I'm trying to evaluate trees for a number of output parameters, in a loop. But sometimes the tree function aborts. How can the lines be surrounded by a try catch block?
I apologize for not having "real" code, but I don't have an example of a non working tree. Here's pseddo code to illustrate the current implementation
for (icol in seq(1,ncol)) {
cName <-colnames(dt)[icol]
tdata <- dt[,unique(c(1,2,icol)),with=F]
nTrues <- sum(rowSums(tdata[,cName,with=F]))
if (nTrues>0 ) {
print(paste('processing column',icol,'of',ncol,': ',cName))
nFac <- table(tdata[,cName,with=F])
print(nFac)
treeData <- merge(tdata, maint_data)
treeData[,c('identifiers'):=NULL]
fmla <- paste(cName,'~ .')
if (TRUE) {
# Recursive Partitioning and Regression Trees
cat('Recursive Partitioning and Regression Trees (rpart)','\n')
rtree <- rpart(fmla,data=treeData) # <-- NEED TRY CATCH HERE...
print(summary(rtree))
cat('Confusion matrix for rpart')
print(table(predict(rtree), treeData[[cName]]))
}
flush.console()
} else {
print(paste('skipping column',icol,'of',ncol(ci_ratio_before_larger),': ',cName))
}
}
Here's a correction that seems to work....
tryCatch({
# Recursive Partitioning and Regression Trees
cat('Recursive Partitioning and Regression Trees (rpart)','\n')
rtree <- rpart(fmla,data=treeData)
print(summary(rtree))
cat('Confusion matrix for rpart')
print(table(predict(rtree,type='vector'), treeData[[cName]]))
},
error = function (condition) {
print("RPART_ERROR:")
print(paste(" Message:",conditionMessage(condition)))
print(paste(" Call: ",conditionCall(condition)))
}
)
I cannot really test it, but can you try replacing your
if (TRUE)
condition with this:
tryCatch({
# Recursive Partitioning and Regression Trees
cat('Recursive Partitioning and Regression Trees (rpart)','\n')
rtree <- rpart(fmla,data=treeData) # <-- NEED TRY CATCH HERE...
print(summary(rtree))
cat('Confusion matrix for rpart')
print(table(predict(rtree), treeData[[cName]]))
},
error = function (condition) {
print("RPART_ERROR:")
print(paste(" Message:",conditionMessage(condition)))
print(paste(" Call: ",conditionCall(condition)))
},
finally= function() {
}
)
Related
library(mvtnorm)
set.seed(14)
n=10000
sigmatrue<-1
rhotrue<-0.3
b1=0.05
b0=0
y<-arima.sim(model=list(ar=c(0.3)),n=10000 ,sd=sigmatrue)#kataskevi
#xronoseiras
x=rep(0,n)
for(i in 1:n){
x[i]=i
}
for(t in 1:n)
{
y[t]=y[t]+b0+b1*x[t]
}
est=arima(y,order=c(1,0,0),xreg=x,include.mean=TRUE,method="ML",kappa=1e+06)
cens<-rep(0, n)
c=(9/10)*(n*b1+b0)
for (i in 1:n) {
if(y[i]>c){
y[i]<-c
cens[i]<-1
}
}
ll<-function(p){
sigma=matrix(c(p[2]^2/(1-p[3]^2), p[2]^2*p[3]/(1-p[3]^2),p[2]^2*p[3]/(1-p[3]^2),p[2]^2/(1-p[3]^2)),ncol=2,nrow=2,byrow=TRUE)
likelihood<-rep(0,n)
for(t in 2 :n){
if(cens[t]==0 & cens[t-1]==0){
likelihood[t]<-dnorm(((y[t]-(p[1]+p[4]*t)-p[3]*(y[t-1]-(p[1]+p[4]*(t-1)))/p[2]) )/p[2])
}
else if(cens[t]==0 & cens[t-1]==1){
likelihood[t]<-(1/(1-pnorm((c-(p[1]+p[4]*t)*sqrt(1-p[3]^2)/p[2]))*sqrt(1-p[3]^2)/p[2]*dnorm(((y[t]-(p[1]+p[4]*t)*sqrt(1-p[3]^2))/p[2])*(1-pnorm(((c-(p[1]+p[4]*(t))-p[3]*(y[t]-(p[1]+p[4]*(t-1)))/p[2])))))))
}
else if(cens[t]==1 & cens[t-1]==0){
likelihood[t]<-1-pnorm(((c-(p[1]+p[4]*t)-p[3]*(y[t-1]-(p[1]+p[4]*(t-1)))/p[2])))
}
else
{
likelihood[t]<-(((pmvnorm(lower=c, upper=Inf , mean=c(p[1]+p[4]*(t-1),p[1]+p[4]*t),sigma=sigma))/(1-pnorm((c-(p[1]+p[4]*(t-1))*sqrt(1-p[3]^2)/p[2])))))
}
}
f0=(sqrt(1-p[3])/p[2]*dnorm(((y[1]-p[1]-p[4])*sqrt(1-p[3]^2))/p[2]))
likelihood[1]=f0
#Ta prosthesa
if (any(likelihood==0)){
likelihood[likelihood==0] = 0.000001 #poly mikros arithmos
}
if (any(likelihood==Inf)){
likelihood[likelihood==Inf] = 1 #poly megalos h 1, an milame gia pi8anothta
}
if (any(is.nan(likelihood))){
likelihood[is.nan(likelihood)] = 0.000001
}
minusloglike=-sum(log(likelihood))
#l1=list(Minusloglike=minusloglike,Loglikelihood=log(likelihood))
return(minusloglike)
}
fit<-optim(c(0,1,0.3,0.05),ll,method="L-BFGS-B",lower=c(-Inf,0.001,-0.999,-Inf),upper = c(Inf,Inf,0.999,Inf),hessian=TRUE)
fisher.info<-solve(fit$hessian)
fisher.info
prop.sigma<-sqrt(diag(fisher.info))
sigmas<-diag(prop.sigma)
upper<-fit$par+1.96*sigmas
lower<-fit$par-1.96*sigmas
interval<-data.frame(value=fit$par, lower=diag(lower),upper=diag(upper))
interval
I run this code(it is for censored first order autogressive process with covariate , i have 4 cases for x(t) ,x(t-1) either is censored or non-censored and i dont want the likelihood to go near zero and inf).I get error
Error in if (any(likelihood == Inf)) { :
missing value where TRUE/FALSE needed
Called from: fn(par, ...)
The program is working for n=100 but when n is larger than 100 i have this error. I think this error causes bad estimattes of the four parameters(b1,rho,sigma,b0).Does anyone know what can i do?
Thank you for your help.
I am trying to compare two distributions by using Likelihood ratio test. I used the maxLik function to obtain mles of both of null and alternative distributions. I want to use BFGSR method because it gives better estimates.
library("maxLik")
library("flexsurv")
n=20
den1=1000
mpar=3
omepar=5
spar=3
Logliknak1=function(param){
m=param[1]
o=param[2]
n*(log(2)+m*log(m)-lgamma(m)-m*log(o))+(2*m-1)*sum(log(y))-(m/o)*sum(y^(2))
}
Loglikgennak= function(param){
s <- param[1]
ome <- param[2]
m<-param[3]
(n*(log(2*s)+m*log(m)-lgamma(m)-m*log(ome))+(2*m*s-1)*sum(log(y))-(m/ome)*sum(y^(2*s)))
}
LR2=rep(0,den1)
ps=0; pome=0; pm=0;
for(i in 1:den1){
repeat
{
x=rgengamma.orig(n,shape=spar,scale=(omepar/mpar),k=mpar)
y=x^0.5
ot=mean(y^2)
mt=(mean(y)*mean(y^2))/(2*(mean(y^3)-(mean(y)*mean(y^2))))
mle2 <- maxLik(logLik=Logliknak1, start = c(m=mt, o=ot),method="BFGSR")
lnull=logLik(mle2)
mm=coef(mle2)[[1]]
mo=coef(mle2)[[2]]
mle3 <- maxLik(logLik=Loglikgennak, start = c(s=1.5,ome=omepar+1,m=mpar+1),method="BFGSR")
lalt=logLik(mle3)
ps=coef(mle3)[[1]]
pome=coef(mle3)[[2]]
pm=coef(mle3)[[3]]
if (lalt>lnull && ps>1 && pome>0 && pm>0)
{break}
}
LR2[i]=2*(lalt-lnull)
print(i)
print(LR2[i])
print(pm)
print(pome)
print(ps)
}
However I keep getting the following error message:
Error in if (all(y == 0)) { : missing value where TRUE/FALSE needed
How do I fix this?
I have a recursive function that uses the output of the previous call as the input of the next call:
recurse_foo = function(input) {
if(identical(input, character(0))) return(NULL)
else {
uu = get_incremental_output(input) ## <-- interested in collecting this
return(recurse_foo(uu))
}
}
As is evident, the terminal output is not very interesting, and I am interested in collecting the intermediate output, but I cannot imagine that growing a global list or any other side effect would be elegant (which is the only thing I can think of).
Any other abstractions that might be useful here?
Thanks.
Specific example:
final_countdown = function(input) {
if (input/2 < 1) return(NULL)
else {
uu = input/2 # <-- interested in collecting this
print(uu)
return(final_countdown(uu))
}
}
final_countdown(100)
In this case, I am interested in collecting the sequence of uus that are printed.
This is a solution, if all intermediate outputs are of the same type:
final_countdown = function(input) {
if (input/2 < 1) return(NA)
else {
c(input, final_countdown(input/2))
}
}
I'm using constrOptim() in R to estimate parameters of a model. I get the error that my target function has a result of length 0 instead 1. The problem can be the starting values I chose. I'm using R the first time and I'm not familiar with the constrOptim algorithm itself. Can somebody help me with the optimization?
my input:
library(quantmod)
getSymbols('^GDAXI', src='yahoo', return.class='ts',from="2005-01-01", to="2015-01-31")
GDAXI.DE=GDAXI[ , "GDAXI.Close"]
log_r1=diff(log(GDAXI.DE[39:2575]))
sigma=matrix(nrow=length(log_r1)-1, ncol=1)
for(i in 2:length(log_r1))
{
sigma[i-1]=var(log_r1[1:i])
}
error=matrix(nrow=length(log_r1), ncol=1)
mu=mean(log_r1)
for(i in 1:length(log_r1))
{
error[i]=log_r1[i]-mu
}
the function i want to minimize:
LogLik=function(th)
{
input=garch(th)
sig=input
for(i in 1:length(sigma))
{
LL=(-1/2)*log(2*pi)-(1/2)*log(sig[i])-(1/2)*er[i]/sig[i]
}
}
the function calculating the input above:
sig=var(log_r1)
er=error
Sigma_garch=matrix(nrow=length(sigma), ncol=1)
garch=function(th)
{
omega.0=th[1]
alpha.0=th[2]
beta.0=th[3]
for(i in 1:length(sigma))
{
if(i==1)
{
Sigma_ga=sig
}else
{
Sigma_ga=Sigma_garch[i-1]
}
Sigma_garch[i]=omega.0+alpha.0*er[i]^2+beta.0*Sigma_ga
}
return(Sigma_garch)
}
my constraints and optimization procedure:
ui=matrix(c(diag(1,3),c(0,(-1),(-1))),4,3, byrow = T)
ci=c(0.01,0,0,(-0.99))
theta=c(0.02,0.01,0.95)
est=constrOptim(c(0.02,0.01,0.95),LogLik, grad=NULL, ui,ci,hessian=FALSE)
the error I'm getting: Error in optim(theta.old, fun, gradient, control = control, method = method, : Zielfunktion gibt Ergebnis der Länge 0 zurück, nicht Länge 1.
Does somebody can tell me what can be the probleme here?
Your target function, LogLik, doesnt return a value resulting in target function has a result of length 0 instead 1.
LogLik=function(th)
{
input=garch(th)
sig=input
for(i in 1:length(sigma))
{
LL=(-1/2)*log(2*pi)-(1/2)*log(sig[i])-(1/2)*er[i]/sig[i]
}
return(LL)
}
I have to call a function that throws an error if the arguments didn't satisfy many conditions.
The conditions are so complicated that I cannot try to satisfy them 100% of the time (I would have to re-type all the conditions the function checks internally).
Instead, I should just retry calling with different arguments (as many times as necessary to fill my table).
In other languages I can write a catch block around the call.
However, in R tryCatch seems to work differently: you can give code with finally=, but after executing the finally-code the outer function terminates anyway.
Here is a minimal example:
sometimesError <- function() {
if(runif(1)<0.1) stop("err")
return(1)
}
fct <- function() {
theSum <- 0
while(theSum < 20) {
tryCatch( theSum <- theSum + sometimesError() )
}
return(theSum)
}
fct() # this should always evaluate to 20, never throw error
( I have read "Is there a way to source() and continue after an error?", and some other posts but I dont think they apply here. They achieve that the source'd code continues statement-by-statement regardless of error as if it were executing at the top level. I, on the other side, am happy with the called function terminating and it is the caller-code that should continue )
You can pass a function to the error argument of tryCatch to specify what should happen when there is an error. In this case, you could just return 0 when there is an error
fct <- function() {
theSum <- 0
while(theSum < 20) {
theSum <- theSum + tryCatch(sometimesError(), error=function(e) 0)
}
return(theSum)
}
As #rawr mentioned in the comments, you could also replace tryCatch with try in this case.
fct <- function() {
theSum <- 0
while(theSum < 20) {
try(theSum <- theSum + sometimesError(), silent=TRUE)
}
return(theSum)
}