দ্বিপদী বিতরণের


16

এই প্রশ্নের একটি প্রযুক্তিগত ফলো-আপ এই প্রশ্নের

রাফ্টারি (1988)N উপস্থাপিত মডেলটি বুঝতে এবং তার প্রতিরূপ করতে আমার সমস্যা হচ্ছে : দ্বিপদী এন প্যারামিটারের জন্য অনুকরণ: উইনবিইউজিএস / ওপেনবিগ / জেজিএস-এ একটি শ্রেণিবদ্ধ বায়েস পদ্ধতির । এটি কেবল কোড সম্পর্কে নয় তবে এটি এখানে অনন্য-বিষয় হওয়া উচিত।

পটভূমি

যাক x=(x1,,xn) অজানা সঙ্গে একটি দ্বিপদ বিন্যাস থেকে সাফল্য গন্য একটি সেট হতে N এবং θ । আরও, আমি ধরে নিচ্ছি যে N প্যারামিটার μ (যেমন কাগজে আলোচনা করা হয়েছে) দিয়ে পোইসন বিতরণ অনুসরণ করে । এর পরে, প্রতিটি xi সঙ্গে গড় একটি পইসন বিতরণের হয়েছে λ=μθ । আমি পরিপ্রেক্ষিতে গতকাল দেশের সর্বোচ্চ তাপমাত্রা নির্দিষ্ট করতে চান λ এবং θ

Assuming যে আমি কোন ভাল পূর্বে জ্ঞান নেই N বা θ , আমি অ-তথ্যপূর্ণ উভয় গতকাল দেশের সর্বোচ্চ তাপমাত্রা নির্ধারণ করতে চান λ এবং θ । বলুন, আমার প্রিরিয়াররা হলেন λGamma(0.001,0.001) এবং θUniform(0,1)

লেখক পূর্বে একটি অনুপযুক্ত ব্যবহার p(N,θ)N1করে তবে উইনবিইউজিএস অনুচিত প্রিয়ারদের গ্রহণ করে না।

উদাহরণ

কাগজে (226 পৃষ্ঠা), পর্যবেক্ষণ করা জলছবিগুলির নিম্নলিখিত সাফল্যের গণনা সরবরাহ করা হয়েছে: 53,57,66,67,72 । আমি জনসংখ্যার আকার N , অনুমান করতে চাই ।

এখানে আমি WinBUGS তে উদাহরণটি কীভাবে ব্যবহার করার চেষ্টা করেছি ( @ স্টাফেন লরেন্টের মন্তব্যের পরে আপডেট হয়েছে):

model {

# Likelihood
  for (i in 1:N) {
    x[i] ~ dbin(theta, n)
  }

# Priors

n ~ dpois(mu)
lambda ~ dgamma(0.001, 0.001)
theta ~ dunif(0, 1)
mu <- lambda/theta

}

# Data

list(x = c(53, 57, 66, 67, 72), N = 5)

# Initial values

list(n = 100, lambda = 100, theta  = 0.5)
list(n = 1000, lambda = 1000, theta  = 0.8)
list(n = 5000, lambda = 10, theta  = 0.2)

মডেল নেই গোবরাট সঙ্গে 20'000 নমুনা পুড়ে-ইন 500'000 নমুনার পর চমত্কারভাবে মিলিত নয়। এখানে একটি জাগস রানের আউটপুট দেওয়া হল:

Inference for Bugs model at "jags_model_binomial.txt", fit using jags,
 5 chains, each with 5e+05 iterations (first 20000 discarded), n.thin = 5
 n.sims = 480000 iterations saved
         mu.vect  sd.vect   2.5%     25%     50%     75%    97.5%  Rhat  n.eff
lambda    63.081    5.222 53.135  59.609  62.938  66.385   73.856 1.001 480000
mu       542.917 1040.975 91.322 147.231 231.805 462.539 3484.324 1.018    300
n        542.906 1040.762 95.000 147.000 231.000 462.000 3484.000 1.018    300
theta      0.292    0.185  0.018   0.136   0.272   0.428    0.668 1.018    300
deviance  34.907    1.554 33.633  33.859  34.354  35.376   39.213 1.001  43000

প্রশ্নাবলি

স্পষ্টতই, আমি কিছু মিস করছি, তবে আমি ঠিক কী দেখতে পাচ্ছি না। আমি মনে করি আমার মডেলটি গঠন কোথাও ভুল। সুতরাং আমার প্রশ্নগুলি হ'ল:

  • আমার মডেল এবং এর বাস্তবায়ন কেন কাজ করে না?
  • রাফটারির দেওয়া মডেলটি (1988) কীভাবে সঠিকভাবে প্রণয়ন এবং প্রয়োগ করা যেতে পারে?

