[Yuima-commits] r477 - in pkg/yuimaGUI: . inst/yuimaGUI
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 7 16:28:53 CEST 2016
Author: phoenix844
Date: 2016-10-07 16:28:53 +0200 (Fri, 07 Oct 2016)
New Revision: 477
Modified:
pkg/yuimaGUI/DESCRIPTION
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
Log:
added COGARCH (estimation and simulation) + introducing CARMA
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2016-10-04 13:46:46 UTC (rev 476)
+++ pkg/yuimaGUI/DESCRIPTION 2016-10-07 14:28:53 UTC (rev 477)
@@ -1,10 +1,10 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the Yuima Package
-Version: 0.7.3
+Version: 0.7.4
Author: YUIMA Project Team
Maintainer: Emanuele Guidotti <emanuele.guidotti at studenti.unimi.it>
Description: Provides a graphical user interface for the yuima package.
License: GPL-2
Depends: R(>= 3.0.0)
-Imports: DT (>= 0.2), shinyjs, shiny, shinydashboard, shinyBS, yuima, quantmod, sde
+Imports: DT (>= 0.2), shinyjs, shiny(>=0.14), shinydashboard, shinyBS, yuima, quantmod, sde
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-10-04 13:46:46 UTC (rev 476)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-10-07 14:28:53 UTC (rev 477)
@@ -180,8 +180,8 @@
}
-defaultModels <- c("Diffusion process"="Brownian Motion",
- "Diffusion process"="Geometric Brownian Motion",
+defaultModels <- c("Diffusion process"="Geometric Brownian Motion",
+ "Diffusion process"="Brownian Motion",
"Diffusion process"="Ornstein-Uhlenbeck (OU)",
"Diffusion process"="Vasicek model (VAS)",
"Diffusion process"="Constant elasticity of variance (CEV)",
@@ -194,19 +194,20 @@
"Compound Poisson" = "Power Low Intensity",
"Compound Poisson" = "Exponentially Decaying Intensity",
"Compound Poisson" = "Periodic Intensity",
- "COGARCH" = "Noise - Compound Poisson"
+ "CARMA" = "Carma Noise: Compound Poisson",
+ "COGARCH" = "Cogarch(p,q)"
)
defaultJumps <- c("Gaussian", "Uniform")
-defaultBounds <- function(name, jumps = NULL, lower = NA, upper = NA, p_C = NA, q_C = NA){
- if (name %in% c(names(isolate({usr_models$model})), defaultModels[names(defaultModels)=="COGARCH"])){
- par <- setModelByName(name = name, jumps = jumps, p_C = p_C, q_C = q_C)@parameter at all
+defaultBounds <- function(name, jumps = NA, lower = NA, upper = NA, AR_C = NA, MA_C = NA){
+ if (name %in% names(isolate({usr_models$model}))){
+ par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter at all
startmin <- rep(lower, length(par))
startmax <- rep(upper, length(par))
names(startmin) <- par
names(startmax) <- par
- if (!is.null(jumps)){
+ if (!is.na(jumps)){
boundsJump <- jumpBounds(jumps = jumps, lower = lower, upper = upper)
for (i in par[par %in% names(boundsJump$lower)]){
startmin[[i]] <- boundsJump$lower[[i]]
@@ -215,6 +216,40 @@
}
return(list(lower=as.list(startmin), upper=as.list(startmax)))
}
+ if (name %in% defaultModels[names(defaultModels) == "COGARCH"]){
+ par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter
+ par <- unique(c(par at drift, par at xinit))
+ startmin <- rep(lower, length(par))
+ startmax <- rep(upper, length(par))
+ names(startmin) <- par
+ names(startmax) <- par
+ startmin["a0"] <- ifelse(is.na(lower),NA,0)
+ startmax["a0"] <- ifelse(is.na(upper),NA,1000)
+ if (!is.na(jumps)){
+ boundsJump <- jumpBounds(jumps = jumps, lower = lower, upper = upper)
+ for (i in par[par %in% names(boundsJump$lower)]){
+ startmin[[i]] <- boundsJump$lower[[i]]
+ startmax[[i]] <- boundsJump$upper[[i]]
+ }
+ }
+ return(list(lower=as.list(startmin), upper=as.list(startmax)))
+ }
+ if (name %in% defaultModels[names(defaultModels) == "CARMA"]){
+ par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter
+ par <- unique(c(par at drift, par at jump, par at measure, par at xinit[1]))
+ startmin <- rep(lower, length(par))
+ startmax <- rep(upper, length(par))
+ names(startmin) <- par
+ names(startmax) <- par
+ if (!is.na(jumps)){
+ boundsJump <- jumpBounds(jumps = jumps, lower = lower, upper = upper)
+ for (i in par[par %in% names(boundsJump$lower)]){
+ startmin[[i]] <- boundsJump$lower[[i]]
+ startmax[[i]] <- boundsJump$upper[[i]]
+ }
+ }
+ return(list(lower=as.list(startmin), upper=as.list(startmax)))
+ }
if (name == "Brownian Motion" | name == "Bm")
return (list(lower=list("sigma"=0, "mu"=lower), upper=list("sigma"=upper, "mu"=upper)))
if (name == "Geometric Brownian Motion" | name == "gBm")
@@ -292,16 +327,12 @@
}
-setModelByName <- function(name, jumps = NULL, p_C = NA, q_C = NA){
- if (name %in% defaultModels[names(defaultModels=="COGARCH")]){
- if (name == "Noise - Compound Poisson")
- return(yuima::setCogarch(p = p_C, q = q_C, measure = list(intensity = "lambda", df = setJumps(jumps)), measure.type = "CP", XinExpr=TRUE))
- }
+setModelByName <- function(name, jumps, AR_C = NA, MA_C = NA, XinExpr = FALSE){
if (name %in% names(isolate({usr_models$model}))){
if (isolate({usr_models$model[[name]]$class=="Diffusion process"}))
return(isolate({usr_models$model[[name]]$object}))
if (isolate({usr_models$model[[name]]$class=="Compound Poisson"}))
- return(setPoisson(intensity = isolate({usr_models$model[[name]]$intensity}), df = setJumps(jumps), solve.variable = "x"))
+ return(setPoisson(intensity = isolate({usr_models$model[[name]]$intensity}), df = setJumps(jumps = jumps), solve.variable = "x"))
}
if (name == "Brownian Motion" | name == "Bm")
return(yuima::setModel(drift="mu", diffusion="sigma", solve.variable = "x"))
@@ -321,14 +352,23 @@
return(yuima::setModel(drift="(sigma/2)^2*(beta-alpha*((x-mu)/(sqrt(delta^2+(x-mu)^2))))", diffusion="sigma", solve.variable = "x"))
if (name == "Hyperbolic (Bibby and Sorensen)" | name == "hyp2")
return(yuima::setModel(drift="0", diffusion="sigma*exp(0.5*(alpha*sqrt(delta^2+(x-mu)^2)-beta*(x-mu)))", solve.variable = "x"))
- if (name == "Power Low Intensity") return(yuima::setPoisson(intensity="alpha*t^(beta)", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Constant Intensity") return(yuima::setPoisson(intensity="lambda", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Linear Intensity") return(yuima::setPoisson(intensity="alpha+beta*t", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Exponentially Decaying Intensity") return(yuima::setPoisson(intensity="alpha*exp(-beta*t)", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Periodic Intensity") return(yuima::setPoisson(intensity="a/2*(1+cos(omega*t+phi))+b", df=setJumps(jumps), solve.variable = "x"))
+ if (name == "Power Low Intensity") return(yuima::setPoisson(intensity="alpha*t^(beta)", df=setJumps(jumps = jumps), solve.variable = "x"))
+ if (name == "Constant Intensity") return(yuima::setPoisson(intensity="lambda", df=setJumps(jumps = jumps), solve.variable = "x"))
+ if (name == "Linear Intensity") return(yuima::setPoisson(intensity="alpha+beta*t", df=setJumps(jumps = jumps), solve.variable = "x"))
+ if (name == "Exponentially Decaying Intensity") return(yuima::setPoisson(intensity="alpha*exp(-beta*t)", df=setJumps(jumps = jumps), solve.variable = "x"))
+ if (name == "Periodic Intensity") return(yuima::setPoisson(intensity="a/2*(1+cos(omega*t+phi))+b", df=setJumps(jumps = jumps), solve.variable = "x"))
+ if (name == "Cogarch(p,q)") {
+ return(yuima::setCogarch(p = MA_C, q = AR_C, measure.type = "CP", measure = list(intensity = "lambda", df = setJumps(jumps = "Gaussian")), XinExpr = XinExpr, Cogarch.var="y", V.var="v", Latent.var="x", ma.par="MA", ar.par="AR"))
+ }
+ if (name == "Carma Noise: Compound Poisson") {
+ jumpsGlobalEnv <<- jumps
+ model <- yuima::setCarma(p = AR_C, q = MA_C, ma.par="MA", ar.par="AR", measure = list(intensity = "lambda", df = list("dnorm(z, 0, 1)")), scale.par = "sigma_jump", loc.par = "mu_jump", measure.type = "CP", XinExpr = XinExpr)#df = setJumps(jumps = jumpsGlobalEnv)), measure.type = "CP", XinExpr = XinExpr)
+ rm(jumpsGlobalEnv, envir = globalenv())
+ return(model)
+ }
}
-printModelLatex <- function(names, process, jumps = NULL){
+printModelLatex <- function(names, process, jumps = NA){
if (process=="Diffusion process"){
mod <- ""
for (name in names){
@@ -380,6 +420,9 @@
if (process=="COGARCH"){
return(paste("$$","COGARCH(p,q)","$$"))
}
+ if (process=="CARMA"){
+ return(paste("$$","CARMA(p,q)","$$"))
+ }
}
@@ -469,13 +512,23 @@
return(list("Estimate"= param, "Std. Error"=StdErr))
}
+qmleGUI <- function(upper, lower, ...){
+ if(length(upper)!=0 & length(lower)!=0)
+ return (qmle(upper = upper, lower = lower, ...))
+ if(length(upper)!=0 & length(lower)==0)
+ return (qmle(upper = upper, ...))
+ if(length(upper)==0 & length(lower)!=0)
+ return (qmle(lower = lower, ...))
+ if(length(upper)==0 & length(lower)==0)
+ return (qmle(...))
+}
-addModel <- function(modName, modClass, p_C, q_C, jumps, symbName, data, delta, start, startMin, startMax, tries, seed, method="BFGS", fixed = list(), lower, upper, joint=FALSE, aggregation=TRUE, threshold=NULL, session, anchorId){
+addModel <- function(modName, modClass, AR_C, MA_C, jumps, symbName, data, delta, start, startMin, startMax, tries, seed, method="BFGS", fixed = list(), lower, upper, joint=FALSE, aggregation=TRUE, threshold=NULL, session, anchorId, alertId){
info <- list(
class = modClass,
modName = modName,
- p = p_C,
- q = q_C,
+ AR = AR_C,
+ MA = MA_C,
jumps = ifelse(is.null(jumps),NA,jumps),
method=method,
delta = delta,
@@ -503,9 +556,9 @@
fixed <- clearNA(fixed)
lower <- clearNA(lower)
upper <- clearNA(upper)
- model <- setYuima(data = setData(data, delta = delta), model=setModelByName(name = modName, jumps = jumps, q_C = q_C, p_C = p_C))
+ model <- setYuima(data = setData(data, delta = delta), model=setModelByName(name = modName, jumps = jumps, MA_C = MA_C, AR_C = AR_C))
index(model at data@original.data) <- index(data)
- parameters <- setModelByName(name = modName, jumps = jumps, q_C = q_C, p_C = p_C)@parameter
+ parameters <- setModelByName(name = modName, jumps = jumps, MA_C = MA_C, AR_C = AR_C)@parameter
if (modName == "Geometric Brownian Motion" | modName == "gBm"){
X <- as.numeric(na.omit(Delt(data, type = "log")))
alpha <- mean(X)/delta
@@ -515,16 +568,77 @@
if (is.null(start$mu)) start$mu <- mu
QMLE <- try(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper))
if (class(QMLE)=="try-error"){
- createAlert(session = session, anchorId = anchorId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
+ createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
return()
}
}
+ else if (modClass=="CARMA") {
+ allParam <- unique(c(parameters at drift, parameters at jump, parameters at measure, parameters at xinit[1]))
+ if (all(allParam %in% c(names(start),names(fixed))))
+ QMLE <- try(qmleGUI(model, start = start, method = method, lower = lower, upper = upper, #REMOVE# fixed = fixed, joint = joint, aggregation = aggregation,
+ threshold = threshold, grideq = TRUE))
+ else {
+ miss <- allParam[!(allParam %in% c(names(start),names(fixed)))]
+ m2logL_prec <- NA
+ na_prec <- NA
+ withProgress(message = 'Step: ', value = 0, {
+ for(iter in 1:tries){
+ incProgress(1/tries, detail = paste(iter,"(/", tries ,")"))
+ for(j in 1:3){
+ for (i in miss)
+ start[[i]] <- runif(1, min = max(lower[[i]],startMin[[i]], na.rm = TRUE), max = min(upper[[i]],startMax[[i]],na.rm = TRUE))
+ QMLEtemp <- try(qmleGUI(model, start = start, method = method, lower = lower, upper = upper, #fixed = fixed, joint = joint, aggregation = aggregation,
+ threshold = threshold, grideq = TRUE))
+ if (class(QMLEtemp)!="try-error") if (all(!is.na(summary(QMLEtemp)@coef[,"Estimate"])))
+ break
+ }
+ if (class(QMLEtemp)!="try-error") if (all(!is.na(summary(QMLEtemp)@coef[,"Estimate"]))){
+ repeat{
+ m2logL <- summary(QMLEtemp)@m2logL
+ coefTable <- summary(QMLEtemp)@coef
+ for (param in rownames(coefTable))
+ start[[param]] <- as.numeric(coefTable[param,"Estimate"])
+ QMLEtemp <- try(qmleGUI(model, start = start, method = method, lower = lower, upper = upper, #fixed = fixed, joint = joint, aggregation = aggregation,
+ threshold = threshold, grideq = TRUE))
+ if (class(QMLEtemp)=="try-error") break
+ else if(summary(QMLEtemp)@m2logL>=m2logL*abs(sign(m2logL)-0.001)) break
+ }
+ if(is.na(m2logL_prec) & class(QMLEtemp)!="try-error"){
+ QMLE <- QMLEtemp
+ m2logL_prec <- summary(QMLE)@m2logL
+ na_prec <- sum(is.na(coefTable))
+ }
+ else if (class(QMLEtemp)!="try-error"){
+ if (sum(is.na(coefTable)) < na_prec){
+ QMLE <- QMLEtemp
+ m2logL_prec <- summary(QMLE)@m2logL
+ na_prec <- sum(is.na(coefTable))
+ }
+ else {
+ test <- summary(QMLEtemp)@m2logL
+ if(test < m2logL_prec & sum(is.na(coefTable))==na_prec){
+ QMLE <- QMLEtemp
+ m2logL_prec <- test
+ na_prec <- sum(is.na(coefTable))
+ }
+ }
+ }
+ }
+ if (iter==tries & class(QMLEtemp)=="try-error" & !exists("QMLE")){
+ createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
+ return()
+ }
+ }
+ })
+ }
+ }
else if (modClass=="COGARCH") {
- if (all(parameters at all %in% c(names(start),names(fixed))))
+ allParam <- unique(c(parameters at drift, parameters at xinit))
+ if (all(allParam %in% c(names(start),names(fixed))))
QMLE <- try(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #REMOVE# joint = joint, aggregation = aggregation,
threshold = threshold, grideq = TRUE))
else {
- miss <- parameters at all[!(parameters at all %in% c(names(start),names(fixed)))]
+ miss <- allParam[!(allParam %in% c(names(start),names(fixed)))]
m2logL_prec <- NA
na_prec <- NA
withProgress(message = 'Step: ', value = 0, {
@@ -545,7 +659,7 @@
for (param in rownames(coefTable))
start[[param]] <- as.numeric(coefTable[param,"Estimate"])
QMLEtemp <- try(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #joint = joint, aggregation = aggregation,
- threshold = threshold, grideq = TRUE))
+ threshold = threshold, grideq = TRUE))
if (class(QMLEtemp)=="try-error") break
else if(summary(QMLEtemp)@objFunVal>=m2logL*abs(sign(m2logL)-0.001)) break
}
@@ -571,7 +685,7 @@
}
}
if (iter==tries & class(QMLEtemp)=="try-error" & !exists("QMLE")){
- createAlert(session = session, anchorId = anchorId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
+ createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
return()
}
}
@@ -632,7 +746,7 @@
}
}
if (iter==tries & class(QMLEtemp)=="try-error" & !exists("QMLE")){
- createAlert(session = session, anchorId = anchorId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
+ createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
return()
}
}
@@ -691,7 +805,7 @@
}
}
if (iter==tries & class(QMLEtemp)=="try-error" & !exists("QMLE")){
- createAlert(session = session, anchorId = anchorId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
+ createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
return()
}
}
@@ -706,8 +820,8 @@
yuimaGUIdata$model[[symbName]][[ifelse(is.null(length(yuimaGUIdata$model[[symbName]])),1,length(yuimaGUIdata$model[[symbName]])+1)]] <<- list(
model = model,
qmle = QMLE,
- aic = ifelse(modClass!="COGARCH", AIC(QMLE), NA),
- bic = ifelse(modClass!="COGARCH", BIC(QMLE), NA),
+ aic = ifelse(!(modClass %in% c("CARMA","COGARCH")), AIC(QMLE), NA),
+ bic = ifelse(!(modClass %in% c("CARMA","COGARCH")), BIC(QMLE), NA),
info = info
)
}
@@ -734,7 +848,7 @@
-addSimulation <- function(model, symbName, info = list("simulate.from"=NA, "simulate.to"=NA,"model"=NA, "estimate.from"=NA, "estimate.to"=NA), xinit, true.parameter, nsim, saveTraj = TRUE, seed=NULL, sampling, subsampling = NULL, space.discretized = FALSE, method = "euler", session, anchorId){
+addSimulation <- function(modelYuima, symbName, info, xinit, true.parameter, nsim, data = NA, saveTraj = TRUE, seed=NULL, sampling, space.discretized = FALSE, method = "euler", session, anchorId){
if(!is.na(seed)) set.seed(seed)
if(is.na(seed)) set.seed(NULL)
if(saveTraj==TRUE){
@@ -743,16 +857,18 @@
}
if(saveTraj==FALSE){
trajectory <- NA
- hist <- vector()
+ hist <- numeric(nsim)
}
is.valid <- TRUE
+ model <- modelYuima at model
+ if (info$class=="COGARCH") incr.L <- cogarchNoise(yuima = modelYuima, param = true.parameter)$incr.L
withProgress(message = 'Simulating: ', value = 0, {
for (i in 1:nsim){
incProgress(1/nsim, detail = paste("Simulating:",i,"(/",nsim,")"))
- if(is.null(subsampling))
+ if (info$class=="COGARCH")
+ simulation <- try(yuima::simulate(object = model, increment.L = sample(x = incr.L, size = sampling at n, replace = TRUE), xinit = xinit, true.parameter = true.parameter, nsim = nsim, sampling = sampling, space.discretized = space.discretized, method = method))
+ else
simulation <- try(yuima::simulate(object = model, xinit = xinit, true.parameter = true.parameter, nsim = nsim, sampling = sampling, space.discretized = space.discretized, method = method))
- else
- simulation <- try(yuima::simulate(object = model, xinit = xinit, true.parameter = true.parameter, nsim = nsim, sampling = sampling, subsampling = subsampling, space.discretized = space.discretized, method = method))
if (class(simulation)=="try-error"){
is.valid <- FALSE
break()
@@ -761,7 +877,7 @@
if (saveTraj==TRUE)
trajectory <- merge(trajectory, simulation at data@zoo.data[[1]])
else
- hist <- c(hist, as.numeric(tail(simulation at data@zoo.data[[1]],1)))
+ hist[i] <- as.numeric(tail(simulation at data@zoo.data[[1]],1))
}
}
})
@@ -772,7 +888,7 @@
if(saveTraj==TRUE){
if(class(info$simulate.from)=="Date")
- index(trajectory) <- as.POSIXlt(24*60*60*index(trajectory)/simulation at sampling@delta*as.numeric(info$simulate.to-info$simulate.from)/(simulation at sampling@n), origin = info$simulate.from)
+ index(trajectory) <- as.POSIXct(24*60*60*index(trajectory)/simulation at sampling@delta*as.numeric(info$simulate.to-info$simulate.from)/(simulation at sampling@n), origin = info$simulate.from)
if(class(info$simulate.from)=="numeric")
index(trajectory) <- as.numeric(index(trajectory)/simulation at sampling@delta*as.numeric(info$simulate.to-info$simulate.from)/(simulation at sampling@n))
if(!is.null(colnames(trajectory)))
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-10-04 13:46:46 UTC (rev 476)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-10-07 14:28:53 UTC (rev 477)
@@ -251,19 +251,24 @@
for(i in names(usr_models$model))
if (usr_models$model[[i]]$class==input$modelClass)
choices <- c(choices, i)
- return (selectInput("model",label = "Model Name", choices = choices, multiple = TRUE))
+ return (selectInput("model",label = "Model Name", choices = choices, multiple = TRUE, selected = choices[1]))
})
output$jumps <- renderUI({
- if (input$modelClass!="Diffusion process")
+ if (input$modelClass!="Diffusion process" & input$modelClass!="COGARCH")
return(selectInput("jumps",label = "Jumps", choices = defaultJumps))
})
output$pq_C <- renderUI({
+ if (input$modelClass=="CARMA")
+ return(div(
+ column(6,numericInput("AR_C",label = "AR degree (p)", value = 2, min = 1, step = 1)),
+ column(6,numericInput("MA_C",label = "MA degree (q)", value = 1, min = 1, step = 1))
+ ))
if (input$modelClass=="COGARCH")
return(div(
- column(6,numericInput("p_C",label = "p", value = 1, min = 1, step = 1)),
- column(6,numericInput("q_C",label = "q", value = 1, min = 1, step = 1))
+ column(6,numericInput("AR_C",label = "AR degree (p)", value = 1, min = 1, step = 1)),
+ column(6,numericInput("MA_C",label = "MA degree (q)", value = 1, min = 1, step = 1))
))
})
@@ -512,52 +517,54 @@
if (is.null(deltaSettings[[symb]]))
deltaSettings[[symb]] <<- 0.01
for (modName in input$model){
- if (is.null(estimateSettings[[modName]]))
- estimateSettings[[modName]] <<- list()
- if (is.null(estimateSettings[[modName]][[symb]]))
- estimateSettings[[modName]][[symb]] <<- list()
- if (is.null(estimateSettings[[modName]][[symb]][["fixed"]]) | isolate({input$modelClass!="Diffusion process"}))
- estimateSettings[[modName]][[symb]][["fixed"]] <<- list()
- if (is.null(estimateSettings[[modName]][[symb]][["start"]]) | isolate({input$modelClass!="Diffusion process"}))
- estimateSettings[[modName]][[symb]][["start"]] <<- list()
- if (is.null(estimateSettings[[modName]][[symb]][["startMin"]]) | isolate({input$modelClass!="Diffusion process"}))
- estimateSettings[[modName]][[symb]][["startMin"]] <<- defaultBounds(name = modName,
- jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = input$jumps),
- p_C = ifelse(isolate({input$modelClass})=="COGARCH", input$p_C, NA),
- q_C = ifelse(isolate({input$modelClass})=="COGARCH", input$q_C, NA),
- lower = -100, upper = 100
- )$lower
- if (is.null(estimateSettings[[modName]][[symb]][["startMax"]]) | input$modelClass!="Diffusion process")
- estimateSettings[[modName]][[symb]][["startMax"]] <<- defaultBounds(name = modName,
- jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = input$jumps),
- p_C = ifelse(isolate({input$modelClass})=="COGARCH", input$p_C, NA),
- q_C = ifelse(isolate({input$modelClass})=="COGARCH", input$q_C, NA),
- lower = -100, upper = 100
- )$upper
- if (is.null(estimateSettings[[modName]][[symb]][["upper"]]) | input$modelClass!="Diffusion process")
- estimateSettings[[modName]][[symb]][["upper"]] <<- defaultBounds(name = modName,
- jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = input$jumps),
- p_C = ifelse(isolate({input$modelClass})=="COGARCH", input$p_C, NA),
- q_C = ifelse(isolate({input$modelClass})=="COGARCH", input$q_C, NA)
- )$upper
- if (is.null(estimateSettings[[modName]][[symb]][["lower"]]) | input$modelClass!="Diffusion process")
- estimateSettings[[modName]][[symb]][["lower"]] <<- defaultBounds(name = modName,
- jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = input$jumps),
- p_C = ifelse(isolate({input$modelClass})=="COGARCH", input$p_C, NA),
- q_C = ifelse(isolate({input$modelClass})=="COGARCH", input$q_C, NA)
- )$lower
- if (is.null(estimateSettings[[modName]][[symb]][["method"]]))
- estimateSettings[[modName]][[symb]][["method"]] <<- "L-BFGS-B"
- if (is.null(estimateSettings[[modName]][[symb]][["tries"]]))
- estimateSettings[[modName]][[symb]][["tries"]] <<- 1
- if (is.null(estimateSettings[[modName]][[symb]][["seed"]]))
- estimateSettings[[modName]][[symb]][["seed"]] <<- NA
- if (is.null(estimateSettings[[modName]][[symb]][["joint"]]))
- estimateSettings[[modName]][[symb]][["joint"]] <<- FALSE
- if (is.null(estimateSettings[[modName]][[symb]][["aggregation"]]))
- estimateSettings[[modName]][[symb]][["aggregation"]] <<- TRUE
- if (is.null(estimateSettings[[modName]][[symb]][["threshold"]]))
- estimateSettings[[modName]][[symb]][["threshold"]] <<- NA
+ if (class(try(setModelByName(modName, jumps = switch(input$modelClass, "Diffusion process" = NA, "Compound Poisson" = input$jumps, "COGARCH"=NA, "CARMA"=input$jumps), AR_C = ifelse(input$modelClass %in% c("CARMA","COGARCH"), input$AR_C, NA), MA_C = ifelse(input$modelClass %in% c("CARMA","COGARCH"), input$MA_C, NA))))!="try-error"){
+ if (is.null(estimateSettings[[modName]]))
+ estimateSettings[[modName]] <<- list()
+ if (is.null(estimateSettings[[modName]][[symb]]))
+ estimateSettings[[modName]][[symb]] <<- list()
+ if (is.null(estimateSettings[[modName]][[symb]][["fixed"]]) | isolate({input$modelClass!="Diffusion process"}))
+ estimateSettings[[modName]][[symb]][["fixed"]] <<- list()
+ if (is.null(estimateSettings[[modName]][[symb]][["start"]]) | isolate({input$modelClass!="Diffusion process"}))
+ estimateSettings[[modName]][[symb]][["start"]] <<- list()
+ if (is.null(estimateSettings[[modName]][[symb]][["startMin"]]) | isolate({input$modelClass!="Diffusion process"}))
+ estimateSettings[[modName]][[symb]][["startMin"]] <<- defaultBounds(name = modName,
+ jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = NA, "CARMA" = input$jumps),
+ AR_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$AR_C, NA),
+ MA_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$MA_C, NA),
+ lower = -100, upper = 100
+ )$lower
+ if (is.null(estimateSettings[[modName]][[symb]][["startMax"]]) | input$modelClass!="Diffusion process")
+ estimateSettings[[modName]][[symb]][["startMax"]] <<- defaultBounds(name = modName,
+ jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = NA, "CARMA" = input$jumps),
+ AR_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$AR_C, NA),
+ MA_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$MA_C, NA),
+ lower = -100, upper = 100
+ )$upper
+ if (is.null(estimateSettings[[modName]][[symb]][["upper"]]) | input$modelClass!="Diffusion process")
+ estimateSettings[[modName]][[symb]][["upper"]] <<- defaultBounds(name = modName,
+ jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = NA, "CARMA" = input$jumps),
+ AR_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$AR_C, NA),
+ MA_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$MA_C, NA)
+ )$upper
+ if (is.null(estimateSettings[[modName]][[symb]][["lower"]]) | input$modelClass!="Diffusion process")
+ estimateSettings[[modName]][[symb]][["lower"]] <<- defaultBounds(name = modName,
+ jumps = switch(isolate({input$modelClass}), "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = NA, "CARMA" = input$jumps),
+ AR_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$AR_C, NA),
+ MA_C = ifelse(isolate({input$modelClass}) %in% c("CARMA","COGARCH"), input$MA_C, NA)
+ )$lower
+ if (is.null(estimateSettings[[modName]][[symb]][["method"]]))
+ estimateSettings[[modName]][[symb]][["method"]] <<- "L-BFGS-B"
+ if (is.null(estimateSettings[[modName]][[symb]][["tries"]]))
+ estimateSettings[[modName]][[symb]][["tries"]] <<- 1
+ if (is.null(estimateSettings[[modName]][[symb]][["seed"]]))
+ estimateSettings[[modName]][[symb]][["seed"]] <<- NA
+ if (is.null(estimateSettings[[modName]][[symb]][["joint"]]))
+ estimateSettings[[modName]][[symb]][["joint"]] <<- FALSE
+ if (is.null(estimateSettings[[modName]][[symb]][["aggregation"]]))
+ estimateSettings[[modName]][[symb]][["aggregation"]] <<- TRUE
+ if (is.null(estimateSettings[[modName]][[symb]][["threshold"]]))
+ estimateSettings[[modName]][[symb]][["threshold"]] <<- NA
+ }
}
}
})
@@ -565,7 +572,7 @@
observe({
valid <- TRUE
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 477
More information about the Yuima-commits
mailing list