[Yuima-commits] r650 - in pkg/yuimaGUI: . inst/yuimaGUI inst/yuimaGUI/server inst/yuimaGUI/server/eda inst/yuimaGUI/server/modeling inst/yuimaGUI/server/simulation inst/yuimaGUI/ui/eda inst/yuimaGUI/ui/home inst/yuimaGUI/ui/modeling inst/yuimaGUI/ui/simulation
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 21 17:12:18 CEST 2018
Author: phoenix844
Date: 2018-05-21 17:12:17 +0200 (Mon, 21 May 2018)
New Revision: 650
Modified:
pkg/yuimaGUI/DESCRIPTION
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R
pkg/yuimaGUI/inst/yuimaGUI/server/functions.R
pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_results.R
pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_start_estimation.R
pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_results.R
pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R
pkg/yuimaGUI/inst/yuimaGUI/server/settings.R
pkg/yuimaGUI/inst/yuimaGUI/server/simulation/multivariate_non_estimated.R
pkg/yuimaGUI/inst/yuimaGUI/server/simulation/univariate_estimated.R
pkg/yuimaGUI/inst/yuimaGUI/server/simulation/univariate_non_estimated.R
pkg/yuimaGUI/inst/yuimaGUI/ui/eda/changepoint.R
pkg/yuimaGUI/inst/yuimaGUI/ui/home/home.R
pkg/yuimaGUI/inst/yuimaGUI/ui/modeling/models.R
pkg/yuimaGUI/inst/yuimaGUI/ui/modeling/multi_models.R
pkg/yuimaGUI/inst/yuimaGUI/ui/simulation/univariate.R
Log:
ppr
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/DESCRIPTION 2018-05-21 15:12:17 UTC (rev 650)
@@ -1,10 +1,10 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the 'yuima' Package
-Version: 1.2.0
+Version: 1.2.2
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, ggplot2, plotly
\ No newline at end of file
+Imports: DT (>= 0.2), shinyjs, shiny, shinydashboard, shinyBS, yuima, quantmod, sde, ggplot2, plotly, ghyp
\ No newline at end of file
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -8,26 +8,59 @@
suppressMessages(require(shinyBS))
suppressMessages(require(ggplot2))
suppressMessages(require(plotly))
+suppressMessages(require(ghyp))
-if(!exists("yuimaGUIdata"))
- yuimaGUIdata <- reactiveValues(series=list(),
- model=list(), multimodel=list(),
- usr_model = list(), usr_multimodel = list(),
- simulation=list(), multisimulation=list(),
- usr_simulation = list(), usr_multisimulation = list(),
- cp=list(),
- cpYuima=list(),
- llag = list(),
- cluster = list(),
- hedging = list())
-
+# if(!exists("yuimaGUIdata"))
+# yuimaGUIdata <- reactiveValues(series=list(),
+# model=list(), multimodel=list(),
+# usr_model = list(), usr_multimodel = list(),
+# simulation=list(), multisimulation=list(),
+# usr_simulation = list(), usr_multisimulation = list(),
+# cp=list(),
+# cpYuima=list(),
+# llag = list(),
+# cluster = list(),
+# hedging = list())
+
if(is.null(getOption("yuimaGUItheme"))) options(yuimaGUItheme = "black")
-# getSimulation <- function(symb, n = 1){
-# return(isolate({yuimaGUIdata$simulation[[symb]][[n]]}))
-# }
-#
-# getSeries <- function(symb){
-# return(isolate({yuimaGUIdata$series[[symb]]}))
-# }
+#NIG distribution
+dNIG.gui <- function(x, alpha, delta, beta, mu){
+ g <- NIG.ad(alpha = alpha, delta = delta, beta = beta, mu = mu)
+ dghyp(x = x, object = g)
+}
+rNIG.gui <- function(n, alpha, delta, beta, mu){
+ g <- NIG.ad(alpha = alpha, delta = delta, beta = beta, mu = mu)
+ rghyp(n = n, object = g)
+}
+
+#hyp distribution
+dhyp.gui <- function(x, alpha, delta, beta, mu){
+ g <- hyp.ad(alpha = alpha, delta = delta, beta = beta, mu = mu)
+ dghyp(x = x, object = g)
+}
+rhyp.gui <- function(n, alpha, delta, beta, mu){
+ g <- hyp.ad(alpha = alpha, delta = delta, beta = beta, mu = mu)
+ rghyp(n = n, object = g)
+}
+
+#VG distribution
+dVG.gui <- function(x, lambda, alpha, beta, mu){
+ g <- VG.ad(lambda = lambda, alpha = alpha, beta = beta, mu = mu)
+ dghyp(x = x, object = g)
+}
+rVG.gui <- function(n, lambda, alpha, beta, mu){
+ g <- VG.ad(lambda = lambda, alpha = alpha, beta = beta, mu = mu)
+ rghyp(n = n, object = g)
+}
+
+#ghyp distribution
+dghyp.gui <- function(x, lambda, alpha, delta, beta, mu){
+ g <- ghyp.ad(lambda = lambda, alpha = alpha, delta = delta, beta = beta, mu = mu)
+ dghyp(x = x, object = g)
+}
+rghyp.gui <- function(n, lambda, alpha, delta, beta, mu){
+ g <- ghyp.ad(lambda = lambda, alpha = alpha, delta = delta, beta = beta, mu = mu)
+ rghyp(n = n, object = g)
+}
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -296,7 +296,8 @@
})
output$parametric_modal_parameter <- renderUI({
if (!is.null(input$parametric_modal_model)){
- par <- setModelByName(input$parametric_modal_model, jumps = NA, AR_C = NA, MA_C = NA)@parameter at all
+ mod <- setModelByName(input$parametric_modal_model, jumps = NA, AR_C = NA, MA_C = NA)
+ par <- getAllParams(mod, 'Diffusion process')
selectInput(inputId = "parametric_modal_parameter", label = "Parameter", choices = par)
}
})
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/functions.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/functions.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/functions.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -93,7 +93,8 @@
defaultBounds <- function(name, delta, strict, jumps = NA, AR_C = NA, MA_C = NA, data, intensity = NULL, threshold = NULL){
lastPrice = last(data)
if ( isUserDefined(name) ){
- par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter at all
+ mod <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)
+ par <- getAllParams(mod, yuimaGUIdata$usr_model[[name]]$class)
if(strict==TRUE){
lower <- rep(NA, length(par))
upper <- rep(NA, length(par))
@@ -117,9 +118,23 @@
}
return(list(lower=as.list(lower), upper=as.list(upper)))
}
+ if (name %in% defaultModels[names(defaultModels) == "Point Process"]){
+ mod <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)
+ par <- getAllParams(mod, "Point Process")
+ if(strict==TRUE){
+ lower <- rep(NA, length(par))
+ upper <- rep(NA, length(par))
+ } else {
+ lower <- rep(0, length(par))
+ upper <- rep(10, length(par))
+ }
+ names(lower) <- par
+ names(upper) <- par
+ return(list(lower=as.list(lower), upper=as.list(upper)))
+ }
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))
+ mod <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)
+ par <- getAllParams(mod, "COGARCH")
if(strict==TRUE){
lower <- rep(NA, length(par))
upper <- rep(NA, length(par))
@@ -132,8 +147,8 @@
return(list(lower=as.list(lower), upper=as.list(upper)))
}
if (name %in% defaultModels[names(defaultModels) == "CARMA"]){
- par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter
- par <- par at drift
+ mod <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)
+ par <- getAllParams(mod, "CARMA")
if(strict==TRUE){
lower <- rep(NA, length(par))
upper <- rep(NA, length(par))
@@ -236,7 +251,8 @@
else return(list(lower=c(list("mu"=-1, "sigma"=0), boundsJump$lower, boundsIntensity$lower),upper=c(list("mu"=1, "sigma"=1), boundsJump$upper, boundsIntensity$upper)))
}
if (name == "Correlated Brownian Motion"){
- par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C, dimension = ncol(data))@parameter
+ mod <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C, dimension = ncol(data))
+ par <- getAllParams(mod, "Diffusion process", FALSE)
drift <- rep(NA, length(par at drift))
diffusion <- rep(NA, length(par at diffusion))
names(drift) <- par at drift
@@ -267,22 +283,44 @@
}
}
+
+
setJumps <- function(jumps){
if(is.na(jumps)) return("")
- else switch (jumps,
- "Gaussian" = list("dnorm(z, mean = mu_jump, sd = sigma_jump)"),
- "Uniform" = list("dunif(z, min = a_jump, max = b_jump)")
- )
+ if(jumps=='Gaussian') {
+ return(list("dnorm(z, mean = mu_jump, sd = sigma_jump)"))
+ }
+ if(jumps=='Uniform') {
+ return(list("dunif(z, min = a_jump, max = b_jump)"))
+ }
+ if(jumps=='Inverse Gaussian') {
+ return(list("dIG(z, delta = delta_jump, gamma = gamma_jump)"))
+ }
+ if(jumps=='Normal Inverse Gaussian') {
+ return(list("dNIG.gui(z, alpha = alpha_jump, beta = beta_jump, delta = delta_jump, mu = mu_jump)"))
+ }
+ if(jumps=='Hyperbolic') {
+ return(list("dhyp.gui(z, alpha = alpha_jump, beta = beta_jump, delta = delta_jump, mu = mu_jump)"))
+ }
+ if(jumps=='Student t') {
+ return(list("dt(z, df = nu_jump, ncp = mu_jump)"))
+ }
+ if(jumps=='Variance Gamma') {
+ return(list("dVG.gui(z, lambda = lambda_jump, alpha = alpha_jump, beta = beta_jump, mu = mu_jump)"))
+ }
+ if(jumps=='Generalized Hyperbolic') {
+ return(list("dghyp.gui(z, lambda = lambda_jump, alpha = alpha_jump, delta = delta_jump, beta = beta_jump, mu = mu_jump)"))
+ }
}
jumpBounds <- function(jumps, data, strict, threshold = 0){
+ x <- na.omit(diff(data))
+ x <- x[abs(x)>threshold]
+ x <- x-sign(x)*threshold
switch(jumps,
"Gaussian" = {
if(strict==TRUE) return(list(lower=list("mu_jump"=NA, "sigma_jump"=0), upper=list("mu_jump"=NA, "sigma_jump"=NA)))
else {
- x <- na.omit(diff(data))
- x <- x[abs(x)>threshold]
- x <- x-sign(x)*threshold
mu <- mean(x)
s <- sd(x)
return(list(lower=list("mu_jump"=mu, "sigma_jump"=s), upper=list("mu_jump"=mu, "sigma_jump"=s)))
@@ -291,13 +329,101 @@
"Uniform" = {
if(strict==TRUE) return(list(lower=list("a_jump"=NA, "b_jump"=NA), upper=list("a_jump"=NA, "b_jump"=NA)))
else {
- x <- na.omit(diff(data))
- x <- x[abs(x)>threshold]
- x <- x-sign(x)*threshold
a <- min(x)
b <- max(x)
return(list(lower=list("a_jump"=a, "b_jump"=b), upper=list("a_jump"=a, "b_jump"=b)))
}
+ },
+ "Inverse Gaussian" = {
+ if(strict==TRUE) return(list(lower=list("delta_jump"=NA, "gamma_jump"=NA), upper=list("delta_jump"=NA, "gamma_jump"=NA)))
+ else {
+ x <- x[x>0]
+ delta <- mean(x)
+ gamma <- delta^3/var(x)
+ return(list(lower=list("delta_jump"=delta, "gamma_jump"=gamma), upper=list("delta_jump"=delta, "gamma_jump"=gamma)))
+ }
+ },
+ "Normal Inverse Gaussian" = {
+ if(strict==TRUE) return(list(lower=list("alpha_jump"=0, "beta_jump"=NA, "delta_jump"=0, "mu_jump"=NA), upper=list("alpha_jump"=NA, "beta_jump"=NA, "delta_jump"=NA, "mu_jump"=NA)))
+ else {
+ fit <- try(coef(fit.NIGuv(x), type = 'alpha.delta'))
+ if(class(fit)!='try-error'){
+ alpha <- fit$alpha
+ beta <- fit$beta
+ delta <- fit$delta
+ mu <- fit$mu
+ } else {
+ alpha <- 1.5
+ beta <- 0
+ delta <- 1
+ mu <- mean(x)
+ }
+ return(list(lower=list("alpha_jump"=alpha, "beta_jump"=beta, "delta_jump"=delta, "mu_jump" = mu), upper=list("alpha_jump"=alpha, "beta_jump"=beta, "delta_jump"=delta, "mu_jump" = mu)))
+ }
+ },
+ "Hyperbolic" = {
+ if(strict==TRUE) return(list(lower=list("alpha_jump"=NA, "beta_jump"=NA, "delta_jump"=NA, "mu_jump"=NA), upper=list("alpha_jump"=NA, "beta_jump"=NA, "delta_jump"=NA, "mu_jump"=NA)))
+ else {
+ fit <- try(coef(fit.hypuv(x), type = 'alpha.delta'))
+ if(class(fit)!='try-error'){
+ alpha <- fit$alpha
+ beta <- fit$beta
+ delta <- fit$delta
+ mu <- fit$mu
+ } else {
+ alpha <- 1.5
+ beta <- 0
+ delta <- 1
+ mu <- mean(x)
+ }
+ return(list(lower=list("alpha_jump"=alpha, "beta_jump"=beta, "delta_jump"=delta, "mu_jump" = mu), upper=list("alpha_jump"=alpha, "beta_jump"=beta, "delta_jump"=delta, "mu_jump" = mu)))
+ }
+ },
+ "Student t" = {
+ if(strict==TRUE) return(list(lower=list("nu_jump"=0, "mu_jump"=NA), upper=list("nu_jump"=NA, "mu_jump"=NA)))
+ else {
+ mu <- mean(x)
+ nu <- 1
+ return(list(lower=list("nu_jump"=nu, "mu_jump" = mu), upper=list("nu_jump"=nu, "mu_jump" = mu)))
+ }
+ },
+ "Variance Gamma" = {
+ if(strict==TRUE) return(list(lower=list("lambda_jump"=0, "alpha_jump"=NA, "beta_jump"=NA, "mu_jump"=NA), upper=list("lambda_jump"=NA, "alpha_jump"=NA, "beta_jump"=NA, "mu_jump"=NA)))
+ else {
+ fit <- try(coef(fit.VGuv(x), type = 'alpha.delta'))
+ if(class(fit)!='try-error'){
+ lambda <- fit$lambda
+ alpha <- fit$alpha
+ beta <- fit$beta
+ mu <- fit$mu
+ } else {
+ lambda <- 1
+ alpha <- 1.5
+ beta <- 0
+ mu <- mean(x)
+ }
+ return(list(lower=list("lambda_jump"=lambda, "alpha_jump"=alpha, "beta_jump"=beta, "mu_jump" = mu), upper=list("lambda_jump"=lambda, "alpha_jump"=alpha, "beta_jump"=beta, "mu_jump" = mu)))
+ }
+ },
+ "Generalized Hyperbolic" = {
+ if(strict==TRUE) return(list(lower=list("lambda_jump"=NA, "alpha_jump"=NA, "delta_jump"=NA, "beta_jump"=NA, "mu_jump"=NA), upper=list("lambda_jump"=NA, "alpha_jump"=NA, "delta_jump"=NA, "beta_jump"=NA, "mu_jump"=NA)))
+ else {
+ fit <- try(coef(fit.ghypuv(x), type = 'alpha.delta'))
+ if(class(fit)!='try-error'){
+ lambda <- fit$lambda
+ alpha <- fit$alpha
+ delta <- fit$delta
+ beta <- fit$beta
+ mu <- fit$mu
+ } else {
+ lambda <- 0.5
+ alpha <- 1.5
+ delta <- 1
+ beta <- 0
+ mu <- mean(x)
+ }
+ return(list(lower=list("lambda_jump"=lambda, "alpha_jump"=alpha, "delta_jump"=delta, "beta_jump"=beta, "mu_jump" = mu), upper=list("lambda_jump"=lambda, "alpha_jump"=alpha, "delta_jump"=delta, "beta_jump"=beta, "mu_jump" = mu)))
+ }
}
)
}
@@ -306,7 +432,13 @@
if (!is.null(jumps)){
switch (jumps,
"Gaussian" = "Y_i \\sim N(\\mu_{jump}, \\; \\sigma_{jump})",
- "Uniform" = "Y_i \\sim Unif(a_{jump}, \\; b_{jump})"
+ "Uniform" = "Y_i \\sim Unif(a_{jump}, \\; b_{jump})",
+ "Inverse Gaussian" = "Y_i \\sim IG(\\delta_{jump}, \\; \\gamma_{jump})",
+ "Normal Inverse Gaussian" = "Y_i \\sim NIG( \\alpha_{jump}, \\; \\beta_{jump}, \\; \\delta_{jump}, \\; \\mu_{jump})",
+ "Hyperbolic" = "Y_i \\sim HYP( \\alpha_{jump}, \\; \\beta_{jump}, \\; \\delta_{jump}, \\; \\mu_{jump})",
+ "Student t" = "Y_i \\sim t( \\nu_{jump}, \\; \\mu_{jump} )",
+ "Variance Gamma" = "Y_i \\sim VG( \\lambda_{jump}, \\; \\alpha_{jump}, \\; \\beta_{jump}, \\; \\mu_{jump})",
+ "Generalized Hyperbolic" = "Y_i \\sim GH( \\lambda_{jump}, \\; \\alpha_{jump}, \\; \\beta_{jump}, \\; \\delta_{jump}, \\; \\mu_{jump})"
)
}
}
@@ -341,6 +473,7 @@
if (name == "Frac. Brownian Motion" | name == "Bm") return(yuima::setModel(drift="mu", diffusion="sigma", solve.variable = "x", hurst = NA))
if (name == "Frac. Geometric Brownian Motion" | name == "gBm") return(yuima::setModel(drift="mu*x", diffusion="sigma*x", solve.variable = "x", hurst = NA))
if (name == "Frac. Ornstein-Uhlenbeck (OU)" | name == "OU") return(yuima::setModel(drift="-theta*x", diffusion="sigma", solve.variable = "x", hurst = NA))
+ if (name == "Hawkes") return(yuima::setHawkes())
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"))
@@ -360,6 +493,29 @@
}
}
+getAllParams <- function(mod, class, all = TRUE){
+ if(is(mod)=='yuima' & class!="Point Process") mod <- mod at model
+
+ if(all==TRUE){
+ if (class=="Point Process")
+ return(mod at PPR@allparamPPR)
+ else if (class=="Fractional process")
+ return(c(mod at parameter@all, "hurst"))
+ else if (class=="COGARCH")
+ return(c(mod at parameter@drift, mod at parameter@xinit))
+ else if (class=="CARMA")
+ return(mod at parameter@drift)
+ else
+ return(mod at parameter@all)
+ } else {
+ if (class=="Point Process")
+ return(mod at PPR)
+ else
+ return(mod at parameter)
+ }
+
+}
+
printModelLatex <- function(names, process, jumps = NA, multi = FALSE, dimension = 1, symb = character(0)){
dimension <- max(dimension, 1)
if(length(symb)>0) dimension <- length(symb)
@@ -432,6 +588,16 @@
}
return(paste("$$",mod,"$$"))
}
+ if (process=="Point Process"){
+ mod <- "\\lambda_t = \\nu_1+\\int_{0}^{t_-}kern(t-s)\\mbox{d}N_s"
+ for (name in names){
+ if ( isUserDefined(name) ){
+
+ }
+ if (name == "Hawkes") mod <- paste(mod, ifelse(mod=="","","\\\\"), "kern(t-s) = c_{11}\\exp\\left[-a_{11}\\left(t-s\\right)\\right]")
+ }
+ return(paste("$$",mod,"$$"))
+ }
if (process=="Compound Poisson"){
mod <- paste("X_t = X_0+\\sum_{i=0}^{N_t} Y_i \\; : \\;\\;\\; N_t \\sim Poi\\Bigl(\\int_0^t \\lambda(t)dt\\Bigl)", ifelse(!is.null(jumps), paste(", \\;\\;\\;\\; ", latexJumps(jumps)),""))
for (name in names){
@@ -647,13 +813,19 @@
return()
}
}
- model <- try(setYuima(data = setDataGUI(data, delta = delta), model=setModelByName(name = modName, dimension = ncol(data), intensity = intensity_levy, jumps = jumps, MA_C = MA_C, AR_C = AR_C)))
+ if(modClass=='Point Process'){
+ dataObj <- setDataGUI(data, delta = delta)
+ model <- setModelByName(name = modName, dimension = ncol(data), intensity = intensity_levy, jumps = jumps, MA_C = MA_C, AR_C = AR_C)
+ model at data <- dataObj
+ } else {
+ model <- try(setYuima(data = setDataGUI(data, delta = delta), model=setModelByName(name = modName, dimension = ncol(data), intensity = intensity_levy, jumps = jumps, MA_C = MA_C, AR_C = AR_C)))
+ }
if (class(model)=="try-error"){
createAlert(session = session, anchorId = anchorId, alertId = alertId, content = "Unable to construct a synchronous grid for the data provided", style = "error")
return()
}
index(model at data@original.data) <- index(na.omit(data))
- parameters <- model at model@parameter
+ parameters <- getAllParams(model, modClass)
if (modClass == "Fractional process"){
@@ -669,11 +841,10 @@
}
}
else if (modClass=="CARMA") {
- allParam <- parameters at drift
- if (all(allParam %in% c(names(start),names(fixed))))
+ if (all(parameters %in% c(names(start),names(fixed))))
QMLE <- try(qmleGUI(model, start = start, method = method, lower = lower, upper = upper))
else {
- miss <- allParam[!(allParam %in% c(names(start),names(fixed)))]
+ miss <- parameters[!(parameters %in% c(names(start),names(fixed)))]
m2logL_prec <- NA
na_prec <- NA
withProgress(message = 'Step: ', value = 0, {
@@ -723,12 +894,11 @@
}
}
else if (modClass=="COGARCH") {
- allParam <- unique(c(parameters at drift, parameters at xinit))
- if (all(allParam %in% c(names(start),names(fixed))))
+ if (all(parameters %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, rcpp = TRUE))
else {
- miss <- allParam[!(allParam %in% c(names(start),names(fixed)))]
+ miss <- parameters[!(parameters %in% c(names(start),names(fixed)))]
m2logL_prec <- NA
na_prec <- NA
withProgress(message = 'Step: ', value = 0, {
@@ -780,11 +950,11 @@
}
}
else if (modClass == "Compound Poisson") {
- if (all(parameters at all %in% c(names(start),names(fixed))))
+ if (all(parameters %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)))]
+ miss <- parameters[!(parameters %in% c(names(start),names(fixed)))]
m2logL_prec <- NA
na_prec <- NA
withProgress(message = 'Step: ', value = 0, {
@@ -836,11 +1006,11 @@
}
}
else if (modClass == "Levy process") {
- if (all(parameters at all %in% c(names(start),names(fixed))))
+ if (all(parameters %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)))]
+ miss <- parameters[!(parameters %in% c(names(start),names(fixed)))]
m2logL_prec <- NA
na_prec <- NA
withProgress(message = 'Step: ', value = 0, {
@@ -892,11 +1062,11 @@
}
}
else {
- if (all(parameters at all %in% c(names(start),names(fixed))))
+ if (all(parameters %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, rcpp = TRUE))
else {
- miss <- parameters at all[!(parameters at all %in% c(names(start),names(fixed)))]
+ miss <- parameters[!(parameters %in% c(names(start),names(fixed)))]
m2logL_prec <- NA
na_prec <- NA
withProgress(message = 'Step: ', value = 0, {
@@ -995,7 +1165,8 @@
)
yuima <- setYuima(data = setDataGUI(series, delta = delta), model = mod)
t0 <- start(yuima at data@zoo.data[[1]])
- miss <- mod at parameter@all[!(mod at parameter@all %in% names(start))]
+ par <- getAllParams(mod, "Diffusion process")
+ miss <- par[!(par %in% names(start))]
m2logL_prec <- NA
na_prec <- NA
@@ -1182,6 +1353,8 @@
simulation <- try(yuima::simulate(object = model, increment.W = t(sample(x = increments, size = sampling at n, replace = TRUE)), xinit = xinit, true.parameter = true.parameter, sampling = sampling, space.discretized = space.discretized, method = method))
else if (modelYuimaGUI$info$class=="Fractional process")
simulation <- try(yuima::simulate(object = model, xinit = xinit, true.parameter = true.parameter, hurst = true.parameter[["hurst"]], sampling = sampling, space.discretized = space.discretized, method = method))
+ else if (modelYuimaGUI$info$class=="Point Process")
+ simulation <- try(yuima::simulate(object = modelYuima, xinit = xinit, true.parameter = true.parameter, sampling = sampling, space.discretized = space.discretized, method = method))
else
simulation <- try(yuima::simulate(object = model, xinit = xinit, true.parameter = true.parameter, sampling = sampling, space.discretized = space.discretized, method = method))
if (class(simulation)=="try-error"){
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_results.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_results.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_results.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -63,7 +63,7 @@
info <- yuimaGUIdata$multimodel[[id[1]]][[as.numeric(id[2])]]$info
if (info$class=="Fractional process") coef <- as.data.frame(yuimaGUIdata$multimodel[[id[1]]][[as.numeric(id[2])]]$qmle)
else coef <- as.data.frame(t(summary(yuimaGUIdata$multimodel[[id[1]]][[as.numeric(id[2])]]$qmle)@coef))
- params <- yuimaGUIdata$multimodel[[id[1]]][[as.numeric(id[2])]]$model at model@parameter at all
+ params <- getAllParams(mod = yuimaGUIdata$multimodel[[id[1]]][[as.numeric(id[2])]]$model, class = info$class)
lower <- data.frame(info$lower)
upper <- data.frame(info$upper)
fixed <- data.frame(info$fixed)
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_start_estimation.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_start_estimation.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/modeling/multivariate_start_estimation.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -5,7 +5,7 @@
for(i in names(yuimaGUIdata$usr_multimodel))
if (yuimaGUIdata$usr_multimodel[[i]]$class==input$multi_modelClass) {
if(input$multi_modelClass!="Diffusion process") choices <- c(i, choices)
- else if (length(setModelByName(name = i)@parameter at all)!=0) choices <- c(i, choices)
+ else if (length(getAllParams(mod = setModelByName(name = i), class = input$multi_modelClass))!=0) choices <- c(i, choices)
}
return (selectInput("multi_model",label = "Model Name", choices = choices, multiple = FALSE))
})
@@ -363,10 +363,8 @@
output$multi_advancedSettingsParameter <- renderUI({
if (!is.null(input$multi_model))
if (!is.null(input$multi_advancedSettingsModel)){
- parL <- setModelByName(input$multi_advancedSettingsModel, dimension = nrow(multi_seriesToEstimate$table), intensity = input$model_levy_intensity, jumps = jumps_shortcut(class = input$multi_modelClass, jumps = input$multi_jumps), AR_C = ifelse(input$multi_modelClass %in% c("CARMA","COGARCH"), input$AR_C, NA), MA_C = ifelse(input$multi_modelClass %in% c("CARMA","COGARCH"), input$MA_C, NA))@parameter
- par <- parL at all
- if (input$multi_modelClass=="COGARCH") par <- unique(c(parL at drift, parL at xinit))
- if (input$multi_modelClass=="CARMA") par <- parL at drift
+ mod <- setModelByName(input$multi_advancedSettingsModel, dimension = nrow(multi_seriesToEstimate$table), intensity = input$model_levy_intensity, jumps = jumps_shortcut(class = input$multi_modelClass, jumps = input$multi_jumps), AR_C = ifelse(input$multi_modelClass %in% c("CARMA","COGARCH"), input$AR_C, NA), MA_C = ifelse(input$multi_modelClass %in% c("CARMA","COGARCH"), input$MA_C, NA))
+ par <- getAllParams(mod, input$multi_modelClass)
selectInput(inputId = "multi_advancedSettingsParameter", label = "Parameter", choices = par)
}
})
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_results.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_results.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_results.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -58,7 +58,7 @@
info <- yuimaGUIdata$model[[id[1]]][[as.numeric(id[2])]]$info
if (info$class=="Fractional process") coef <- as.data.frame(yuimaGUIdata$model[[id[1]]][[as.numeric(id[2])]]$qmle)
else coef <- as.data.frame(t(summary(yuimaGUIdata$model[[id[1]]][[as.numeric(id[2])]]$qmle)@coef))
- params <- yuimaGUIdata$model[[id[1]]][[as.numeric(id[2])]]$model at model@parameter at all
+ params <- getAllParams(mod = yuimaGUIdata$model[[id[1]]][[as.numeric(id[2])]]$model, class = info$class)
lower <- data.frame(info$lower)
upper <- data.frame(info$upper)
fixed <- data.frame(info$fixed)
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -5,7 +5,7 @@
for(i in names(yuimaGUIdata$usr_model))
if (yuimaGUIdata$usr_model[[i]]$class==input$modelClass) {
if(input$modelClass!="Diffusion process") choices <- c(i, choices)
- else if (length(setModelByName(name = i)@parameter at all)!=0) choices <- c(i, choices)
+ else if (length(getAllParams(mod = setModelByName(name = i), class = input$modelClass))!=0) choices <- c(i, choices)
}
return (selectInput("model",label = "Model Name", choices = choices, multiple = TRUE))
})
@@ -357,10 +357,8 @@
output$advancedSettingsParameter <- renderUI({
if (!is.null(input$model))
if (!is.null(input$advancedSettingsModel)){
- parL <- setModelByName(input$advancedSettingsModel, intensity = input$model_levy_intensity, jumps = jumps_shortcut(class = input$modelClass, jumps = 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))@parameter
- par <- parL at all
- if (input$modelClass=="COGARCH") par <- unique(c(parL at drift, parL at xinit))
- if (input$modelClass=="CARMA") par <- parL at drift
+ mod <- setModelByName(input$advancedSettingsModel, intensity = input$model_levy_intensity, jumps = jumps_shortcut(class = input$modelClass, jumps = 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))
+ par <- getAllParams(mod, input$modelClass)
selectInput(inputId = "advancedSettingsParameter", label = "Parameter", choices = par)
}
})
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/settings.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/settings.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/settings.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -1,3 +1,15 @@
+#use it for shinyapps.io
+yuimaGUIdata <- reactiveValues(series=list(),
+ model=list(), multimodel=list(),
+ usr_model = list(), usr_multimodel = list(),
+ simulation=list(), multisimulation=list(),
+ usr_simulation = list(), usr_multisimulation = list(),
+ cp=list(),
+ cpYuima=list(),
+ llag = list(),
+ cluster = list(),
+ hedging = list())
+
yuimaGUItable <- reactiveValues(series=data.frame(),
model=data.frame(), multimodel=data.frame(),
simulation=data.frame(), multisimulation=data.frame(),
@@ -190,6 +202,7 @@
"Compound Poisson" = "Power Low Intensity",
"Compound Poisson" = "Exponentially Decaying Intensity",
"Compound Poisson" = "Periodic Intensity",
+ "Point Process" = "Hawkes",
#"Fractional process"="Frac. Geometric Brownian Motion",
#"Fractional process"="Frac. Brownian Motion",
"Fractional process"="Frac. Ornstein-Uhlenbeck (OU)",
@@ -198,6 +211,13 @@
"Levy process" = "Geometric Brownian Motion with Jumps"
)
-defaultMultiModels <- c("Diffusion process"="Correlated Brownian Motion")
+defaultMultiModels <- c("Diffusion process" = "Correlated Brownian Motion")
-defaultJumps <- c("Gaussian", "Uniform")
+defaultJumps <- c("Gaussian",
+ "Uniform",
+ "Student t",
+ "Variance Gamma",
+ "Inverse Gaussian",
+ "Normal Inverse Gaussian",
+ "Hyperbolic",
+ "Generalized Hyperbolic")
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/simulation/multivariate_non_estimated.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/simulation/multivariate_non_estimated.R 2018-05-21 05:48:17 UTC (rev 649)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/simulation/multivariate_non_estimated.R 2018-05-21 15:12:17 UTC (rev 650)
@@ -31,7 +31,8 @@
else if (isolate({input$multi_simulate_model_usr_selectClass=="Compound Poisson"}) & is.null(input$multi_simulate_model_usr_selectJumps)) valid <- FALSE
else if (isolate({input$multi_simulate_model_usr_selectModel %in% c("Correlated Brownian Motion")}) & is.null(input$multi_simulate_model_usr_selectDimension)) valid <- FALSE
if (valid) {
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 650
More information about the Yuima-commits
mailing list