[Yuima-commits] r527 - in pkg/yuimaGUI: . inst/yuimaGUI
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 23 20:51:20 CET 2016
Author: phoenix844
Date: 2016-11-23 20:51:19 +0100 (Wed, 23 Nov 2016)
New Revision: 527
Modified:
pkg/yuimaGUI/DESCRIPTION
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
Log:
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2016-11-23 00:27:42 UTC (rev 526)
+++ pkg/yuimaGUI/DESCRIPTION 2016-11-23 19:51:19 UTC (rev 527)
@@ -1,7 +1,7 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the Yuima Package
-Version: 0.9.1
+Version: 0.9.2
Author: YUIMA Project Team
Maintainer: Emanuele Guidotti <emanuele.guidotti at studenti.unimi.it>
Description: Provides a graphical user interface for the yuima package.
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-23 00:27:42 UTC (rev 526)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-23 19:51:19 UTC (rev 527)
@@ -53,6 +53,11 @@
return(xx)
}
+mode <- function(x) {
+ ux <- unique(x)
+ ux[which.max(tabulate(match(x, ux)))]
+}
+
observeEvent(yuimaGUIdata$series, priority = 10, {
yuimaGUItable$series <<- data.frame()
for (symb in names(yuimaGUIdata$series)){
@@ -106,6 +111,12 @@
}
})
+observeEvent(yuimaGUIdata$series, priority = 10, {
+ n <- names(yuimaGUIdata$series)
+ for (i in names(estimateSettings)) if(!(i %in% n)) estimateSettings[[i]] <<- NULL
+ for (i in names(deltaSettings)) if(!(i %in% n)) deltaSettings[[i]] <<- NULL
+})
+
observeEvent(yuimaGUIdata$hedging, priority = 10, {
yuimaGUItable$hedging <<- data.frame()
if (length(yuimaGUIdata$hedging)!=0){
@@ -145,7 +156,7 @@
}
-addData <- function(x, typeIndex, session, anchorId, printSuccess = TRUE){
+addData <- function(x, typeIndex){
x <- data.frame(x, check.names = TRUE)
err <- c()
alreadyIn <- c()
@@ -173,12 +184,7 @@
}
}
}
- if (length(err)==0 & length(alreadyIn)==0 & printSuccess)
- createAlert(session = session, anchorId = anchorId, content = paste("Data uploaded successfully"), style = "success")
- if (length(err)!=0)
- createAlert(session = session, anchorId = anchorId, content = paste("Unable to upload following symbols:",paste(err,collapse = " ")), style = "error")
- if (length(alreadyIn)!=0)
- createAlert(session = session, anchorId = anchorId, content = paste("Following data already uploaded:", paste(alreadyIn, collapse = " ")), style = "warning")
+ return(list(err = err, already_in = alreadyIn))
}
getDataNames <- function(){
@@ -213,12 +219,13 @@
#"Fractional process"="Frac. Brownian Motion",
"Fractional process"="Frac. Ornstein-Uhlenbeck (OU)",
"CARMA" = "Carma(p,q)",
- "COGARCH" = "Cogarch(p,q)"
+ "COGARCH" = "Cogarch(p,q)",
+ "Levy process" = "Geometric Brownian Motion with Jumps"
)
defaultJumps <- c("Gaussian", "Uniform")
-defaultBounds <- function(name, delta, strict, jumps = NA, AR_C = NA, MA_C = NA, data){
+defaultBounds <- function(name, delta, strict, jumps = NA, AR_C = NA, MA_C = NA, data, intensity = NULL, threshold = NULL){
lastPrice = last(data)
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
@@ -233,7 +240,6 @@
lower <- rep(-100, length(par))
upper <- rep(100, length(par))
}
-
}
names(lower) <- par
names(upper) <- par
@@ -280,11 +286,21 @@
}
if (name == "Brownian Motion" | name == "Bm"){
if (strict==TRUE) return (list(lower=list("sigma"=0, "mu"=NA), upper=list("sigma"=NA, "mu"=NA)))
- else return (list(lower=list("sigma"=0, "mu"=-1/delta), upper=list("sigma"=1/sqrt(delta), "mu"=1/delta)))
+ else {
+ x <- as.numeric(diff(data))
+ mu <- mean(x)
+ sigma <- sd(x)
+ return (list(lower=list("sigma"=sigma/sqrt(delta), "mu"=mu/delta), upper=list("sigma"=sigma/sqrt(delta), "mu"=mu/delta)))
+ }
}
if (name == "Geometric Brownian Motion" | name == "gBm") {
if (strict==TRUE) return (list(lower=list("sigma"=0, "mu"=NA), upper=list("sigma"=NA, "mu"=NA)))
- else return (list(lower=list("sigma"=0, "mu"=-1/delta), upper=list("sigma"=1/sqrt(delta), "mu"=1/delta)))
+ else {
+ x <- as.numeric(na.omit(Delt(data)))
+ mu <- mean(x)
+ sigma <- sd(x)
+ return (list(lower=list("sigma"=sigma/sqrt(delta), "mu"=mu/delta), upper=list("sigma"=sigma/sqrt(delta), "mu"=mu/delta)))
+ }
}
if (name == "Ornstein-Uhlenbeck (OU)" | name == "OU"){
if (strict==TRUE) return(list(lower=list("theta"=0, "sigma"=0),upper=list("theta"=NA, "sigma"=NA)))
@@ -321,7 +337,12 @@
if (name == "Constant Intensity"){
boundsJump <- jumpBounds(jumps = jumps, strict = strict, data = data)
if (strict==TRUE) return(list(lower=c(list("lambda"=0), boundsJump$lower),upper=c(list("lambda"=NA), boundsJump$upper)))
- else return(list(lower=c(list("lambda"=0), boundsJump$lower),upper=c(list("lambda"=1/delta), boundsJump$upper)))
+ else {
+ x <- as.numeric(diff(data))
+ counts <- length(x[x!=0 & !is.na(x)])
+ lambda <- counts/(length(x)*delta)
+ return(list(lower=c(list("lambda"=lambda), boundsJump$lower),upper=c(list("lambda"=lambda), boundsJump$upper)))
+ }
}
if (name == "Power Low Intensity"){
boundsJump <- jumpBounds(jumps = jumps, strict = strict, data = data)
@@ -343,31 +364,51 @@
if (strict==TRUE) return(list(lower=c(list("a"=0, "b"=0, "omega"=0, "phi"=0), boundsJump$lower),upper=c(list("a"=NA, "b"=NA, "omega"=NA, "phi"=2*pi), boundsJump$upper)))
else return(list(lower=c(list("a"=0, "b"=0, "omega"=0, "phi"=0), boundsJump$lower),upper=c(list("a"=1/delta, "b"=1/delta, "omega"=1/delta, "phi"=2*pi), boundsJump$upper)))
}
+ if (name == "Geometric Brownian Motion with Jumps"){
+ boundsJump <- jumpBounds(jumps = jumps, strict = strict, data = data, threshold = threshold)
+ boundsIntensity <- intensityBounds(intensity = intensity, strict = strict, delta = delta)
+ if (strict==TRUE) return(list(lower=c(list("mu"=NA, "sigma"=0), boundsJump$lower, boundsIntensity$lower),upper=c(list("mu"=NA, "sigma"=NA), boundsJump$upper, boundsIntensity$upper)))
+ 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)))
+ }
}
+setThreshold <- function(class, data){
+ if(class!="Levy process") return(NA)
+ else {
+ return(0)
+ }
+}
+
setJumps <- function(jumps){
- switch (jumps,
- "Gaussian" = list("dnorm(z, mean = mu_jump, sd = sigma_jump)"),
- "Uniform" = list("dunif(z, min = a_jump, max = b_jump)")
+ 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)")
)
}
-jumpBounds <- function(jumps, data, strict){
+jumpBounds <- function(jumps, data, strict, threshold = 0){
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 {
- mu <- mean(diff(data))
- s <- sd(diff(data))
+ 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)))
}
},
"Uniform" = {
if(strict==TRUE) return(list(lower=list("a_jump"=NA, "b_jump"=NA), upper=list("a_jump"=NA, "b_jump"=NA)))
else {
- a <- min(diff(data))
- b <- max(diff(data))
+ 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)))
}
}
@@ -383,9 +424,17 @@
}
}
+intensityBounds <- function(intensity, strict, delta){
+ switch(intensity,
+ "lambda" = {
+ if(strict==TRUE) return(list(lower=list("lambda"=0), upper=list("lambda"=NA)))
+ else return(list(lower=list("lambda"=0), upper=list("lambda"=1/delta)))
+ }
+ )
+}
-setModelByName <- function(name, jumps = NA, AR_C = NA, MA_C = NA, XinExpr = FALSE){
+setModelByName <- function(name, jumps = NA, AR_C = NA, MA_C = NA, XinExpr = FALSE, intensity = NA){
if (name %in% names(isolate({usr_models$model}))){
if (isolate({usr_models$model[[name]]$class=="Diffusion process" | usr_models$model[[name]]$class=="Fractional process"}))
return(isolate({usr_models$model[[name]]$object}))
@@ -411,6 +460,10 @@
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(p,q)") return(yuima::setCarma(p = AR_C, q = MA_C, ma.par="MA", ar.par="AR", XinExpr = XinExpr))
+ if (name == "Geometric Brownian Motion with Jumps") {
+ if(intensity=="None") return(yuima::setModel(drift="mu*x", diffusion="sigma*x", jump.coeff="x", measure.type = "code", measure = list(df = setJumps(jumps = jumps)), solve.variable = "x"))
+ else return(yuima::setModel(drift="mu*x", diffusion="sigma*x", jump.coeff="x", measure.type = "CP", measure = list(intensity = intensity, df = setJumps(jumps = jumps)), solve.variable = "x"))
+ }
}
printModelLatex <- function(names, process, jumps = NA){
@@ -489,6 +542,9 @@
if (process=="CARMA"){
return(paste("$$","CARMA(p,q)","$$"))
}
+ if (process=="Levy process"){
+ return(paste("$$","dX_t = \\mu X_t \\; dt + \\sigma X_t \\; dW_t + X_t \\; dZ_t","$$"))
+ }
}
@@ -637,7 +693,7 @@
return (List)
}
-addModel <- function(modName, modClass, AR_C, MA_C, jumps, symbName, data, toLog, delta, start, startMin, startMax, trials, seed, method="BFGS", fixed = list(), lower, upper, joint=FALSE, aggregation=TRUE, threshold=NULL, session, anchorId, alertId){
+addModel <- function(modName, intensity_levy, modClass, AR_C, MA_C, jumps, symbName, data, toLog, delta, start, startMin, startMax, trials, seed, method="BFGS", fixed = list(), lower, upper, joint=FALSE, aggregation=TRUE, threshold=NULL, session, anchorId, alertId){
info <- list(
class = modClass,
modName = modName,
@@ -670,23 +726,10 @@
createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("Cannot convert series ", symbName, "to log. Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "error")
return()
}
- model <- setYuima(data = setDataGUI(data, delta = delta), model=setModelByName(name = modName, jumps = jumps, MA_C = MA_C, AR_C = AR_C))
+ model <- setYuima(data = setDataGUI(data, delta = delta), model=setModelByName(name = modName, intensity = intensity_levy, jumps = jumps, MA_C = MA_C, AR_C = AR_C))
index(model at data@original.data) <- index(data)
parameters <- model at model@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, rcpp = TRUE))
- if (class(QMLE)=="try-error"){
- 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 == "Fractional process"){
+ if (modClass == "Fractional process"){
QMLEtemp <- try(mmfrac(model))
if(class(QMLEtemp)!="try-error") {
estimates <- QMLEtemp[[1]]
@@ -862,6 +905,61 @@
})
}
}
+ else if (modClass == "Levy process") {
+ 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:trials){
+ incProgress(1/trials, detail = paste(iter,"(/", trials ,")"))
+ 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))
+ }
+ }
+ }
+ }
+ }
+ })
+ }
+ }
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,
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-23 00:27:42 UTC (rev 526)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-23 19:51:19 UTC (rev 527)
@@ -30,7 +30,7 @@
}
jumps_shortcut <- function(class, jumps){
- switch(class, "Diffusion process" = NA, "Fractional process" = NA,"Compound Poisson" = jumps, "COGARCH"=NA, "CARMA" = NA)
+ switch(class, "Diffusion process" = NA, "Fractional process" = NA,"Compound Poisson" = jumps, "COGARCH"=NA, "CARMA" = NA, "Levy process" = jumps)
}
### Home
@@ -55,23 +55,30 @@
observeEvent(input$finDataGo, priority = 1, {
if (input$symb!=""){
closeAlert(session, "finDataAlert_err")
+ closeAlert(session, "finDataAlert_warn")
closeAlert(session, "finDataAlert_succ")
symb <- unlist(strsplit(input$symb, split = "[, ]+" , fixed = FALSE))
err <- c()
+ already_in <- c()
withProgress(message = 'Loading: ', value = 0, {
for (i in symb){
incProgress(1/length(symb), detail = i)
x <- try(getSymbols(i, src = input$sources ,auto.assign = FALSE, from = input$dR[1], to = input$dR[2]))
if (class(x)[1]=="try-error")
err <- cbind(err,i)
- else
- addData(x, typeIndex = "%Y-%m-%d", session = session, anchorId = "finDataAlert", printSuccess = FALSE)
+ else {
+ info <- addData(x, typeIndex = "%Y-%m-%d")
+ err <- c(err, info$err)
+ already_in <- c(already_in, info$already_in)
+ }
}
})
if(!is.null(err))
- createAlert(session = session, anchorId = "finDataAlert", alertId = "finDataAlert_err", content = paste("WARNING! Unable to download following symbols:", paste(err,collapse = " ")), style = "danger")
- if(is.null(err))
- createAlert(session = session, anchorId = "finDataAlert", alertId = "finDataAlert_succ", content = paste("All symbols downloaded successfully"), style = "success")
+ createAlert(session = session, anchorId = "finDataAlert", alertId = "finDataAlert_err", content = paste("Unable to load following symbols:", paste(err,collapse = " ")), style = "error")
+ if(!is.null(already_in))
+ createAlert(session = session, anchorId = "finDataAlert", alertId = "finDataAlert_warn", content = paste("WARNING! Following symbols already loaded:", paste(already_in,collapse = " ")), style = "warning")
+ if(is.null(err) & is.null(already_in))
+ createAlert(session = session, anchorId = "finDataAlert", alertId = "finDataAlert_succ", content = paste("All symbols loaded successfully"), style = "success")
}
})
@@ -234,7 +241,16 @@
###Upload file
observeEvent(input$yourFileGo, priority = 1, {
- addData(fileUp(), typeIndex = input$yourFileFUN, session = session, anchorId = "yourDataAlert")
+ closeAlert(session, "yourDataAlert_err")
+ closeAlert(session, "yourDataAlert_warn")
+ closeAlert(session, "yourDataAlert_succ")
+ info <- addData(fileUp(), typeIndex = input$yourFileFUN)
+ if(!is.null(info$err))
+ createAlert(session = session, anchorId = "yourDataAlert", alertId = "yourDataAlert_err", content = paste("Unable to load following symbols:", paste(info$err,collapse = " ")), style = "error")
+ if(!is.null(info$already_in))
+ createAlert(session = session, anchorId = "yourDataAlert", alertId = "yourDataAlert_warn", content = paste("WARNING! Following symbols already loaded:", paste(info$already_in,collapse = " ")), style = "warning")
+ if(is.null(info$err) & is.null(info$already_in))
+ createAlert(session = session, anchorId = "yourDataAlert", alertId = "yourDataAlert_succ", content = paste("All symbols loaded successfully"), style = "success")
})
###Display data available
@@ -282,6 +298,19 @@
output$jumps <- renderUI({
if (input$modelClass=="Compound Poisson")
return(selectInput("jumps",label = "Jumps", choices = defaultJumps))
+ if (input$modelClass=="Levy process"){
+ jump_choices <- defaultJumps
+ jump_sel <- NULL
+ if(!is.null(input$model)){
+ if(input$model=="Geometric Brownian Motion with Jumps") jump_sel <- "Gaussian"
+ }
+ return(div(
+ column(6,selectInput("model_levy_intensity", label = "Intensity", choices = c(#"None",
+ "Constant"="lambda"))),
+ column(6,selectInput("jumps",label = "Jumps", choices = jump_choices, selected = jump_sel)))
+ )
+ }
+
})
output$pq_C <- renderUI({
@@ -314,6 +343,8 @@
return(withMathJax("$$dX=a(t,X,\\theta)\\;dt\\;+\\;b(t,X,\\theta)\\;dW^H$$"))
if (input$usr_modelClass=="Compound Poisson")
return(withMathJax("$$X_t = X_0+\\sum_{i=0}^{N_t} Y_i \\; : \\;\\;\\; N_t \\sim Poi\\Bigl(\\int_0^t \\lambda(t)dt\\Bigl)$$"))
+ if (input$usr_modelClass=="Levy process")
+ return(withMathJax("$$dX_t = \\mu X_t \\; dt + \\sigma X_t \\; dW_t + X_t \\; dZ_t$$"))
})
observe({
@@ -342,6 +373,16 @@
textInput("usr_model_coeff_intensity", width = "45%", label = withMathJax("$$\\lambda(t)$$"))
)
)
+ if (input$usr_modelClass=="Levy process")
+ return(
+ div(align="center",
+ fluidRow(column(12,textInput("usr_model_coeff_intensity", width = "45%", label = withMathJax("$$\\lambda(t)$$")))),
+ fluidRow(
+ column(6, textInput("usr_model_coeff_drift", width = "70%", label = withMathJax("$$a(t,X,\\theta)$$"))),
+ column(6, textInput("usr_model_coeff_diff", width = "70%", label = withMathJax("$$b(t,X,\\theta)$$")))
+ )
+ )
+ )
})
observeEvent(input$usr_model_button_save, {
@@ -367,6 +408,13 @@
if(class(mod)!="try-error") usr_models$model[[input$usr_model_name]] <<- list(intensity=tolower(input$usr_model_coeff_intensity), class=input$usr_modelClass)
entered <- TRUE
}
+ },
+ "Levy process" = {
+ if (input$usr_model_name!=""){
+ mod <- try(setModel(drift=input$usr_model_coeff_drift, diffusion=input$usr_model_coeff_diff, measure.type = ifelse(is.na(input$usr_model_coeff_intensity), "code", "CP"), measure = list(intensity = input$usr_model_coeff_intensity, df = ""), solve.variable = "x"))
+ if(class(mod)!="try-error") usr_models$model[[input$usr_model_name]] <<- list(intensity=tolower(input$usr_model_coeff_intensity), drift = input$usr_model_coeff_drift, diffusion = input$usr_model_coeff_diff, class=input$usr_modelClass)
+ entered <- TRUE
+ }
}
)
if (entered){
@@ -607,12 +655,16 @@
observe({
class <- isolate({input$modelClass})
for (symb in rownames(seriesToEstimate$table)){
- if (is.null(deltaSettings[[symb]])) deltaSettings[[symb]] <<- 0.01
+ if (is.null(deltaSettings[[symb]])) {
+ i <- index(getData(symb))
+ if(is.numeric(i)) deltaSettings[[symb]] <<- mode(diff(i))
+ else deltaSettings[[symb]] <<- 0.01
+ }
if (is.null(toLogSettings[[symb]])) toLogSettings[[symb]] <<- FALSE
data <- na.omit(as.numeric(getData(symb)))
if (toLogSettings[[symb]]==TRUE) data <- log(data)
for (modName in input$model){
- if (class(try(setModelByName(modName, 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"){
+ 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"){
if (is.null(estimateSettings[[modName]]))
estimateSettings[[modName]] <<- list()
if (is.null(estimateSettings[[modName]][[symb]]))
@@ -621,9 +673,13 @@
estimateSettings[[modName]][[symb]][["fixed"]] <<- list()
if (is.null(estimateSettings[[modName]][[symb]][["start"]]) | !(class %in% c("Diffusion process", "Fractional process")) | prev_buttonDelta!=input$advancedSettingsButtonApplyDelta | prev_buttonAllDelta!=input$advancedSettingsButtonApplyAllDelta)
estimateSettings[[modName]][[symb]][["start"]] <<- list()
+ if (is.null(estimateSettings[[modName]][[symb]][["threshold"]]))
+ estimateSettings[[modName]][[symb]][["threshold"]] <<- setThreshold(class = class, data = data)
startMinMax <- defaultBounds(name = modName,
jumps = jumps_shortcut(class = class, jumps = input$jumps),
+ intensity = input$model_levy_intensity,
+ threshold = estimateSettings[[modName]][[symb]][["threshold"]],
AR_C = ifelse(class %in% c("CARMA","COGARCH"), input$AR_C, NA),
MA_C = ifelse(class %in% c("CARMA","COGARCH"), input$MA_C, NA),
strict = FALSE,
@@ -631,6 +687,8 @@
delta = deltaSettings[[symb]])
upperLower <- defaultBounds(name = modName,
jumps = jumps_shortcut(class = class, jumps = input$jumps),
+ intensity = input$model_levy_intensity,
+ threshold = estimateSettings[[modName]][[symb]][["threshold"]],
AR_C = ifelse(class %in% c("CARMA","COGARCH"), input$AR_C, NA),
MA_C = ifelse(class %in% c("CARMA","COGARCH"), input$MA_C, NA),
strict = TRUE,
@@ -657,8 +715,6 @@
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
}
}
}
@@ -669,7 +725,7 @@
observe({
valid <- TRUE
if (nrow(seriesToEstimate$table)==0 | is.null(input$model)) valid <- FALSE
- else for(mod in input$model) if (class(try(setModelByName(mod, 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))))=="try-error") valid <- FALSE
+ else for(mod in input$model) if (class(try(setModelByName(mod, 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))))=="try-error") valid <- FALSE
shinyjs::toggle(id="advancedSettingsAll", condition = valid)
shinyjs::toggle(id="advancedSettingsErrorMessage", condition = !valid)
})
@@ -695,7 +751,7 @@
output$advancedSettingsParameter <- renderUI({
if (!is.null(input$model))
if (!is.null(input$advancedSettingsModel)){
- parL <- setModelByName(input$advancedSettingsModel, 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
+ 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
@@ -756,10 +812,10 @@
#REMOVE# if (!is.null(input$advancedSettingsModel) & !is.null(input$advancedSettingsSeries))
#REMOVE# selectInput("advancedSettingsAggregation", label = "aggregation", choices = c(TRUE, FALSE), selected = estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["aggregation"]])
#REMOVE# })
- #REMOVE# output$advancedSettingsThreshold <- renderUI({
- #REMOVE# if (!is.null(input$advancedSettingsModel) & !is.null(input$advancedSettingsSeries))
- #REMOVE# numericInput("advancedSettingsThreshold", label = "threshold", value = estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["threshold"]])
- #REMOVE# })
+ output$advancedSettingsThreshold <- renderUI({
+ if (!is.null(input$advancedSettingsModel) & !is.null(input$advancedSettingsSeries)) if(isolate({input$modelClass})=="Levy process")
+ numericInput("advancedSettingsThreshold", label = "threshold", value = estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["threshold"]])
+ })
output$advancedSettingsTrials <- renderUI({
if (!is.null(input$advancedSettingsModel) & !is.null(input$advancedSettingsSeries) & !is.null(input$advancedSettingsMethod))
numericInput("advancedSettingsTrials", label = "trials", min = 1, value = ifelse(input$advancedSettingsMethod=="SANN" & estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["method"]]!="SANN",1,estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["trials"]]))
@@ -806,7 +862,7 @@
estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["seed"]] <<- input$advancedSettingsSeed
#REMOVE# estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["joint"]] <<- input$advancedSettingsJoint
#REMOVE# estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["aggregation"]] <<- input$advancedSettingsAggregation
- #REMOVE# estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["threshold"]] <<- input$advancedSettingsThreshold
+ estimateSettings[[input$advancedSettingsModel]][[input$advancedSettingsSeries]][["threshold"]] <<- input$advancedSettingsThreshold
})
observeEvent(input$advancedSettingsButtonApplyAllModelGeneral,{
for (symb in rownames(seriesToEstimate$table)){
@@ -815,7 +871,7 @@
estimateSettings[[input$advancedSettingsModel]][[symb]][["seed"]] <<- input$advancedSettingsSeed
#REMOVE# estimateSettings[[input$advancedSettingsModel]][[symb]][["joint"]] <<- input$advancedSettingsJoint
#REMOVE# estimateSettings[[input$advancedSettingsModel]][[symb]][["aggregation"]] <<- input$advancedSettingsAggregation
- #REMOVE# estimateSettings[[input$advancedSettingsModel]][[symb]][["threshold"]] <<- input$advancedSettingsThreshold
+ estimateSettings[[input$advancedSettingsModel]][[symb]][["threshold"]] <<- input$advancedSettingsThreshold
}
})
observeEvent(input$advancedSettingsButtonApplyAllGeneral,{
@@ -826,7 +882,7 @@
estimateSettings[[mod]][[symb]][["seed"]] <<- input$advancedSettingsSeed
#REMOVE# estimateSettings[[mod]][[symb]][["joint"]] <<- input$advancedSettingsJoint
#REMOVE# estimateSettings[[mod]][[symb]][["aggregation"]] <<- input$advancedSettingsAggregation
- #REMOVE# estimateSettings[[mod]][[symb]][["threshold"]] <<- input$advancedSettingsThreshold
+ estimateSettings[[mod]][[symb]][["threshold"]] <<- input$advancedSettingsThreshold
}
}
})
@@ -854,7 +910,7 @@
valid <- TRUE
if(is.null(input$model) | nrow(seriesToEstimate$table)==0) valid <- FALSE
else if (input$modelClass=="Compound Poisson" & is.null(input$jumps)) valid <- FALSE
- else for(mod in input$model) if (class(try(setModelByName(mod, 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))))=="try-error") valid <- FALSE
+ else for(mod in input$model) if (class(try(setModelByName(mod, 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))))=="try-error") valid <- FALSE
if(!valid){
createAlert(session = session, anchorId = "panel_run_estimation_alert", alertId = "modelsAlert_err", content = "Select some series and (valid) models to estimate", style = "warning")
}
@@ -875,6 +931,7 @@
addModel(
modName = modName,
modClass = input$modelClass,
+ intensity_levy = input$model_levy_intensity,
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),
jumps = jumps_shortcut(class = input$modelClass, jumps = input$jumps),
@@ -967,6 +1024,7 @@
em("delta:"), info$delta, br(),
em("series to log:"), info$toLog, br(),
em("method:"), info$method, br(),
+ em("threshold:"), info$threshold, br(),
em("trials:"), info$trials, br(),
em("seed:"), info$seed, br()
#REMOVE# em("joint:"), info$joint, br(),
@@ -1030,7 +1088,7 @@
test <- FALSE
choices <- NULL
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 527
More information about the Yuima-commits
mailing list