I'm trying to implement a beta-geometric probability model in R (as described in this whitepaper) which involves solving an equation with two unknown parameters. In the example, they use Excel to do this, starting the values off at alpha = beta = 1
and constraining them to alpha > 0.0001 < beta
.
I've nearly implemented this in R, but I can't seem to make any solver work for me. Please help.
# probability mass function
P = function (alpha, beta, t) {
out = numeric(length=length(t))
for (i in seq_along(t)) {
if (t[i]==1) {
out[i] = alpha / (alpha + beta)
} else {
out[i] = ((beta + t[i] - 2) / (alpha + beta + t[i] - 1)) * P(alpha, beta, t[i] - 1)
}
}
out
}
# survival probability function
S = function(alpha, beta, t) {
if (t==1) {
1 - P(alpha, beta, t=t)
} else {
S(alpha, beta, t - 1) - P(alpha, beta, t=t)
}
}
# log likelihood function
LL = function(alpha, beta=1, t, n) {
sum(n * log(P(1,1,t))) + (sum(n[1:length(n)-1]) * log(S(alpha, beta, t=t[length(t)])))
}
# make some test data
n = c(239L, 2650L, 1063L, 1014L, 473L, 1304L)
t = 1:6
# log likelihood
LL(alpha=1, beta=1, n=n, t=t)
# use numerical optimization to find values of alpha and beta
optim(c(1,1), fn=LL, n=n, t=t)
require(stats4)
mle(LL, start=list(alpha=1, beta=1), t=t, n=n)
By default, optim
will minimize, but you want to maximize LL
. Also, you want to use a method like L-BFGS-B, which uses bound information:
optim(c(1, 1), function(x) -LL(x[1], x[2], n=n, t=t), method="L-BFGS-B",
lower=c(0.0001, 0.0001))
# $par
# [1] 0.0001 9679.3562
#
# $value
# [1] 17075.64
#
# $counts
# function gradient
# 87 87
#
# $convergence
# [1] 0
#
# $message
# [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
We can verify we've improved the log-likelihood:
LL(1, 1, n=n, t=t)
# [1] -27659.45
LL(0.0001, 9679.3562, n=n, t=t)
# [1] -17075.64