আপনার সাহায্যের জন্য ধন্যবাদ.


2
কাগজ অনুসরণ আপনি যোগ করা উচিত mu=lambda/thetaএবং প্রতিস্থাপন n ~ dpois(lambda)সঙ্গেn ~ dpois(mu)
Stéphane লরেন্ট

@ স্টাফেনলরেন্ট পরামর্শের জন্য ধন্যবাদ। আমি সেই অনুযায়ী কোড পরিবর্তন করেছি। দুঃখের বিষয়, মডেলটি এখনও রূপান্তর করে না।
COOLSerdash

1
আপনি নমুনা নিলে কী ঘটে ? N<72
সাইকোরাক্স বলছেন মনিকা

1
যদি তবে সম্ভাবনা শূন্য, কারণ আপনার মডেল ধরে নিয়েছে যে কমপক্ষে 72২ টি জলবাক রয়েছে। আমি ভাবছি কিনা এটি স্যাম্পলারের জন্য সমস্যা সৃষ্টি করছে। N<72
সাইকোরাক্স বলছেন মনিকা

3
আমি মনে করি না যে সমস্যাটি রূপান্তর is আমি মনে করি যে টাঙানো নকশা-বোনা দুর্বল মডেল একাধিক স্তরে পারস্পরিক সম্পর্কের উচ্চ ডিগ্রী কারণে করণ , কম থাকে তখন এটি এন পুনরাবৃত্তিও সংখ্যা কম আপেক্ষিক। আমি শুধু অবর কম্পিউটিং সরাসরি, উদাহরণস্বরূপ, একটি গ্রিড উপর সুপারিশ করবে θ , এনR^neffθ,N
সাইকোরাক্স বলছেন মোনিকা

উত্তর:


7

ঠিক আছে, যেহেতু আপনি আপনার কোডটি কাজ করার জন্য পেয়েছেন তাই দেখে মনে হচ্ছে এই উত্তরটি কিছুটা দেরিতে। তবে আমি ইতিমধ্যে কোড লিখেছি, তাই ...

এর মূল্য কী, এটি একই * মডেলের সাথে খাপ খায় rstan। এটি আমার গ্রাহক ল্যাপটপে 11 সেকেন্ডে অনুমান করা হয়, আমাদের পুনরাবৃত্তির পরামিতিগুলির কম পুনরাবৃত্তিতে উচ্চতর কার্যকর নমুনার আকার অর্জন করে ।(N,θ)

raftery.model   <- "
    data{
        int     I;
        int     y[I];
    }
    parameters{
        real<lower=max(y)>  N;
        simplex[2]      theta;
    }
    transformed parameters{
    }
    model{
        vector[I]   Pr_y;

        for(i in 1:I){
            Pr_y[i] <-  binomial_coefficient_log(N, y[i])
                        +multiply_log(y[i],         theta[1])
                        +multiply_log((N-y[i]),     theta[2]);
        }
        increment_log_prob(sum(Pr_y));
        increment_log_prob(-log(N));            
    }
"
raft.data           <- list(y=c(53,57,66,67,72), I=5)
system.time(fit.test    <- stan(model_code=raftery.model, data=raft.data,iter=10))
system.time(fit     <- stan(fit=fit.test, data=raft.data,iter=10000,chains=5))

নোট করুন যে আমি theta2-সিমপ্লেক্স হিসাবে কাস্ট করেছি । এটি কেবল সংখ্যাগত স্থায়িত্বের জন্য। সুদের পরিমাণ হ'ল theta[1]; স্পষ্টতই theta[2]অতিরিক্ত প্রয়োজনের তথ্য।

* আপনি দেখতে পাচ্ছেন যে উত্তরোত্তর সংক্ষিপ্তসারটি কার্যত অভিন্ন, এবং প্রকৃত পরিমাণে প্রচার করা আমাদের অনুমানগুলিতে উল্লেখযোগ্য প্রভাব ফেলবে বলে মনে হয় না।N

এন এর জন্য 97.5% কোয়ান্টাইলN আমার মডেলের চেয়ে 50% বড়, তবে আমি মনে করি কারণ স্ট্যানের নমুনা একটি সাধারণ এলোমেলো হাঁটার চেয়ে উত্তরের পুরো পরিসীমা অন্বেষণে ভাল, তাই এটি আরও সহজেই লেজগুলিতে তৈরি করতে পারে। যদিও আমি ভুল হতে পারি।

            mean se_mean       sd   2.5%    25%    50%    75%   97.5% n_eff Rhat
