[Yuima-commits] r466 - in pkg/yuimaGUI: . inst/yuimaGUI inst/yuimaGUI/www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Sep 22 17:25:11 CEST 2016
Author: phoenix844
Date: 2016-09-22 17:25:10 +0200 (Thu, 22 Sep 2016)
New Revision: 466
Modified:
pkg/yuimaGUI/DESCRIPTION
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
pkg/yuimaGUI/inst/yuimaGUI/www/custom.css
Log:
added COGARACH estimation
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2016-09-20 16:05:02 UTC (rev 465)
+++ pkg/yuimaGUI/DESCRIPTION 2016-09-22 15:25:10 UTC (rev 466)
@@ -1,9 +1,10 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the Yuima Package
-Version: 0.7.2
+Version: 0.7.3
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), DT, shinyjs, shiny, shinydashboard, shinyBS, yuima, quantmod, sde
+Depends: R(>= 3.0.0)
+Imports: DT (>= 0.2), shinyjs, shiny, shinydashboard, shinyBS, yuima, quantmod, sde
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-09-20 16:05:02 UTC (rev 465)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-09-22 15:25:10 UTC (rev 466)
@@ -1,11 +1,11 @@
+require(DT)
+require(shinyjs)
+require(yuima)
require(shiny)
-require(DT)
require(sde)
require(quantmod)
require(shinydashboard)
require(shinyBS)
-require(yuima)
-require(shinyjs)
#require(corrplot)
@@ -138,18 +138,19 @@
if (symb %in% names(yuimaGUIdata$series))
alreadyIn <- c(alreadyIn, symb)
else{
- temp <- data.frame("Index" = rownames(x), symb = as.numeric(as.character(x[,symb])))
+ temp <- data.frame("Index" = rownames(x), "symb" = as.numeric(as.character(x[,symb])))
temp <- temp[complete.cases(temp), ]
rownames(temp) <- temp[,"Index"]
+ colnames(temp) <- c("Index", symb)
if (typeIndex=="numeric"){
- test <- try(read.zoo(temp, FUN=as.numeric))
+ test <- try(read.zoo(temp, FUN=as.numeric, drop = FALSE))
if (class(test)!="try-error")
yuimaGUIdata$series[[symb]] <<- test
else
err <- c(err, symb)
}
else{
- test <- try(read.zoo(temp, FUN=as.Date, format = typeIndex))
+ test <- try(read.zoo(temp, FUN=as.Date, format = typeIndex, drop = FALSE))
if (class(test)!="try-error")
yuimaGUIdata$series[[symb]] <<- test
else
@@ -192,14 +193,15 @@
"Compound Poisson" = "Linear Intensity",
"Compound Poisson" = "Power Low Intensity",
"Compound Poisson" = "Exponentially Decaying Intensity",
- "Compound Poisson" = "Periodic Intensity"
+ "Compound Poisson" = "Periodic Intensity",
+ "COGARCH" = "Noise - Compound Poisson"
)
defaultJumps <- c("Gaussian", "Uniform")
-defaultBounds <- function(name, jumps = NULL, lower = NA, upper = NA){
- if (name %in% names(isolate({usr_models$model}))){
- par <- setModelByName(name = name, jumps = jumps)@parameter at all
+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
startmin <- rep(lower, length(par))
startmax <- rep(upper, length(par))
names(startmin) <- par
@@ -279,6 +281,7 @@
estimateJumps <- function(data, jumps, threshold = 0){
if (is.na(threshold)) threshold <- 0
+ data <- as.numeric(data)
x <- na.omit(diff(data))
x <- x[abs(x) > threshold]
param <- switch (jumps,
@@ -289,7 +292,11 @@
}
-setModelByName <- function(name, jumps = NULL){
+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))
+ }
if (name %in% names(isolate({usr_models$model}))){
if (isolate({usr_models$model[[name]]$class=="Diffusion process"}))
return(isolate({usr_models$model[[name]]$object}))
@@ -370,6 +377,9 @@
}
return(paste("$$",mod,"$$"))
}
+ if (process=="COGARCH"){
+ return(paste("$$","COGARCH(p,q)","$$"))
+ }
}
@@ -460,10 +470,12 @@
}
-addModel <- function(modName, modClass, 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, 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){
info <- list(
class = modClass,
modName = modName,
+ p = p_C,
+ q = q_C,
jumps = ifelse(is.null(jumps),NA,jumps),
method=method,
delta = delta,
@@ -491,44 +503,88 @@
fixed <- clearNA(fixed)
lower <- clearNA(lower)
upper <- clearNA(upper)
- model <- setYuima(data = setData(data, delta = delta), model=setModelByName(name = modName, jumps = jumps))
- parameters <- setModelByName(name = modName, jumps = jumps)@parameter
- if (!is.null(jumps)){
- jumpParam <- estimateJumps(data = data, jumps = jumps, threshold = threshold)
- for (i in names(jumpParam)) if (is.null(start[[i]])) start[[i]] <- jumpParam[[i]]
- }
- if (all(parameters at all %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))
+ model <- setYuima(data = setData(data, delta = delta), model=setModelByName(name = modName, jumps = jumps, q_C = q_C, p_C = p_C))
+ index(model at data@original.data) <- index(data)
+ parameters <- setModelByName(name = modName, jumps = jumps, q_C = q_C, p_C = p_C)@parameter
+ if (modName == "Geometric Brownian Motion" | modName == "gBm"){
+ X <- as.numeric(na.omit(Delt(data, type = "log")))
+ alpha <- mean(X)/delta
+ sigma <- sqrt(var(X)/delta)
+ mu <- alpha +0.5*sigma^2
+ if (is.null(start$sigma)) start$sigma <- sigma
+ 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, 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))))
+ 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)))]
+ 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(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #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)@objFunVal
+ coefTable <- summary(QMLEtemp)@coef
+ 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))
+ if (class(QMLEtemp)=="try-error") break
+ else if(summary(QMLEtemp)@objFunVal>=m2logL*abs(sign(m2logL)-0.001)) break
+ }
+ if(is.na(m2logL_prec) & class(QMLEtemp)!="try-error"){
+ QMLE <- QMLEtemp
+ m2logL_prec <- summary(QMLE)@objFunVal
+ 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)@objFunVal
+ na_prec <- sum(is.na(coefTable))
+ }
+ else {
+ test <- summary(QMLEtemp)@objFunVal
+ 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, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
+ return()
+ }
+ }
+ })
+ }
}
- else{
- if (modName == "Geometric Brownian Motion" | modName == "gBm"){
- X <- as.numeric(na.omit(Delt(data, type = "log")))
- alpha <- mean(X)/delta
- sigma <- sqrt(var(X)/delta)
- mu <- alpha +0.5*sigma^2
- if (is.null(start$sigma)) start$sigma <- sigma
- if (is.null(start$mu)) start$mu <- mu
+ else if (modClass == "Compound Poisson") {
+ jumpParam <- estimateJumps(data = data, jumps = jumps, threshold = threshold)
+ for (i in names(jumpParam)) if (is.null(start[[i]])) start[[i]] <- jumpParam[[i]]
+ if (all(parameters at all %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))
- 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")
- return()
- }
- #} else if (modName == "Brownian Motion" | modName == "Bm") {
- #Delta <- ifelse(is.null(delta), 1, delta)
- #X <- as.numeric(na.omit(Delt(data, type = "arithmetic")))
- #mu <- mean(X)/Delta
- #sigma <- sqrt(var(X)/Delta)
- #if (is.null(start$sigma)) start$sigma <- sigma
- #if (is.null(start$mu)) start$mu <- mu
- #QMLE <- qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #joint = joint, aggregation = aggregation,
- # threshold = threshold)
- } else {
+ threshold = threshold))
+ else {
miss <- parameters at all[!(parameters at all %in% c(names(start),names(fixed)))]
m2logL_prec <- NA
na_prec <- NA
@@ -539,22 +595,20 @@
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(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #joint = joint, aggregation = aggregation,
- threshold = threshold))
- if (class(QMLEtemp)!="try-error")
+ threshold = threshold))
+ if (class(QMLEtemp)!="try-error") if (all(!is.na(summary(QMLEtemp)@coef[,"Estimate"])))
break
}
- if (class(QMLEtemp)!="try-error"){
+ 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 names(start))
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))
- if (class(QMLEtemp)=="try-error")
- break
- else if (summary(QMLEtemp)@m2logL>=m2logL*abs(sign(m2logL)-0.001))
- break
+ threshold = threshold))
+ 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
@@ -567,11 +621,73 @@
m2logL_prec <- summary(QMLE)@m2logL
na_prec <- sum(is.na(coefTable))
}
- else if(summary(QMLEtemp)@m2logL < m2logL_prec & sum(is.na(coefTable))==na_prec){
+ 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, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
+ return()
+ }
+ }
+ })
+ }
+ }
+ else {
+ if (all(parameters at all %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))
+ else {
+ miss <- parameters at all[!(parameters at all %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(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #joint = joint, aggregation = aggregation,
+ threshold = threshold))
+ 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 names(start))
+ 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))
+ 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")){
@@ -583,14 +699,15 @@
}
}
+
if(!exists("QMLE"))
return()
yuimaGUIdata$model[[symbName]][[ifelse(is.null(length(yuimaGUIdata$model[[symbName]])),1,length(yuimaGUIdata$model[[symbName]])+1)]] <<- list(
model = model,
qmle = QMLE,
- aic = AIC(QMLE),
- bic = BIC(QMLE),
+ aic = ifelse(modClass!="COGARCH", AIC(QMLE), NA),
+ bic = ifelse(modClass!="COGARCH", BIC(QMLE), NA),
info = info
)
}
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-09-20 16:05:02 UTC (rev 465)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-09-22 15:25:10 UTC (rev 466)
@@ -54,7 +54,7 @@
})
###Display available data
- output$database1 <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = TRUE, deferRender = FALSE, dom = 'frtiS'), extensions = 'Scroller', selection = "multiple", rownames = FALSE,{
+ output$database1 <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', selection = "multiple", rownames = FALSE,{
if (length(yuimaGUItable$series)!=0)
return(yuimaGUItable$series)
})
@@ -216,7 +216,7 @@
})
###Display data available
- output$database2 <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = TRUE, deferRender = FALSE, dom = 'frtiS'), extensions = 'Scroller', selection = "multiple", rownames = FALSE,{
+ output$database2 <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', selection = "multiple", rownames = FALSE,{
if (length(yuimaGUItable$series)!=0)
return (yuimaGUItable$series)
})
@@ -258,6 +258,14 @@
if (input$modelClass!="Diffusion process")
return(selectInput("jumps",label = "Jumps", choices = defaultJumps))
})
+
+ output$pq_C <- renderUI({
+ 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))
+ ))
+ })
###Print last selected model in Latex
output$PrintModelLatex <- renderUI({
@@ -357,7 +365,7 @@
###Display Selected Data
output$database4 <- DT::renderDataTable(options=list(order = list(1, 'desc'), scrollY = 150, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = FALSE, selection = "multiple",{
- if (length(rownames(seriesToEstimate$table))==0){
+ if (nrow(seriesToEstimate$table)==0){
NoData <- data.frame("Symb"=NA,"Select some data from the table beside"=NA, check.names = FALSE)
return(NoData[-1,])
}
@@ -401,8 +409,8 @@
observe({
- shinyjs::toggle(id="plotsRangeErrorMessage", condition = length(rownames(seriesToEstimate$table))==0)
- shinyjs::toggle(id="plotsRangeAll", condition = length(rownames(seriesToEstimate$table))!=0)
+ shinyjs::toggle(id="plotsRangeErrorMessage", condition = nrow(seriesToEstimate$table)==0)
+ shinyjs::toggle(id="plotsRangeAll", condition = nrow(seriesToEstimate$table)!=0)
})
###Display charts: series and its increments
@@ -513,13 +521,31 @@
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), lower = -100, upper = 100)$lower
+ 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), lower = -100, upper = 100)$upper
+ 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))$upper
+ 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))$lower
+ 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"]]))
@@ -538,13 +564,13 @@
observe({
valid <- TRUE
- if (is.null(rownames(seriesToEstimate$table)) | is.null(input$model)) valid <- FALSE
+ if (nrow(seriesToEstimate$table)==0 | is.null(input$model)) valid <- FALSE
else if (input$modelClass!="Diffusion process") if (is.null(input$jumps)) valid <- FALSE
shinyjs::toggle(id="advancedSettingsAll", condition = valid)
shinyjs::toggle(id="advancedSettingsErrorMessage", condition = !valid)
})
output$advancedSettingsSeries <- renderUI({
- if (!is.null(rownames(seriesToEstimate$table)))
+ if (nrow(seriesToEstimate$table)!=0)
selectInput(inputId = "advancedSettingsSeries", label = "Series", choices = rownames(seriesToEstimate$table))
})
output$advancedSettingsDelta <- renderUI({
@@ -558,7 +584,7 @@
output$advancedSettingsParameter <- renderUI({
if (!is.null(input$model))
if (!is.null(input$advancedSettingsModel))
- selectInput(inputId = "advancedSettingsParameter", label = "Parameter", choices = setModelByName(input$advancedSettingsModel, jumps = switch(input$modelClass, "Diffusion process" = NULL, "Compound Poisson" = input$jumps))@parameter at all)
+ selectInput(inputId = "advancedSettingsParameter", label = "Parameter", choices = setModelByName(input$advancedSettingsModel, jumps = switch(input$modelClass, "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH"=input$jumps), p_C = ifelse(input$modelClass=="COGARCH", input$p_C, NA), q_C = ifelse(input$modelClass=="COGARCH", input$q_C, NA))@parameter at all)
})
#REMOVE# output$advancedSettingsFixed <- renderUI({
#REMOVE# if (!is.null(input$advancedSettingsModel) & !is.null(input$advancedSettingsSeries) & !is.null(input$advancedSettingsParameter))
@@ -686,7 +712,7 @@
###Estimate models
observeEvent(input$EstimateModels,{
valid <- TRUE
- if(is.null(input$model) | length(rownames(seriesToEstimate$table))==0 | is.null(rownames(seriesToEstimate$table))) valid <- FALSE
+ if(is.null(input$model) | nrow(seriesToEstimate$table)==0) valid <- FALSE
else if (input$modelClass!="Diffusion process" & is.null(input$jumps)) valid <- FALSE
if(!valid){
createAlert(session = session, anchorId = "modelsAlert", alertId = "modelsAlert_err", content = "Select some series and models to estimate", style = "warning")
@@ -696,18 +722,21 @@
for (modName in input$model){
for (i in rownames(seriesToEstimate$table)){
symb <- as.character(seriesToEstimate$table[i,"Symb"])
- incProgress(1/(length(input$model)*length(rownames(seriesToEstimate$table))), detail = paste(symb,"-",modName))
+ incProgress(1/(length(input$model)*nrow(seriesToEstimate$table)), detail = paste(symb,"-",modName))
data <- getData(symb)
start <- as.character(seriesToEstimate$table[i,"From"])
end <- as.character(seriesToEstimate$table[i,"To"])
- if (class(index(data))=="numeric")
- data <- window(data, start = as.numeric(start), end = as.numeric(end))
+ times <- index(data)
+ if (class(times)=="numeric")
+ data <- data[(times >= as.numeric(start)) & (times <= as.numeric(end)), , drop = FALSE]
else
- data <- window(data, start = start, end = end)
+ data <- data[(times >= start) & (times <= end), , drop = FALSE]
addModel(
modName = modName,
modClass = input$modelClass,
- jumps = switch(input$modelClass, "Diffusion process" = NULL, "Compound Poisson" = input$jumps),
+ p_C = ifelse(input$modelClass=="COGARCH", input$p_C, NA),
+ q_C = ifelse(input$modelClass=="COGARCH", input$q_C, NA),
+ jumps = switch(input$modelClass, "Diffusion process" = NULL, "Compound Poisson" = input$jumps, "COGARCH" = input$jumps),
symbName = symb,
data = data,
delta = deltaSettings[[symb]],
@@ -735,7 +764,7 @@
observe({
valid <- TRUE
- if(is.null(input$model) | length(rownames(seriesToEstimate$table))==0 | is.null(rownames(seriesToEstimate$table))) valid <- FALSE
+ if(is.null(input$model) | nrow(seriesToEstimate$table)==0) valid <- FALSE
else if (input$modelClass!="Diffusion process" & is.null(input$jumps)) valid <- FALSE
if(valid) closeAlert(session, alertId = "modelsAlert_err")
})
@@ -754,7 +783,7 @@
})
###Display estimated models
- output$databaseModels <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = TRUE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
+ output$databaseModels <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
if (length(yuimaGUItable$model)==0){
NoData <- data.frame("Symb"=NA,"Here will be stored models you estimate in the previous tabs"=NA, check.names = FALSE)
return(NoData[-1,])
@@ -901,7 +930,7 @@
########################
########################
- output$simulate_databaseModels <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = TRUE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "multiple",{
+ output$simulate_databaseModels <- DT::renderDataTable(options=list(scrollY = 200, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "multiple",{
if (length(yuimaGUItable$model)==0){
NoData <- data.frame("Symb"=NA,"Please estimate some models first (section Modelling)"=NA, check.names = FALSE)
return(NoData[-1,])
@@ -1375,7 +1404,7 @@
})
###Create simulations table
- output$simulate_monitor_table <- DT::renderDataTable(options=list(scrollY = 200, scrollX=TRUE, scrollCollapse = TRUE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
+ output$simulate_monitor_table <- DT::renderDataTable(options=list(scrollY = 200, scrollX=TRUE, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
if (length(yuimaGUItable$simulation)==0){
NoData <- data.frame("Symb"=NA,"Here will be stored simulations you run in the previous tabs"=NA, check.names = FALSE)
return(NoData[-1,])
@@ -1951,7 +1980,7 @@
########################
########################
- output$hedging_databaseModels <- DT::renderDataTable(options=list(scrollY = 200, scrollX = TRUE, scrollCollapse = TRUE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
+ output$hedging_databaseModels <- DT::renderDataTable(options=list(scrollY = 200, scrollX = TRUE, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
if (length(yuimaGUItable$model)==0){
NoData <- data.frame("Symb"=NA,"Please estimate some models first (section Modelling)"=NA, check.names = FALSE)
return(NoData[-1,])
@@ -2030,7 +2059,7 @@
else createAlert(session, anchorId = "hedging_alert", alertId = "hedging_alert_selectRow", content = "Please select a model to simulate the evolution of the underlying asset", style = "error")
})
- output$hedging_table_results <- DT::renderDataTable(options=list(scrollX=TRUE, scrollY = 200, scrollCollapse = TRUE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
+ output$hedging_table_results <- DT::renderDataTable(options=list(scrollX=TRUE, scrollY = 200, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = TRUE, selection = "single",{
if (length(yuimaGUItable$hedging)==0){
NoData <- data.frame("Symb"=NA, "Here will be stored simulations you run in the previous tab"=NA, check.names = FALSE)
return(NoData[-1,])
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 466
More information about the Yuima-commits
mailing list