[Yuima-commits] r651 - in pkg/yuimaGUI/inst/yuimaGUI/server: . eda modeling
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 22 12:01:06 CEST 2018
Author: phoenix844
Date: 2018-05-22 12:01:06 +0200 (Tue, 22 May 2018)
New Revision: 651
Modified:
pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R
pkg/yuimaGUI/inst/yuimaGUI/server/functions.R
pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R
pkg/yuimaGUI/inst/yuimaGUI/server/settings.R
Log:
ppr ready
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R 2018-05-21 15:12:17 UTC (rev 650)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R 2018-05-22 10:01:06 UTC (rev 651)
@@ -215,7 +215,7 @@
for (symb in rownames(parametric_seriesToChangePoint$table)){
if (is.null(yuimaGUIsettings$delta[[symb]])) yuimaGUIsettings$delta[[symb]] <<- 0.01
if (is.null(yuimaGUIsettings$toLog[[symb]])) yuimaGUIsettings$toLog[[symb]] <<- FALSE
- data <- na.omit(as.numeric(getData(symb)))
+ data <- getData(symb)
if (yuimaGUIsettings$toLog[[symb]]==TRUE) data <- log(data)
for (modName in input$parametric_changepoint_model){
if (class(try(setModelByName(modName, jumps = NA, AR_C = NA, MA_C = NA)))!="try-error"){
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/functions.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/functions.R 2018-05-21 15:12:17 UTC (rev 650)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/functions.R 2018-05-22 10:01:06 UTC (rev 651)
@@ -91,7 +91,7 @@
defaultBounds <- function(name, delta, strict, jumps = NA, AR_C = NA, MA_C = NA, data, intensity = NULL, threshold = NULL){
- lastPrice = last(data)
+ lastPrice = as.numeric(last(data))
if ( isUserDefined(name) ){
mod <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)
par <- getAllParams(mod, yuimaGUIdata$usr_model[[name]]$class)
@@ -118,19 +118,18 @@
}
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))
+ if (name == "Hawkes"){
+ if (strict==TRUE) return (list(lower=list("nu1"=0, "c11"=0, "a11"=0), upper=list("nu1"=NA, "c11"=100, "a11"=NA)))
+ else {
+ x <- as.numeric(diff(data))
+ t1 <- tail(time(data),n=1)
+ t0 <- time(data)[1]
+ n <- length(x[x!=0])
+ nu1 <- n/as.numeric(t1-t0)
+ c11 <- 0
+ a11 <- 1
+ return (list(lower=list("nu1"=nu1, "c11"=c11, "a11"=a11), upper=list("nu1"=nu1, "c11"=c11, "a11"=a11)))
}
- names(lower) <- par
- names(upper) <- par
- return(list(lower=as.list(lower), upper=as.list(upper)))
}
if (name %in% defaultModels[names(defaultModels) == "COGARCH"]){
mod <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)
@@ -290,6 +289,9 @@
if(jumps=='Gaussian') {
return(list("dnorm(z, mean = mu_jump, sd = sigma_jump)"))
}
+ if(jumps=='Constant') {
+ return(list("dconst(z, k = k_jump)"))
+ }
if(jumps=='Uniform') {
return(list("dunif(z, min = a_jump, max = b_jump)"))
}
@@ -314,7 +316,7 @@
}
jumpBounds <- function(jumps, data, strict, threshold = 0){
- x <- na.omit(diff(data))
+ x <- na.omit(as.numeric(diff(data)))
x <- x[abs(x)>threshold]
x <- x-sign(x)*threshold
switch(jumps,
@@ -334,6 +336,13 @@
return(list(lower=list("a_jump"=a, "b_jump"=b), upper=list("a_jump"=a, "b_jump"=b)))
}
},
+ "Constant" = {
+ if(strict==TRUE) return(list(lower=list("k_jump"=NA), upper=list("k_jump"=NA)))
+ else {
+ k <- median(x)
+ return(list(lower=list("k_jump"=k), upper=list("k_jump"=k)))
+ }
+ },
"Inverse Gaussian" = {
if(strict==TRUE) return(list(lower=list("delta_jump"=NA, "gamma_jump"=NA), upper=list("delta_jump"=NA, "gamma_jump"=NA)))
else {
@@ -431,14 +440,15 @@
latexJumps <- function(jumps){
if (!is.null(jumps)){
switch (jumps,
- "Gaussian" = "Y_i \\sim N(\\mu_{jump}, \\; \\sigma_{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})"
+ "Gaussian" = "Y_i \\sim N(\\mu_{jump}, \\; \\sigma_{jump})",
+ "Constant" = "Y_i = k_{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})"
)
}
}
@@ -814,9 +824,16 @@
}
}
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
+ model <- setModelByName(name = modName, dimension = ncol(data), intensity = intensity_levy, jumps = jumps, MA_C = MA_C, AR_C = AR_C)
+ t1 <- tail(time(data),n=1)
+ t0 <- time(data)[1]
+ if(!is.numeric(t0) | !is.numeric(t1)){
+ t0 <- 0
+ t1 <- as.numeric(t1-t0)/365
+ }
+ samp <- setSampling(t0, t1, n = as.integer(as.numeric(t1-t0)/delta)+1)
+ colnames(data) <- model at model@solve.variable
+ model <- DataPPR(CountVar = data, yuimaPPR = model, samp = samp)
} 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)))
}
@@ -824,7 +841,7 @@
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))
+ #index(model at data@original.data) <- index(na.omit(data))
parameters <- getAllParams(model, modClass)
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R 2018-05-21 15:12:17 UTC (rev 650)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R 2018-05-22 10:01:06 UTC (rev 651)
@@ -265,7 +265,7 @@
else yuimaGUIsettings$delta[[symb]] <<- 0.01
}
if (is.null(yuimaGUIsettings$toLog[[symb]])) yuimaGUIsettings$toLog[[symb]] <<- FALSE
- data <- na.omit(as.numeric(getData(symb)))
+ data <- getData(symb)
if (yuimaGUIsettings$toLog[[symb]]==TRUE) data <- log(data)
for (modName in input$model){
if (class(try(setModelByName(modName, intensity = input$model_levy_intensity, jumps = jumps_shortcut(class = class, jumps = input$jumps), AR_C = ifelse(class %in% c("CARMA","COGARCH"), input$AR_C, NA), MA_C = ifelse(class %in% c("CARMA","COGARCH"), input$MA_C, NA))))!="try-error"){
Modified: pkg/yuimaGUI/inst/yuimaGUI/server/settings.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/settings.R 2018-05-21 15:12:17 UTC (rev 650)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/settings.R 2018-05-22 10:01:06 UTC (rev 651)
@@ -213,7 +213,8 @@
defaultMultiModels <- c("Diffusion process" = "Correlated Brownian Motion")
-defaultJumps <- c("Gaussian",
+defaultJumps <- c("Gaussian",
+ "Constant",
"Uniform",
"Student t",
"Variance Gamma",
More information about the Yuima-commits
mailing list