[Yuima-commits] r526 - in pkg/yuimaGUI: . inst/yuimaGUI inst/yuimaGUI/www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 23 01:27:42 CET 2016
Author: phoenix844
Date: 2016-11-23 01:27:42 +0100 (Wed, 23 Nov 2016)
New Revision: 526
Modified:
pkg/yuimaGUI/DESCRIPTION
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
pkg/yuimaGUI/inst/yuimaGUI/www/custom.css
Log:
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2016-11-22 01:06:01 UTC (rev 525)
+++ pkg/yuimaGUI/DESCRIPTION 2016-11-23 00:27:42 UTC (rev 526)
@@ -1,10 +1,10 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the Yuima Package
-Version: 0.9.0
+Version: 0.9.1
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, reshape2
+Imports: DT (>= 0.2), shinyjs, shiny, shinydashboard, shinyBS, yuima, quantmod, sde, ggplot2
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-22 01:06:01 UTC (rev 525)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-23 00:27:42 UTC (rev 526)
@@ -7,7 +7,6 @@
require(shinydashboard)
require(shinyBS)
require(ggplot2)
-require(reshape2)
options(warn=-1)
@@ -46,6 +45,13 @@
return (do.call("rbind", dots))
}
+melt <- function(x){
+ V1 <- rep(rownames(x), ncol(x))
+ V2 <- sort(V1)
+ xx <- data.frame(Var1 = V1, Var2 = V2, value = NA)
+ for (i in 1:nrow(xx)) xx[i,"value"] <- x[as.character(xx[i,"Var1"]), as.character(xx[i,"Var2"])]
+ return(xx)
+}
observeEvent(yuimaGUIdata$series, priority = 10, {
yuimaGUItable$series <<- data.frame()
@@ -286,7 +292,10 @@
}
if (name == "Vasicek model (VAS)" | name == "VAS"){
if (strict==TRUE) return(list(lower=list("theta3"=0, "theta1"=NA, "theta2"=NA), upper=list("theta3"=NA, "theta1"=NA, "theta2"=NA)))
- else return(list(lower=list("theta3"=0, "theta1"=-1/delta, "theta2"=-1/delta), upper=list("theta3"=1/sqrt(delta), "theta1"=1/delta, "theta2"=1/delta)))
+ else {
+ mu <- abs(mean(as.numeric(data), na.rm = TRUE))
+ return(list(lower=list("theta3"=0, "theta1"=-0.1*mu/delta, "theta2"=-0.1/delta), upper=list("theta3"=1/sqrt(delta), "theta1"=0.1*mu/delta, "theta2"=0.1/delta)))
+ }
}
if (name == "Constant elasticity of variance (CEV)" | name == "CEV"){
if (strict==TRUE) return(list(lower=list("mu"=NA, "sigma"=0, "gamma"=0), upper=list("mu"=NA, "sigma"=NA, "gamma"=NA)))
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-22 01:06:01 UTC (rev 525)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-23 00:27:42 UTC (rev 526)
@@ -1025,7 +1025,152 @@
observe({
shinyjs::toggle("usr_model_saved_div", condition = length(names(usr_models$model))!=0)
})
+
+ observe({
+ test <- FALSE
+ choices <- NULL
+ if(length(names(yuimaGUIdata$model))!=0) for (i in names(yuimaGUIdata$model)) for (j in 1:length(yuimaGUIdata$model[[i]]))
+ if(yuimaGUIdata$model[[i]][[j]]$info$class %in% c("Diffusion process", "Compound Poisson")){
+ test <- TRUE
+ choices <- c(choices, paste(i,j))
+ }
+ shinyjs::toggle(id = "model_modal_fitting_body", condition = test)
+ shinyjs::toggle(id = "databaseModels_button_showResults", condition = test)
+ output$model_modal_model_id <- renderUI({
+ if (test==TRUE){
+ selectInput("model_modal_model_id", label = "Model ID", choices = choices)
+ }
+ })
+ })
+
+ observe({
+ if(!is.null(input$model_modal_model_id)) {
+ id <- unlist(strsplit(input$model_modal_model_id, split = " " , fixed = FALSE))
+ type <- isolate({yuimaGUIdata$model})[[id[1]]][[as.numeric(id[2])]]$info$class
+ shinyjs::toggle(id = "model_modal_plot_intensity", condition = type=="Compound Poisson")
+ shinyjs::toggle(id = "model_modal_plot_distr", condition = type %in% c("Diffusion process","Compound Poisson"))
+ }
+ })
+
+ observeEvent(input$model_modal_model_id,{
+ if(!is.null(input$model_modal_model_id)){
+ id <- unlist(strsplit(input$model_modal_model_id, split = " " , fixed = FALSE))
+ isolated_yuimaGUIdataModel <- isolate({yuimaGUIdata$model})
+ if(id[1] %in% names(isolated_yuimaGUIdataModel)) if (length(isolated_yuimaGUIdataModel[[id[1]]])>=as.integer(id[2])){
+ y <- isolated_yuimaGUIdataModel[[id[1]]][[as.numeric(id[2])]]
+
+ if (y$info$class=="Diffusion process"){
+
+ delta <- y$model at sampling@delta
+ x <- as.numeric(y$model at data@zoo.data[[1]])
+ x <- x[-length(x)]
+ dx <- diff(x)
+ for (i in names(y$qmle at coef)) assign(i, value = as.numeric(y$qmle at coef[i]))
+ z <- (dx-eval(y$model at model@drift)*delta)/(eval(y$model at model@diffusion[[1]])*sqrt(delta))
+ z <- data.frame("V1" = z)
+ output$model_modal_plot_distr <- renderPlot({
+ return(
+ ggplot(z, aes(x = V1)) +
+ theme(
+ plot.title = element_text(size=14, face= "bold", hjust = 0.5),
+ axis.title=element_text(size=12),
+ legend.position="none"
+ ) +
+ stat_function(fun = dnorm, args = list(mean = 0, sd = 1), fill = "blue",color = "blue", geom = 'area', alpha = 0.5) +
+ geom_density(alpha = 0.5, fill = "green", color = "green") +
+ xlim(-4, 4) +
+ labs(fill="", title = "Estimated VS Theoretical Distribution", x = "Increments", y = "Density")
+ )
+ })
+ ksTest <- try(ks.test(x = as.numeric(z$V1), "pnorm"))
+ output$model_modal_plot_test <- renderUI({
+ if(class(ksTest)!="try-error")
+ HTML(paste("<div><h5>Kolmogorov-Smirnov p-value (the two distributions coincide): ", format(ksTest$p.value, scientific=T, digits = 2), "</h5></div>"))
+ })
+ }
+
+ if (y$info$class=="Compound Poisson"){
+
+ x <- as.numeric(y$model at data@zoo.data[[1]])
+ dx <- diff(x)
+ dx <- dx[dx!=0]
+ for (i in names(y$qmle at coef)) assign(i, value = as.numeric(y$qmle at coef[i]))
+ dx <- data.frame("V1" = dx)
+ if(y$info$jumps=="Gaussian"){
+ output$model_modal_plot_distr <- renderPlot({
+ return(
+ ggplot(dx, aes(x = V1)) +
+ theme(
+ plot.title = element_text(size=14, face= "bold", hjust = 0.5),
+ axis.title=element_text(size=12),
+ legend.position="none"
+ ) +
+ stat_function(fun = dnorm, args = list(mean = mu_jump, sd = sigma_jump), fill = "blue",color = "blue", geom = 'area', alpha = 0.5) +
+ geom_density(alpha = 0.5, fill = "green", color = "green") +
+ xlim(-4, 4) +
+ labs(fill="", title = "Estimated VS Theoretical Distribution", x = "Increments", y = "Density")
+ )
+ })
+ ksTest <- try(ks.test(x = as.numeric(dx$V1), "pnorm", mean = mu_jump, sd = sigma_jump))
+ output$model_modal_plot_test <- renderUI({
+ if(class(ksTest)!="try-error")
+ HTML(paste("<div><h5>Kolmogorov-Smirnov p-value (the two distributions coincide): ", format(ksTest$p.value, scientific=T, digits = 2), "</h5></div>"))
+ })
+ }
+ if(y$info$jumps=="Uniform"){
+ output$model_modal_plot_distr <- renderPlot({
+ return(
+ ggplot(dx, aes(x = V1)) +
+ theme(
+ plot.title = element_text(size=14, face= "bold", hjust = 0.5),
+ axis.title=element_text(size=12),
+ legend.position="none"
+ ) +
+ stat_function(fun = dunif, args = list(min = a_jump, max = b_jump), fill = "blue",color = "blue", geom = 'area', alpha = 0.5) +
+ geom_density(alpha = 0.5, fill = "green", color = "green") +
+ xlim(min(dx$V1),max(dx$V1)) +
+ labs(fill="", title = "Estimated VS Theoretical Distribution", x = "Increments", y = "Density")
+ )
+ })
+ ksTest <- try(ks.test(x = as.numeric(dx$V1), "punif", min = a_jump, max = b_jump))
+ output$model_modal_plot_test <- renderUI({
+ if(class(ksTest)!="try-error")
+ HTML(paste("<div><h5>Kolmogorov-Smirnov p-value (the two distributions coincide): ", format(ksTest$p.value, scientific=T, digits = 2), "</h5></div>"))
+ })
+ }
+
+ delta <- y$model at sampling@delta
+ jumps <- ifelse(diff(x)==0,0,1)
+ jumps[is.na(jumps)] <- 0
+ empirical_Lambda <- cumsum(jumps)
+ t <- y$model at sampling@grid[[1]][-1]
+ theory_Lambda <- cumsum(eval(y$model at model@measure$intensity)*rep(delta, length(t)))
+ Lambda <- data.frame(empirical = empirical_Lambda, theory = theory_Lambda, time = index(y$model at data@original.data)[-1])
+ output$model_modal_plot_intensity <- renderPlot({
+ return(
+ ggplot(Lambda, aes(x = time)) +
+ geom_line(aes(y = empirical), size = 1, color = "green") +
+ geom_line(aes(y = theory), size = 1, color = "blue") +
+ scale_color_manual(values=c("green", "blue")) +
+ theme(
+ plot.title = element_text(size=14, face= "bold", hjust = 0.5),
+ axis.title=element_text(size=12),
+ legend.position="none"
+ ) +
+ labs(fill="", title = "Estimated VS Theoretical Intensity", x = "", y = "Number of Jumps")
+ )
+ })
+
+ }
+ }
+ }
+ })
+
+
+
+
+
###Delete Model
observeEvent(input$databaseModelsDelete, priority = 1, {
if(!is.null(input$databaseModels_rows_selected) & !is.null(input$databaseModels_row_last_clicked)){
Modified: pkg/yuimaGUI/inst/yuimaGUI/ui.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-22 01:06:01 UTC (rev 525)
+++ pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-23 00:27:42 UTC (rev 526)
@@ -287,11 +287,28 @@
),
br(),
fluidRow(
- column(8),
+ column(2,actionButton(inputId = "databaseModels_button_showResults", label = "Show Fitting")),
+ bsTooltip("databaseModels_button_showResults", title = "Available for: Diffusive Processes", placement = "top"),
+ column(6),
column(2,actionButton(inputId = "databaseModelsDelete", label = "Delete")),
bsTooltip("databaseModelsDelete", title = "Delete selected model", placement = "top"),
column(2,actionButton(inputId = "databaseModelsDeleteAll", label = "Delete All")),
bsTooltip("databaseModelsDeleteAll", title = "Delete all models that are displayed", placement = "top")
+ ),
+ bsModal(id = "model_modal_fitting", title = "Fitting", trigger = "databaseModels_button_showResults", size = "Large",
+ div(id = "model_modal_fitting_body",
+ fluidRow(
+ column(2),
+ column(8, uiOutput("model_modal_model_id", align = "center"))
+ ),
+ fluidRow(
+ column(12,
+ plotOutput("model_modal_plot_intensity"),
+ plotOutput("model_modal_plot_distr"),
+ uiOutput("model_modal_plot_test", align = "center")
+ )
+ )
+ )
)
)
))),
Modified: pkg/yuimaGUI/inst/yuimaGUI/www/custom.css
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/www/custom.css 2016-11-22 01:06:01 UTC (rev 525)
+++ pkg/yuimaGUI/inst/yuimaGUI/www/custom.css 2016-11-23 00:27:42 UTC (rev 526)
@@ -223,7 +223,7 @@
}
-#simulate_monitor_button_showSimulation {
+#simulate_monitor_button_showSimulation, #databaseModels_button_showResults {
color: #ffffff;
background: radial-gradient(#662900, #ff8533, #662900);
font-size: 110%;
More information about the Yuima-commits
mailing list