Original: http://tecdat.cn/?p=3772
Create test data
As a first step, we create some test data used to fit our model. Let us assume that there is a linear relationship between the predictor variables and the response variable, so we use a linear model and add some noise.
I will balance the value of x is near zero as "related to" the slope and intercept. The result should look like the right
trueA <- 5
trueB <- 0
trueSd <- 10
sampleSize <- 31
# create independent x-values
x <- (-(sampleSize-1)/2):((sampleSize-1)/2)
# create dependent values according to ax + b + N(0,sd)
y <- trueA * x + trueB + rnorm(n=sampleSize,mean=0,sd=trueSd)
plot(x,y, main="Test Data")
Map
Definition of the statistical model
The next step is to specify the statistical model. We already know that the data is y = a * x + b N error model with normal and standard deviation sd of (0, sd) is created using the linear relationship between x and y, so let us use the same model fit and see if we can retrieve our original parameter values.
The likelihood function is derived from the model
In order to estimate the parameters of Bayesian analysis, we need to export the model we want to fit the likelihood function . We look forward to the possibility that the observed data we have seen to the parameters of the model for the probability (density) conditions occur. Thus, we assumed linear model y = b + a * x + N (0, sd) the parameters (a, b, sd) as input, we must return to the probability of obtaining the test data in the model (which sounds more complex, as you can see in the code above, we simply calculate the difference between the predicted and observed a * x to y y = b +, then we have to find the probability density (using dnorm ) this discrepancy occurs.
likelihood <- function(param){
a = param[1]
b = param[2]
sd = param[3]
pred = a*x + b
sumll = sum(singlelikelihoods)
(sumll)
}
slopevalues <- function(x){return(likelihood(c(x, trueB, trueSd)))}|
|
Logarithmic likelihood curve slope parameter
By way of illustration, the last few lines of code series plotted likelihood parameter value of a slope parameter. The result should look like the plot on the right.
Why do we use a logarithmic
You may have noticed I returned to the log-likelihood function of probability, this is my summing the probabilities of all data points of the reason (the product of the number equal to the sum of the number). Why do we do this? You do not have to do this, but it is strongly recommended, because the possibility of many small probability multiplied quickly becomes very small (such as 10 ^ -34). At some stage, the computer program is entering the digital rounding or underflow problem. So, bottom line: When you use the possibility of programming, always use a logarithmic!
Defined a priori
作为第二步，与贝叶斯统计中一样，我们必须为每个参数指定先验分布。为了方便起见，我对所有三个参数使用了均匀分布和正态分布。 无信息先验通常是1 / sigma的比例（如果你想了解原因，请看这里）。当你认真地深入了解贝叶斯统计数据时，这个东西很重要，但我不想让代码在这里更加混乱。
# Prior distribution
prior <- function(param){
a = param[1]
b = param[2]
sd = param[3]
aprior = (a, min=0, max=10, log = T)
bprior = dnorm(b, sd = 5, log = T)
}后验
先验和可能性的乘积是MCMC将要处理的实际数量。这个函数被称为后验（或者确切地说，它在被归一化之后称为后验，MCMC将为我们做，但让我们暂时不挑剔）。同样，在这里我们使用总和，因为我们使用对数。
posterior <- function(param){
return ( (param) + prior(param))
}
MCMC
现在，实际上是Metropolis-Hastings算法。该算法最常见的应用之一（如本例所示）是从贝叶斯统计中的后验密度中提取样本。然而，原则上，该算法可用于从任何可积函数中进行采样。因此，该算法的目的是在参数空间中跳转，但是以某种方式使得在某一点上的概率与我们采样的函数成比例（这通常称为目标函数）。在我们的例子中，这是上面定义的后验。
这是通过
- 从随机参数值开始
- 根据称为提议函数的某个概率密度，选择接近旧值的新参数值
- 以概率p（新）/ p（旧）跳到这个新点，其中p是目标函数，p> 1表示跳跃
考虑为什么会起作用很有趣，但目前我可以向你保证 - 当我们运行这个算法时，它访问的参数的分布会收敛到目标分布p。那么，让我们在R中得到这个：
######## Metropolis algorithm ################
proposalfunction <- function(param){
return(rnorm(3,mean = param, sd= c(0.1,0.5,0.3)))
}
run_metropolis_MCMC <- function(startvalue, iterations){
for (i in 1:iterations){
if (runif(1) < probab){
chain[i+1,] = proposal
}else{
chain[i+1,] = chain[i,]
}
}
return(chain)
}
chain = run_metropolis_MCMC(startvalue, 10000)
burnIn = 5000
acceptance = 1-mean(duplicated(chain[-(1:burnIn),]))再次，使用后验的对数可能在开始时有点混乱，特别是当您查看计算接受概率的行时（probab = exp（后验（建议） - 后验（链[i，]）） ）。要理解我们为什么这样做，请注意p1 / p2 = exp [log（p1）-log（p2）]。
The first step in the algorithm may be affected by variation of the initial value, thus normally discarded for further analysis. An interesting output depends on the acceptance rate is: refuse to accept the proposal of the frequency standard is how much? Acceptance rate can be affected by the proposed functions: In general, the closer the proposal, the greater the acceptance rate. However, a very high acceptance rate usually is not helpful: This means that the algorithm "stay" at the same point. It can be shown that 20% to 30% acceptance rate is optimal for typical applications.
### Summary: #######################
par(mfrow = c(2,3))
hist( [-(1:burnIn),1],nclass=30, , main="Posterior of a", xlab="True value = red line" )
abline(v = mean(chain[-(1:burnIn),1]))
# for comparison:
summary(lm(y~x))Generated should look something like FIG. You can see that we more or less searched the parameters used to create the original data, and you also see that we get a specific region around the maximum a posteriori value of these areas there are some data to support this is the Bayesian It corresponds to the confidence interval.
FIG: Upper Display rear slope (a) of the standard deviation of the estimated posteriori, intercept (b) and errors (sd). The next line shows the Markov chain parameter values.
Any question? Please leave a comment below!
Big Data tribe - Chinese professional third-party data service providers to provide customized one-stop data mining and statistical analysis consultancy services
Statistical analysis and data mining consulting services: y0.cn/teradat (Consulting Services, please contact the official website customer service )
QQ：3025393450
[Service] Scene
Research; the company outsourcing; online and offline one training; data collection; academic research; report writing; market research.
[Tribe] big data to provide customized one-stop data mining and statistical analysis consultancy
