[Yuima-commits] r505 - in pkg/yuimaGUI: . inst/yuimaGUI
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 2 11:28:03 CET 2016
Author: phoenix844
Date: 2016-11-02 11:28:02 +0100 (Wed, 02 Nov 2016)
New Revision: 505
Modified:
pkg/yuimaGUI/DESCRIPTION
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
Log:
working version
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2016-11-01 10:34:41 UTC (rev 504)
+++ pkg/yuimaGUI/DESCRIPTION 2016-11-02 10:28:02 UTC (rev 505)
@@ -1,7 +1,7 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the Yuima Package
-Version: 0.7.6
+Version: 0.7.7
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-01 10:34:41 UTC (rev 504)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-02 10:28:02 UTC (rev 505)
@@ -8,7 +8,7 @@
require(shinyBS)
#require(corrplot)
-options(warn=-1)
+options(warn=-1)
if(!exists("yuimaGUItable"))
yuimaGUItable <<- reactiveValues(series=data.frame(), model=data.frame(), simulation=data.frame(), hedging=data.frame())
@@ -207,31 +207,17 @@
"Compound Poisson" = "Linear Intensity",
"Compound Poisson" = "Power Low Intensity",
"Compound Poisson" = "Exponentially Decaying Intensity",
-<<<<<<< .mine
"Compound Poisson" = "Periodic Intensity",
#"Fractional process"="Frac. Geometric Brownian Motion",
#"Fractional process"="Frac. Brownian Motion",
"Fractional process"="Frac. Ornstein-Uhlenbeck (OU)",
"CARMA" = "Carma(p,q)",
"COGARCH" = "Cogarch(p,q)"
-||||||| .r460
- "Compound Poisson" = "Periodic Intensity"
-=======
- "Compound Poisson" = "Periodic Intensity",
- "CARMA" = "Carma(p,q)",
- "COGARCH" = "Cogarch(p,q)"
->>>>>>> .r498
)
defaultJumps <- c("Gaussian", "Uniform")
-<<<<<<< .mine
defaultBounds <- function(name, delta, jumps = NA, lower = NA, upper = NA, AR_C = NA, MA_C = NA, lastPrice = NA){
-||||||| .r460
-defaultBounds <- function(name, jumps = NULL, lower = NA, upper = NA){
-=======
-defaultBounds <- function(name, jumps = NA, lower = NA, upper = NA, AR_C = NA, MA_C = NA){
->>>>>>> .r498
if (name %in% names(isolate({usr_models$model}))){
par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter at all
startmin <- rep(lower, length(par))
@@ -247,7 +233,6 @@
}
return(list(lower=as.list(startmin), upper=as.list(startmax)))
}
-<<<<<<< .mine
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))
@@ -283,43 +268,6 @@
# }
return(list(lower=as.list(startmin), upper=as.list(startmax)))
}
-||||||| .r460
-=======
- if (name %in% defaultModels[names(defaultModels) == "COGARCH"]){
- par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter
- par <- unique(c(par at drift, par at xinit))
- startmin <- rep(lower, length(par))
- startmax <- rep(upper, length(par))
- names(startmin) <- par
- names(startmax) <- par
- startmin["a0"] <- ifelse(is.na(lower),NA,0)
- startmax["a0"] <- ifelse(is.na(upper),NA,1000)
-# if (!is.na(jumps)){
-# boundsJump <- jumpBounds(jumps = jumps, lower = lower, upper = upper)
-# for (i in par[par %in% names(boundsJump$lower)]){
-# startmin[[i]] <- boundsJump$lower[[i]]
-# startmax[[i]] <- boundsJump$upper[[i]]
-# }
-# }
- return(list(lower=as.list(startmin), upper=as.list(startmax)))
- }
- if (name %in% defaultModels[names(defaultModels) == "CARMA"]){
- par <- setModelByName(name = name, jumps = jumps, AR_C = AR_C, MA_C = MA_C)@parameter
- par <- unique(c(par at drift, par at xinit))
- startmin <- rep(lower, length(par))
- startmax <- rep(upper, length(par))
- names(startmin) <- par
- names(startmax) <- par
-# if (!is.na(jumps)){
-# boundsJump <- jumpBounds(jumps = jumps, lower = lower, upper = upper)
-# for (i in par[par %in% names(boundsJump$lower)]){
-# startmin[[i]] <- boundsJump$lower[[i]]
-# startmax[[i]] <- boundsJump$upper[[i]]
-# }
-# }
- return(list(lower=as.list(startmin), upper=as.list(startmax)))
- }
->>>>>>> .r498
if (name == "Brownian Motion" | name == "Bm")
return (list(lower=list("sigma"=0, "mu"=lower*delta), upper=list("sigma"=upper*sqrt(delta), "mu"=upper*delta)))
if (name == "Geometric Brownian Motion" | name == "gBm")
@@ -404,7 +352,6 @@
if (isolate({usr_models$model[[name]]$class=="Compound Poisson"}))
return(setPoisson(intensity = isolate({usr_models$model[[name]]$intensity}), df = setJumps(jumps = jumps), solve.variable = "x"))
}
-<<<<<<< .mine
if (name == "Brownian Motion" | name == "Bm") return(yuima::setModel(drift="mu", diffusion="sigma", solve.variable = "x"))
if (name == "Geometric Brownian Motion" | name == "gBm") return(yuima::setModel(drift="mu*x", diffusion="sigma*x", solve.variable = "x"))
if (name == "Ornstein-Uhlenbeck (OU)" | name == "OU") return(yuima::setModel(drift="-theta*x", diffusion="sigma", solve.variable = "x"))
@@ -424,57 +371,6 @@
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))
-||||||| .r460
- if (name == "Brownian Motion" | name == "Bm")
- return(yuima::setModel(drift="mu", diffusion="sigma", solve.variable = "x"))
- if (name == "Geometric Brownian Motion" | name == "gBm")
- return(yuima::setModel(drift="mu*x", diffusion="sigma*x", solve.variable = "x"))
- if (name == "Ornstein-Uhlenbeck (OU)" | name == "OU")
- return(yuima::setModel(drift="-theta*x", diffusion="1", solve.variable = "x"))
- if (name == "Vasicek model (VAS)" | name == "VAS")
- return(yuima::setModel(drift="theta1-theta2*x", diffusion="theta3", solve.variable = "x"))
- if (name == "Constant elasticity of variance (CEV)" | name == "CEV")
- return(yuima::setModel(drift="mu*x", diffusion="sigma*x^gamma", solve.variable = "x"))
- if (name == "Cox-Ingersoll-Ross (CIR)" | name == "CIR")
- return(yuima::setModel(drift="theta1-theta2*x", diffusion="theta3*sqrt(x)", solve.variable = "x"))
- if (name == "Chan-Karolyi-Longstaff-Sanders (CKLS)" | name == "CKLS")
- return(yuima::setModel(drift="theta1+theta2*x", diffusion="theta3*x^theta4", solve.variable = "x"))
- if (name == "Hyperbolic (Barndorff-Nielsen)" | name == "hyp1")
- return(yuima::setModel(drift="(sigma/2)^2*(beta-alpha*((x-mu)/(sqrt(delta^2+(x-mu)^2))))", diffusion="sigma", solve.variable = "x"))
- if (name == "Hyperbolic (Bibby and Sorensen)" | name == "hyp2")
- return(yuima::setModel(drift="0", diffusion="sigma*exp(0.5*(alpha*sqrt(delta^2+(x-mu)^2)-beta*(x-mu)))", solve.variable = "x"))
- if (name == "Power Low Intensity") return(yuima::setPoisson(intensity="alpha*t^(beta)", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Constant Intensity") return(yuima::setPoisson(intensity="lambda", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Linear Intensity") return(yuima::setPoisson(intensity="alpha+beta*t", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Exponentially Decaying Intensity") return(yuima::setPoisson(intensity="alpha*exp(-beta*t)", df=setJumps(jumps), solve.variable = "x"))
- if (name == "Periodic Intensity") return(yuima::setPoisson(intensity="a/2*(1+cos(omega*t+phi))+b", df=setJumps(jumps), solve.variable = "x"))
-=======
- if (name == "Brownian Motion" | name == "Bm")
- return(yuima::setModel(drift="mu", diffusion="sigma", solve.variable = "x"))
- if (name == "Geometric Brownian Motion" | name == "gBm")
- return(yuima::setModel(drift="mu*x", diffusion="sigma*x", solve.variable = "x"))
- if (name == "Ornstein-Uhlenbeck (OU)" | name == "OU")
- return(yuima::setModel(drift="-theta*x", diffusion="1", solve.variable = "x"))
- if (name == "Vasicek model (VAS)" | name == "VAS")
- return(yuima::setModel(drift="theta1-theta2*x", diffusion="theta3", solve.variable = "x"))
- if (name == "Constant elasticity of variance (CEV)" | name == "CEV")
- return(yuima::setModel(drift="mu*x", diffusion="sigma*x^gamma", solve.variable = "x"))
- if (name == "Cox-Ingersoll-Ross (CIR)" | name == "CIR")
- return(yuima::setModel(drift="theta1-theta2*x", diffusion="theta3*sqrt(x)", solve.variable = "x"))
- if (name == "Chan-Karolyi-Longstaff-Sanders (CKLS)" | name == "CKLS")
- return(yuima::setModel(drift="theta1+theta2*x", diffusion="theta3*x^theta4", solve.variable = "x"))
- if (name == "Hyperbolic (Barndorff-Nielsen)" | name == "hyp1")
- return(yuima::setModel(drift="(sigma/2)^2*(beta-alpha*((x-mu)/(sqrt(delta^2+(x-mu)^2))))", diffusion="sigma", solve.variable = "x"))
- if (name == "Hyperbolic (Bibby and Sorensen)" | name == "hyp2")
- return(yuima::setModel(drift="0", diffusion="sigma*exp(0.5*(alpha*sqrt(delta^2+(x-mu)^2)-beta*(x-mu)))", solve.variable = "x"))
- if (name == "Power Low Intensity") return(yuima::setPoisson(intensity="alpha*t^(beta)", df=setJumps(jumps = jumps), solve.variable = "x"))
- if (name == "Constant Intensity") return(yuima::setPoisson(intensity="lambda", df=setJumps(jumps = jumps), solve.variable = "x"))
- if (name == "Linear Intensity") return(yuima::setPoisson(intensity="alpha+beta*t", df=setJumps(jumps = jumps), solve.variable = "x"))
- if (name == "Exponentially Decaying Intensity") return(yuima::setPoisson(intensity="alpha*exp(-beta*t)", df=setJumps(jumps = jumps), solve.variable = "x"))
- if (name == "Periodic Intensity") return(yuima::setPoisson(intensity="a/2*(1+cos(omega*t+phi))+b", df=setJumps(jumps = jumps), solve.variable = "x"))
- if (name == "Cogarch(p,q)") return(yuima::setCogarch(p = MA_C, q = AR_C, measure.type = "CP", measure = list(intensity = "lambda", df = setJumps(jumps = "Gaussian")), XinExpr = XinExpr, Cogarch.var="y", V.var="v", Latent.var="x", ma.par="MA", ar.par="AR"))
- if (name == "Carma(p,q)") return(yuima::setCarma(p = AR_C, q = MA_C, ma.par="MA", ar.par="AR", XinExpr = XinExpr))
->>>>>>> .r498
}
printModelLatex <- function(names, process, jumps = NA){
@@ -557,12 +453,11 @@
###Function to convert unit of measure of the estimates
-changeBase <- function(param, StdErr, delta, original.data, paramName, modelName, newBase, session, choicesUI, anchorId, alertId, allParam){
+changeBaseP <- function(param, StdErr, delta, original.data, paramName, modelName, newBase, allParam){
+ msg <- NULL
if (newBase == "delta")
- return(list("Estimate"= param, "Std. Error"=StdErr))
+ return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
if(class(index(original.data))=="Date"){
- shinyjs::show(choicesUI)
- closeAlert(session, alertId = alertId)
seriesLength <- as.numeric(difftime(end(original.data),start(original.data)),units="days")
if (newBase == "Yearly") dt1 <- seriesLength/365/(length(original.data)-1)
if (newBase == "Semestral") dt1 <- seriesLength/182.50/(length(original.data)-1)
@@ -574,75 +469,110 @@
if (newBase == "Daily") dt1 <- seriesLength/(length(original.data)-1)
}
if(class(index(original.data))=="numeric"){
- shinyjs::hide(choicesUI)
dt1 <- as.numeric(end(original.data) - start(original.data))/(length(original.data)-1)
- closeAlert(session, alertId)
- createAlert(session = session, anchorId = anchorId, alertId = alertId, content = "Parameters are in the same unit of measure of input data", style = "info")
+ msg <- "Parameters are in the same unit of measure of input data"
}
if (modelName %in% c("Brownian Motion","Bm","Geometric Brownian Motion","gBm")){
- if(paramName == "mu") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1)))
+ if(paramName == "mu") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1), "msg"=msg))
}
if (modelName %in% c("Ornstein-Uhlenbeck (OU)","OU")){
- if(paramName == "theta") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1)))
+ if(paramName == "theta") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1), "msg"=msg))
}
if (modelName %in% c("Vasicek model (VAS)","VAS")){
- if(paramName == "theta1") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "theta2") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "theta3") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1)))
+ if(paramName == "theta1") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "theta2") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "theta3") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1), "msg"=msg))
}
if (modelName %in% c("Constant elasticity of variance (CEV)","CEV")){
- if(paramName == "mu") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1)))
- if(paramName == "gamma") return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName == "mu") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1), "msg"=msg))
+ if(paramName == "gamma") return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
if (modelName %in% c("Cox-Ingersoll-Ross (CIR)","CIR")){
- if(paramName == "theta1") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "theta2") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "theta3") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1)))
+ if(paramName == "theta1") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "theta2") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "theta3") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1), "msg"=msg))
}
if (modelName %in% c("Chan-Karolyi-Longstaff-Sanders (CKLS)","CKLS")){
- if(paramName == "theta1") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "theta2") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "theta3") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1)))
- if(paramName == "theta4") return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName == "theta1") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "theta2") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "theta3") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1), "msg"=msg))
+ if(paramName == "theta4") return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
if (modelName %in% c("Hyperbolic (Barndorff-Nielsen)", "Hyperbolic (Bibby and Sorensen)")){
- if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1)))
- if(paramName == "beta") return(list("Estimate"= param, "Std. Error"=StdErr))
- if(paramName == "alpha") return(list("Estimate"= param, "Std. Error"=StdErr))
- if(paramName == "mu") return(list("Estimate"= param, "Std. Error"=StdErr))
- if(paramName == "delta") return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName == "sigma") return(list("Estimate"= param*sqrt(delta/dt1), "Std. Error"=StdErr*sqrt(delta/dt1), "msg"=msg))
+ if(paramName == "beta") return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
+ if(paramName == "alpha") return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
+ if(paramName == "mu") return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
+ if(paramName == "delta") return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
if (modelName %in% c("Constant Intensity")){
- if(paramName == "lambda") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName %in% c("mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName == "lambda") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName %in% c("mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
if (modelName %in% c("Linear Intensity")){
- if(paramName == "alpha") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName == "beta") return(list("Estimate"= param*(delta/dt1)^2, "Std. Error"=StdErr*(delta/dt1)^2))
- if(paramName %in% c("mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName == "alpha") return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName == "beta") return(list("Estimate"= param*(delta/dt1)^2, "Std. Error"=StdErr*(delta/dt1)^2, "msg"=msg))
+ if(paramName %in% c("mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
if (modelName %in% c("Power Low Intensity")){
beta <- as.numeric(allParam["beta"])
- if(paramName == "alpha") return(list("Estimate"= param*(delta/dt1)^(beta+1), "Std. Error"=StdErr*(delta/dt1)^(beta+1)))
- if(paramName %in% c("beta", "mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName == "alpha") return(list("Estimate"= param*(delta/dt1)^(beta+1), "Std. Error"=StdErr*(delta/dt1)^(beta+1), "msg"=msg))
+ if(paramName %in% c("beta", "mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
if (modelName %in% c("Exponentially Decaying Intensity")){
- if(paramName %in% c("alpha", "beta")) return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName %in% c("mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName %in% c("alpha", "beta")) return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName %in% c("mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
if (modelName %in% c("Periodic Intensity")){
- if(paramName %in% c("a", "b", "omega")) return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1))
- if(paramName %in% c("phi", "mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr))
+ if(paramName %in% c("a", "b", "omega")) return(list("Estimate"= param*delta/dt1, "Std. Error"=StdErr*delta/dt1, "msg"=msg))
+ if(paramName %in% c("phi", "mu_jump", "sigma_jump", "a_jump", "b_jump")) return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg))
}
+ msg <- paste("No parameters conversion available for this model. Parameters have been obtained using delta = ", delta)
+ return(list("Estimate"= param, "Std. Error"=StdErr, "msg"=msg, "conversion"=FALSE))
+}
+
+###Function to manipulate digits
+signifDigits <- function(value, sd){
+ if (is.na(sd) | sd=="NaN" | sd==0)
+ return (value)
+ else{
+ pow <- 10^(1-as.integer(log10(as.numeric(sd))))
+ return(round(as.numeric(value)*pow)/pow)
+ }
+}
+
+changeBase <- function(table, yuimaGUI, newBase = input$baseModels, session = session, choicesUI="baseModels", anchorId = "modelsAlert", alertId = "modelsAlert_conversion"){
closeAlert(session, alertId)
- createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("No parameters conversion available for this model. Parameters have been obtained using delta = ", delta), style = "warning")
- shinyjs::hide(choicesUI)
- return(list("Estimate"= param, "Std. Error"=StdErr))
+ shinyjs::toggle(id = choicesUI, condition = (class(index(yuimaGUI$model at data@original.data))=="Date"))
+ outputTable <- data.frame()
+ for (param in unique(colnames(table))){
+ temp <- changeBaseP(param = as.numeric(table["Estimate",param]), StdErr = as.numeric(table["Std. Error",param]), delta = yuimaGUI$model at sampling@delta, original.data = yuimaGUI$model at data@original.data, paramName = param, modelName = yuimaGUI$info$modName, newBase = newBase, allParam = table["Estimate",])
+ outputTable["Estimate",param] <- as.character(signifDigits(temp[["Estimate"]],temp[["Std. Error"]]))
+ outputTable["Std. Error",param] <- as.character(signifDigits(temp[["Std. Error"]],temp[["Std. Error"]]))
+ }
+ colnames(outputTable) <- unique(colnames(table))
+ style <- "info"
+ msg <- NULL
+ if (any(outputTable["Std. Error",] %in% c(0, "NA", "NaN"))){
+ msg <- "The estimated model does not satisfy theoretical properties."
+ style <- "warning"
+ }
+ if (!is.null(temp$conversion)) if (temp$conversion==FALSE) shinyjs::hide(choicesUI)
+ if (yuimaGUI$info$class=="COGARCH") {
+ test <- try(Diagnostic.Cogarch(yuimaGUI$model, param = as.list(coef(yuimaGUI$qmle))))
+ if (class(test)=="try-error") createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("The estimated model does not satisfy theoretical properties.", temp$msg), style = "warning")
+ else if(test$stationary==FALSE | test$positivity==FALSE) createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("The estimated model does not satisfy theoretical properties.", temp$msg), style = "warning")
+ else createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste(msg, temp$msg), style = style)
+ }
+ else if (!is.null(temp$msg) | !is.null(msg)) createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste(msg, temp$msg), style = style)
+ return(outputTable)
}
+
+
qmleGUI <- function(upper, lower, ...){
if(length(upper)!=0 & length(lower)!=0)
return (qmle(upper = upper, lower = lower, ...))
@@ -654,7 +584,6 @@
return (qmle(...))
}
-<<<<<<< .mine
clearNA <- function(List){
for (i in names(List))
if (is.na(List[[i]]))
@@ -663,18 +592,6 @@
}
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){
-||||||| .r460
-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){
-=======
-clearNA <- function(List){
- for (i in names(List))
- if (is.na(List[[i]]))
- List[[i]] <- NULL
- return (List)
-}
-
-addModel <- function(modName, modClass, AR_C, MA_C, jumps, symbName, data, delta, start, startMin, startMax, trials, seed, method="BFGS", fixed = list(), lower, upper, joint=FALSE, aggregation=TRUE, threshold=NULL, session, anchorId, alertId){
->>>>>>> .r498
info <- list(
class = modClass,
modName = modName,
@@ -702,7 +619,6 @@
fixed <- clearNA(fixed)
lower <- clearNA(lower)
upper <- clearNA(upper)
-<<<<<<< .mine
if(toLog==TRUE) data <- try(log(data))
if(class(data)=="try-error"){
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")
@@ -719,34 +635,10 @@
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))
-||||||| .r460
- 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, MA_C = MA_C, AR_C = AR_C))
- index(model at data@original.data) <- index(data)
- parameters <- setModelByName(name = modName, jumps = jumps, MA_C = MA_C, AR_C = AR_C)@parameter
- if (modName == "Geometric Brownian Motion" | modName == "gBm"){
- X <- as.numeric(na.omit(Delt(data, type = "log")))
- alpha <- mean(X)/delta
- 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))
->>>>>>> .r498
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()
}
-<<<<<<< .mine
}
else if (modClass == "Fractional process"){
QMLEtemp <- try(mmfrac(model))
@@ -759,68 +651,7 @@
colnames(QMLE) <- col
rownames(QMLE) <- c("Estimate", "Std. Error")
}
-||||||| .r460
-=======
- }
- else if (modClass=="CARMA") {
- allParam <- unique(c(parameters at drift, parameters at xinit[1]))
- if (all(allParam %in% c(names(start),names(fixed))))
- QMLE <- try(qmleGUI(model, start = start, method = method, lower = lower, upper = upper))
- else {
- miss <- allParam[!(allParam %in% c(names(start),names(fixed)))]
- m2logL_prec <- NA
- na_prec <- NA
- withProgress(message = 'Step: ', value = 0, {
- for(iter in 1: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(qmleGUI(model, start = start, method = method, lower = lower, upper = upper))
- if (class(QMLEtemp)!="try-error") if (all(!is.na(summary(QMLEtemp)@coef[,"Estimate"])))
- break
- }
- if (class(QMLEtemp)!="try-error") if (all(!is.na(summary(QMLEtemp)@coef[,"Estimate"]))){
- repeat{
- m2logL <- summary(QMLEtemp)@m2logL
- coefTable <- summary(QMLEtemp)@coef
- for (param in rownames(coefTable))
- start[[param]] <- as.numeric(coefTable[param,"Estimate"])
- QMLEtemp <- try(qmleGUI(model, start = start, method = method, lower = lower, upper = upper))
- 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==trials & class(QMLEtemp)=="try-error" & !exists("QMLE")){
- createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("Unable to estimate ", modName," on ", symbName, ". Try to use 'Advanced Settings' and customize estimation.", sep = ""), style = "danger")
- return()
- }
- }
- })
- }
->>>>>>> .r498
}
-<<<<<<< .mine
else if (modClass=="CARMA") {
allParam <- parameters at drift
if (all(allParam %in% c(names(start),names(fixed))))
@@ -877,22 +708,7 @@
else if (modClass=="COGARCH") {
allParam <- unique(c(parameters at drift, parameters at xinit))
if (all(allParam %in% c(names(start),names(fixed))))
-||||||| .r460
- 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=="COGARCH") {
- allParam <- unique(c(parameters at drift, parameters at xinit))
- if (all(allParam %in% c(names(start),names(fixed))))
->>>>>>> .r498
QMLE <- try(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #REMOVE# joint = joint, aggregation = aggregation,
-<<<<<<< .mine
threshold = threshold, grideq = TRUE, rcpp = TRUE))
else {
miss <- allParam[!(allParam %in% c(names(start),names(fixed)))]
@@ -952,87 +768,6 @@
QMLE <- try(qmle(model, start = start, fixed = fixed, method = method, lower = lower, upper = upper, #REMOVE# joint = joint, aggregation = aggregation,
threshold = threshold))
else {
-||||||| .r460
- 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, grideq = TRUE, rcpp = TRUE))
- else {
- miss <- allParam[!(allParam %in% c(names(start),names(fixed)))]
- m2logL_prec <- NA
- na_prec <- NA
- withProgress(message = 'Step: ', value = 0, {
- for(iter in 1: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, grideq = TRUE, rcpp = TRUE))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 505
More information about the Yuima-commits
mailing list