The problem is a binomial problem, the Globe Tossing problem. Pick a point randomly in the globe and it will fall in water W or in land L. Supposse the data WLWWWLWLW (n=9, w=6), and the question: What is the most likely fraction of water on the surface of the globe? we don’t know, but we know the most likely ratio that accounts for the given data WLWWWLWLW, is 6/9 = 0.666.

The Likelihood

The same value can be obtained in a more complicated way as the maximum of the binomial distribution considered as a function of p, the probablity, given that 6 out of 9 samples were W. We can estimate this in a graph.

# define grid
p_grid <- seq(from=0, to=1, length.out = 1000)
# compute likelihood at each value in grid
likelihood <- dbinom(6, size = 9, prob = p_grid)
plot(p_grid, likelihood, type = 'l', xlab="probability of water")
mtext("1000 points")

You can appreciate the maximum occurs around 0.66. The maximum can be derived with calculus making the derivative with respect to p equal to zero.(DOIT). Also the Likelihood is not a distribution function, it does not add up to one for example.(DOIT).

The Posterior

A way to turn the likelihood into a probability density is by conditioning the likelihood to the prior. This is the posterior probability that we obtain using the Bayes formula.

# define an uninformative prior
prior <- rep(1, length(p_grid))
# compute the product of the likelihood and prior
unstd.posterior <- likelihood * prior
# standardize the posteriour, so it sums to 1
posterior <- unstd.posterior / sum(unstd.posterior)
plot(p_grid, posterior, type='l', xlab="probability of water")
mtext("1000 points")

The maximum likelihood now correstponds to the maximum aposteriory or MAP but only because the prior is uniform.

Sampling from a grid-approximated posterior

Now we wish to draw 10,000 samples from a probability distribution given as a vector of probability weights which is our posteriour.

samples <- sample(p_grid, size=1e4, replace=TRUE, prob=posterior)
plot(samples)

We now plot the density estimate computed from these samples using the convenient interface for plotting densities defined in the library “rethinking”

dens(samples)

