[Rd] constrained optimiser doesn't obey constraints (PR#411)
thomas@biostat.washington.edu
thomas@biostat.washington.edu
Fri, 4 Feb 2000 17:46:05 +0100 (MET)
---------- Forwarded message ----------
Date: Fri, 4 Feb 2000 01:58:44 +0000 (GMT)
From: Thomas Lumley <thomas@biostat.washington.edu>
To: r-bugs@biostat.ku.dk
Subject: constrained optimiser doesn't obey constraints
The constrained optimiser is calling the function with parameter values
outside the constrained range
In this example the box is from c(0,0,0,0) to c(1,1,.5,1). The function
prints out the parameter vector when it is out of range. This gives:
[1] "x= -0.001" "x= 1" "x= 0" "x= 1"
[1] "x= 0" "x= 1.001" "x= 0" "x= 1"
[1] "x= 0" "x= 1" "x= -0.001" "x= 1"
[1] "x= 0" "x= 1" "x= 0" "x= 1.001"
[1] "x= NaN" "x= NaN" "x= NaN" "x= NaN"
[1] "x= NaN" "x= NaN" "x= NaN" "x= NaN"
repeated a number of times.
For these starting value it eventually reports convergence, for
some others it goes forever.
---Example code---
revise.mix.binbb_function(x,loss,no.inform){
if (any(is.nan(x)) || any(x<0) || any(x>c(1,1,.5,1))){
print(paste("x=",x))
return(Inf)
}
eta_x[1]
pi1_x[2]
omega1_x[3]
p0_x[4]
log.term_0
for (i in 1:length(no.inform)){
if ( (loss[i]-1) >= 0) {
first.prod_1
for (r in 0:(loss[i]-1)){
first.prod_first.prod*(pi1+r*omega1)
};} else {first.prod_1;}
if ( (no.inform[i]-loss[i]-1) >=0) {
second.prod_1
for (r in 0:(no.inform[i]-loss[i]-1)) {
second.prod_second.prod*(1-pi1+r*omega1)
};} else {second.prod_1;}
third.prod_1
for (r in 0:(no.inform[i]-1)){
third.prod_third.prod*(1+r*omega1)
}
common.term<-choose(no.inform[i],loss[i])
first.part_eta*common.term*first.prod*second.prod/third.prod
whole.term_eta*common.term*first.prod*second.prod/third.prod+(1-eta)*common.term*p0^loss[i]*(1-p0)^(no.inform[i]-loss[i])
log.term_log.term+log(whole.term)
}
## log.term is the log-likelihood.
## For nlminb we need to minimize -log-likelihood which is
## equivalent to maximizing the log-likelihood
return(-log.term)
}
init<-c(0.001, 0.001, 0.001, 0.220)
"sim.ns" <-
c(17, 17, 15, 15, 16, 18, 18, 19, 17, 12, 18, 19, 19, 15, 20,
17, 7, 15, 18, 15, 19, 19, 19, 21, 16, 17, 18, 19, 21, 12, 16,
16, 21, 14, 16, 8, 18, 15)
"loss.dat" <-
structure(c(17, 13, 8, 9, 10, 4, 1, 7, 3, 4, 2, 6, 3, 4, 7, 3,
1, 2, 5, 4, 3, 4, 2, 1, 1, 7, 4, 5, 3, 0, 4, 6, 4, 1, 6, 3, 2,
3), .Names = c("V1", "V2", "V3", "V4", "V5", "V6", "V7", "V8",
"V9", "V10", "V11", "V12", "V13", "V14", "V15", "V16", "V17",
"V18", "V19", "V20", "V21", "V22", "V23", "V24", "V25", "V26",
"V27", "V28", "V29", "V30", "V31", "V32", "V33", "V34", "V35",
"V36", "V37", "V38"))
optim(init,fn=revise.mix.binbb,
lower=c(0.00,0.00,0.00,0.00),upper=c(1,1,.5,1),
no.inform=sim.ns,loss=loss.dat,method="L-BFGS-B")
--please do not edit the information below--
Version:
platform = i686-unknown-linux
arch = i686
os = linux
system = i686, linux
status = Under development (unstable)
major = 0
minor = 99.0
year = 2000
month = January
day = 29
language = R
Search Path:
.GlobalEnv, Autoloads, package:base
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._