N        1078.75  256.72 15159.79  94.44 148.28 230.61 461.63 4575.49  3487    1
theta[1]    0.29    0.00     0.19   0.01   0.14   0.27   0.42    0.67  2519    1
theta[2]    0.71    0.00     0.19   0.33   0.58   0.73   0.86    0.99  2519    1
lp__      -19.88    0.02     1.11 -22.89 -20.31 -19.54 -19.09  -18.82  3339    1

মান গ্রহণ স্ট্যান থেকে উত্পন্ন, আমি এই অবর ভবিষ্যদ্বাণীপূর্ণ মান আঁকা ব্যবহার ~ Y । আমরা যে অবর ভবিষ্যৎবাণী গড় অবাক হওয়া উচিত নয় ~ YN,θy~y~ খুব নমুনা তথ্য গড় কাছাকাছি হয়!

N.samples   <- round(extract(fit, "N")[[1]])
theta.samples   <- extract(fit, "theta")[[1]]
y_pred  <- rbinom(50000, size=N.samples, prob=theta.samples[,1])
mean(y_pred)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  32.00   58.00   63.00   63.04   68.00  102.00 

rstanস্যাম্পলারটি সমস্যা কিনা কিনা তা যাচাই করতে, আমি গ্রিডের উপরের অংশটি গণনা করেছি। আমরা দেখতে পারি যে উত্তরোত্তর কলা আকৃতির; ইউক্লিডিয়ান মেট্রিক এইচএমসির জন্য এই জাতীয় পোস্টারিয়াল সমস্যা হতে পারে। তবে আসুন সংখ্যার ফলাফলগুলি পরীক্ষা করে দেখুন। (কলা আকারের তীব্রতা এখানে প্রকৃতপক্ষে দমন করা হয়েছে যেহেতু লগ স্কেলে রয়েছে)) আপনি যদি এক মিনিটের জন্য কলা আকারের বিষয়ে চিন্তা করেন, আপনি বুঝতে পারবেন এটি অবশ্যই ˉ y = θ N লাইনে থাকা উচিত itNy¯=θN

গ্রিডের উপরের অংশ

নীচের কোডটি নিশ্চিত করতে পারে যে স্ট্যান থেকে আমাদের ফলাফলগুলি অর্থবোধ করে।

theta   <- seq(0+1e-10,1-1e-10, len=1e2)
N       <- round(seq(72, 5e5, len=1e5)); N[2]-N[1]
grid    <- expand.grid(N,theta)
y   <- c(53,57,66,67,72)
raftery.prob    <- function(x, z=y){
    N       <- x[1]
    theta   <- x[2]
    exp(sum(dbinom(z, size=N, prob=theta, log=T)))/N
}

post    <- matrix(apply(grid, 1, raftery.prob), nrow=length(N), ncol=length(theta),byrow=F)    
approx(y=N, x=cumsum(rowSums(post))/sum(rowSums(post)), xout=0.975)
$x
[1] 0.975

$y
[1] 3236.665

rstan(0,1)×{N|NZN72)}


+1 এবং স্বীকৃত। আমি অভিভূত! আমি তুলনার জন্য স্ট্যানকে ব্যবহার করার চেষ্টা করেছি কিন্তু মডেলটি স্থানান্তর করতে পারিনি। আমার মডেলটি অনুমান করতে প্রায় 2 মিনিট সময় নেয়।
COOLSerdash 1'14

এই সমস্যার জন্য স্ট্যানের সাথে একটি হিক্কারটি হ'ল সমস্ত প্যারামিটারগুলি বাস্তব হওয়া উচিত, যাতে এটি কিছুটা অসুবিধেয় হয়। তবে যেহেতু আপনি যেকোন স্বেচ্ছাসেবী কার্যক্রমে লগ-সম্ভাবনাটিকে দন্ডিত করতে পারেন, তাই আপনাকে এটি প্রোগ্রাম করার জন্য কেবল সমস্যার মধ্য দিয়ে যেতে হবে ... এবং এটি করার জন্য রচিত ফাংশনগুলি খনন করতে হবে ...
সাইকোরাক্স মনিকাকে

হ্যাঁ! ঠিক আমার সমস্যা ছিল। nপূর্ণসংখ্যা হিসাবে ঘোষিত হতে পারে না এবং আমি সমস্যাটির জন্য কোনও কার্যকারিতা জানতাম না।
COOLSerdash

আমার ডেস্কটপে প্রায় 2 মিনিট।
COOLSerdash

1
@COOLSerdash আপনি [এটি] [1] প্রশ্নে আগ্রহী হতে পারেন, যেখানে আমি জিজ্ঞাসা করি গ্রিডের কোন ফলাফল বা rstanফলাফল আরও সঠিক। [1] stats.stackexchange.com/questions/114366/…
সাইকোরাক্স মনিকাকে

3

λ আমি এখন রাফ্ট্রি (1988) এর কাগজ থেকে ফলাফলগুলি প্রতিলিপি করতে পারি।