LS0tCnRpdGxlOiAiU2FtcGxpbmcgZnJvbSBhIGdyaWQtYXBwcm94aW1hdGUgcG9zdGVyaW9yIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCmBgYHtyLCBpbmNsdWRlPUZBTFNFfQpsaWJyYXJ5KHJldGhpbmtpbmcpCmBgYAoKClRoZSBwcm9ibGVtIGlzIGEgYmlub21pYWwgcHJvYmxlbSwgdGhlIEdsb2JlIFRvc3NpbmcgcHJvYmxlbS4gUGljayBhIHBvaW50IHJhbmRvbWx5IGluIHRoZSBnbG9iZSBhbmQgaXQgd2lsbCBmYWxsIGluIHdhdGVyIFcgb3IgaW4gbGFuZCBMLgpTdXBwb3NzZSB0aGUgZGF0YSBXTFdXV0xXTFcgKG49OSwgdz02KSwgYW5kIHRoZSBxdWVzdGlvbjogV2hhdCBpcyB0aGUgbW9zdCBsaWtlbHkgZnJhY3Rpb24gb2Ygd2F0ZXIgb24gdGhlIHN1cmZhY2Ugb2YgdGhlIGdsb2JlPyB3ZSBkb24ndCBrbm93LCBidXQgd2Uga25vdyB0aGUgbW9zdCBsaWtlbHkgcmF0aW8gdGhhdCBhY2NvdW50cyBmb3IgdGhlIGdpdmVuIGRhdGEgV0xXV1dMV0xXLCBpcyA2LzkgPSAwLjY2Ni4KCiMjIFRoZSBMaWtlbGlob29kClRoZSBzYW1lIHZhbHVlIGNhbiBiZSBvYnRhaW5lZCBpbiBhIG1vcmUgY29tcGxpY2F0ZWQgd2F5IGFzIHRoZSBtYXhpbXVtIG9mIHRoZSBiaW5vbWlhbCBkaXN0cmlidXRpb24gY29uc2lkZXJlZCBhcyBhIGZ1bmN0aW9uIG9mIHAsIHRoZSBwcm9iYWJsaXR5LCBnaXZlbiB0aGF0IDYgb3V0IG9mIDkgc2FtcGxlcyB3ZXJlIFcuIFdlIGNhbiBlc3RpbWF0ZSB0aGlzIGluIGEgZ3JhcGguIAoKYGBge3J9CiMgZGVmaW5lIGdyaWQKcF9ncmlkIDwtIHNlcShmcm9tPTAsIHRvPTEsIGxlbmd0aC5vdXQgPSAxMDAwKQoKIyBjb21wdXRlIGxpa2VsaWhvb2QgYXQgZWFjaCB2YWx1ZSBpbiBncmlkCmxpa2VsaWhvb2QgPC0gZGJpbm9tKDYsIHNpemUgPSA5LCBwcm9iID0gcF9ncmlkKQoKcGxvdChwX2dyaWQsIGxpa2VsaWhvb2QsIHR5cGUgPSAnbCcsIHhsYWI9InByb2JhYmlsaXR5IG9mIHdhdGVyIikKbXRleHQoIjEwMDAgcG9pbnRzIikKYGBgCgpZb3UgY2FuIGFwcHJlY2lhdGUgdGhlIG1heGltdW0gb2NjdXJzIGFyb3VuZCAwLjY2LiBUaGUgbWF4aW11bSBjYW4gYmUgZGVyaXZlZCB3aXRoIGNhbGN1bHVzIG1ha2luZyB0aGUgZGVyaXZhdGl2ZSB3aXRoIHJlc3BlY3QgdG8gcCBlcXVhbCB0byB6ZXJvLihET0lUKS4gQWxzbyB0aGUgTGlrZWxpaG9vZCBpcyBub3QgYSBkaXN0cmlidXRpb24gZnVuY3Rpb24sIGl0IGRvZXMgbm90IGFkZCB1cCB0byBvbmUgZm9yIGV4YW1wbGUuKERPSVQpLgoKIyMgVGhlIFBvc3RlcmlvcgpBIHdheSB0byB0dXJuIHRoZSBsaWtlbGlob29kIGludG8gYSBwcm9iYWJpbGl0eSBkZW5zaXR5IGlzIGJ5IGNvbmRpdGlvbmluZyB0aGUgbGlrZWxpaG9vZCB0byB0aGUgcHJpb3IuIFRoaXMgaXMgdGhlIHBvc3RlcmlvciBwcm9iYWJpbGl0eSB0aGF0IHdlIG9idGFpbiB1c2luZyB0aGUgQmF5ZXMgZm9ybXVsYS4gCgpgYGB7cn0KIyBkZWZpbmUgYW4gdW5pbmZvcm1hdGl2ZSBwcmlvcgpwcmlvciA8LSByZXAoMSwgbGVuZ3RoKHBfZ3JpZCkpCgojIGNvbXB1dGUgdGhlIHByb2R1Y3Qgb2YgdGhlIGxpa2VsaWhvb2QgYW5kIHByaW9yCnVuc3RkLnBvc3RlcmlvciA8LSBsaWtlbGlob29kICogcHJpb3IKCiMgc3RhbmRhcmRpemUgdGhlIHBvc3RlcmlvdXIsIHNvIGl0IHN1bXMgdG8gMQpwb3N0ZXJpb3IgPC0gdW5zdGQucG9zdGVyaW9yIC8gc3VtKHVuc3RkLnBvc3RlcmlvcikKCnBsb3QocF9ncmlkLCBwb3N0ZXJpb3IsIHR5cGU9J2wnLCB4bGFiPSJwcm9iYWJpbGl0eSBvZiB3YXRlciIpCm10ZXh0KCIxMDAwIHBvaW50cyIpCmBgYApUaGUgbWF4aW11bSBsaWtlbGlob29kIG5vdyBjb3JyZXN0cG9uZHMgdG8gdGhlIG1heGltdW0gYXBvc3Rlcmlvcnkgb3IgTUFQIGJ1dCBvbmx5IGJlY2F1c2UgdGhlIHByaW9yIGlzIHVuaWZvcm0uIAoKIyBTYW1wbGluZyBmcm9tIGEgZ3JpZC1hcHByb3hpbWF0ZWQgcG9zdGVyaW9yCk5vdyB3ZSB3aXNoIHRvIGRyYXcgMTAsMDAwIHNhbXBsZXMgZnJvbSBhIHByb2JhYmlsaXR5IGRpc3RyaWJ1dGlvbiBnaXZlbiBhcyBhIHZlY3RvciBvZiBwcm9iYWJpbGl0eSB3ZWlnaHRzIHdoaWNoIGlzIG91ciBwb3N0ZXJpb3VyLgoKYGBge3J9CnNhbXBsZXMgPC0gc2FtcGxlKHBfZ3JpZCwgc2l6ZT0xZTQsIHJlcGxhY2U9VFJVRSwgcHJvYj1wb3N0ZXJpb3IpCgpwbG90KHNhbXBsZXMpCmBgYAoKV2Ugbm93IHBsb3QgdGhlIGRlbnNpdHkgZXN0aW1hdGUgY29tcHV0ZWQgZnJvbSB0aGVzZSBzYW1wbGVzIHVzaW5nIHRoZSBjb252ZW5pZW50IGludGVyZmFjZSBmb3IgcGxvdHRpbmcgZGVuc2l0aWVzIGRlZmluZWQgaW4gdGhlIGxpYnJhcnkgInJldGhpbmtpbmciCgpgYGB7cn0KZGVucyhzYW1wbGVzKQpgYGAKCg==