এখানে আমার বিশ্লেষণ স্ক্রিপ্ট এবং জেএজিএস এবং আর ব্যবহার করে ফলাফল:

#===============================================================================================================
# Load packages
#===============================================================================================================

sapply(c("ggplot2"
         , "rjags"
         , "R2jags"
         , "hdrcde"
         , "runjags"
         , "mcmcplots"
         , "KernSmooth"), library, character.only = TRUE)

#===============================================================================================================
# Model file
#===============================================================================================================

cat("
    model {

    # Likelihood    
    for (i in 1:N) {
      x[i] ~ dbin(theta, n)
    }

    # Prior       
    n ~ dpois(mu)
    lambda ~ dgamma(0.005, 0.005)
#     lambda ~ dunif(0, 1000)
    mu <- lambda/theta
    theta ~ dunif(0, 1)    
}    
", file="jags_model_binomial.txt")


#===============================================================================================================
# Data
#===============================================================================================================

data.list <- list(x = c(53, 57, 66, 67, 72, NA), N = 6) # Waterbuck example from Raftery (1988)

#===============================================================================================================
# Inits
#===============================================================================================================

jags.inits <- function() { 
  list(
    n = sample(max(data.list$x, na.rm = TRUE):1000, size = 1) 
    , theta = runif(1, 0, 1)
    , lambda = runif(1, 1, 10)
#     , cauchy  = runif(1, 1, 1000)
    #     , mu = runif(1, 0, 5)
  )
}

#===============================================================================================================
# Run the chains
#===============================================================================================================

# Parameters to store

params <- c("n"
            , "theta"
            , "lambda"
            , "mu"
            , paste("x[", which(is.na(data.list[["x"]])), "]", sep = "")
)

# MCMC settings

niter <- 500000 # number of iterations
nburn <- 20000  # number of iterations to discard (the burn-in-period)
nchains <- 5    # number of chains

# Run JAGS

out <- jags(
  data                 = data.list
  , parameters.to.save = params
  , model.file         = "jags_model_binomial.txt"
  , n.chains           = nchains
  , n.iter             = niter
  , n.burnin           = nburn
  , n.thin             = 50
  , inits              = jags.inits
  , progress.bar       = "text")

গণনাটি আমার ডেস্কটপ পিসিতে প্রায় 98 সেকেন্ড সময় নিয়েছিল।

#===============================================================================================================
# Inspect results
#===============================================================================================================

print(out
      , digits = 2
      , intervals = c(0.025, 0.1, 0.25, 0.5, 0.75, 0.9,  0.975))

ফলাফলগুলি হ'ল:

Inference for Bugs model at "jags_model_binomial.txt", fit using jags,
 5 chains, each with 5e+05 iterations (first 20000 discarded), n.thin = 50
 n.sims = 48000 iterations saved
         mu.vect sd.vect  2.5%    10%    25%    50%    75%     90%   97.5% Rhat n.eff
lambda     62.90    5.18 53.09  56.47  59.45  62.74  66.19   69.49   73.49    1 48000
mu        521.28  968.41 92.31 113.02 148.00 232.87 467.10 1058.17 3014.82    1  1600
n         521.73  968.54 95.00 114.00 148.00 233.00 467.00 1060.10 3028.00    1  1600
theta       0.29    0.18  0.02   0.06   0.13   0.27   0.42    0.55    0.66    1  1600
x[6]       63.03    7.33 49.00  54.00  58.00  63.00  68.00   72.00   78.00    1 36000
deviance   34.88    1.53 33.63  33.70  33.85  34.34  35.34   36.81   39.07    1 48000

N522233N

jagsfit.mcmc <- as.mcmc(out)
jagsfit.mcmc <- combine.mcmc(jagsfit.mcmc)

hpd.80 <- hdr.den(log(as.vector(jagsfit.mcmc[, "n"])), prob = c(80), den = bkde(log(as.vector(jagsfit.mcmc[, "n"])), gridsize = 10000))

exp(hpd.80$mode)

[1] 149.8161

N

(hpd.ints <- HPDinterval(jagsfit.mcmc, prob = c(0.8)))

               lower      upper
deviance 33.61011007  35.677810
lambda   56.08842502  69.089507
mu       72.42307587 580.027182
n        78.00000000 578.000000
theta     0.01026193   0.465714
x[6]     53.00000000  71.000000

N150(78;578)(80;598)

আমাদের সাইট ব্যবহার করে, আপনি স্বীকার করেছেন যে আপনি আমাদের কুকি নীতি এবং গোপনীয়তা নীতিটি পড়েছেন এবং বুঝতে পেরেছেন ।
Licensed under cc by-sa 3.0 with attribution required.