[Yuima-commits] r611 - in pkg/yuimaGUI: . inst/yuimaGUI inst/yuimaGUI/server inst/yuimaGUI/server/eda inst/yuimaGUI/server/finance inst/yuimaGUI/server/home inst/yuimaGUI/server/load_data inst/yuimaGUI/server/modeling inst/yuimaGUI/server/simulation inst/yuimaGUI/ui inst/yuimaGUI/ui/eda inst/yuimaGUI/ui/finance inst/yuimaGUI/ui/home inst/yuimaGUI/ui/load_data inst/yuimaGUI/ui/modeling inst/yuimaGUI/ui/simulation inst/yuimaGUI/www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu May 4 21:18:53 CEST 2017
Author: phoenix844
Date: 2017-05-04 21:18:53 +0200 (Thu, 04 May 2017)
New Revision: 611
Added:
pkg/yuimaGUI/inst/yuimaGUI/server/
pkg/yuimaGUI/inst/yuimaGUI/server/eda/
pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_non_parametric.R
pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R
pkg/yuimaGUI/inst/yuimaGUI/server/eda/clustering.R
pkg/yuimaGUI/inst/yuimaGUI/server/eda/llag_and_corr.R
pkg/yuimaGUI/inst/yuimaGUI/server/finance/
pkg/yuimaGUI/inst/yuimaGUI/server/finance/profit_and_loss.R
pkg/yuimaGUI/inst/yuimaGUI/server/functions.R
pkg/yuimaGUI/inst/yuimaGUI/server/home/
pkg/yuimaGUI/inst/yuimaGUI/server/home/home.R
pkg/yuimaGUI/inst/yuimaGUI/server/load_data/
pkg/yuimaGUI/inst/yuimaGUI/server/load_data/finance.R
pkg/yuimaGUI/inst/yuimaGUI/server/load_data/your_file.R
pkg/yuimaGUI/inst/yuimaGUI/server/modeling/
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_set_model.R
pkg/yuimaGUI/inst/yuimaGUI/server/modeling/univariate_start_estimation.R
pkg/yuimaGUI/inst/yuimaGUI/server/settings.R
pkg/yuimaGUI/inst/yuimaGUI/server/simulation/
pkg/yuimaGUI/inst/yuimaGUI/server/simulation/univariate_estimated.R
pkg/yuimaGUI/inst/yuimaGUI/server/simulation/univariate_non_estimated.R
pkg/yuimaGUI/inst/yuimaGUI/server/simulation/univariate_results.R
pkg/yuimaGUI/inst/yuimaGUI/ui/
pkg/yuimaGUI/inst/yuimaGUI/ui/eda/
pkg/yuimaGUI/inst/yuimaGUI/ui/eda/changepoint.R
pkg/yuimaGUI/inst/yuimaGUI/ui/eda/cluster.R
pkg/yuimaGUI/inst/yuimaGUI/ui/eda/llag.R
pkg/yuimaGUI/inst/yuimaGUI/ui/finance/
pkg/yuimaGUI/inst/yuimaGUI/ui/finance/hedging.R
pkg/yuimaGUI/inst/yuimaGUI/ui/home/
pkg/yuimaGUI/inst/yuimaGUI/ui/home/home.R
pkg/yuimaGUI/inst/yuimaGUI/ui/load_data/
pkg/yuimaGUI/inst/yuimaGUI/ui/load_data/finData.R
pkg/yuimaGUI/inst/yuimaGUI/ui/load_data/yourData.R
pkg/yuimaGUI/inst/yuimaGUI/ui/modeling/
pkg/yuimaGUI/inst/yuimaGUI/ui/modeling/models.R
pkg/yuimaGUI/inst/yuimaGUI/ui/modeling/multi_models.R
pkg/yuimaGUI/inst/yuimaGUI/ui/simulation/
pkg/yuimaGUI/inst/yuimaGUI/ui/simulation/simulate.R
Modified:
pkg/yuimaGUI/DESCRIPTION
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
pkg/yuimaGUI/inst/yuimaGUI/www/black.css
pkg/yuimaGUI/inst/yuimaGUI/www/white.css
Log:
Code reorganized and introduced timeout for model estimation
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2017-04-29 16:38:26 UTC (rev 610)
+++ pkg/yuimaGUI/DESCRIPTION 2017-05-04 19:18:53 UTC (rev 611)
@@ -1,7 +1,7 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the 'yuima' Package
-Version: 1.0.1
+Version: 1.1.0
Author: YUIMA Project Team
Maintainer: Emanuele Guidotti <emanuele.guidotti at studenti.unimi.it>
Description: Provides a graphical user interface for the 'yuima' package.
Added: pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_non_parametric.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_non_parametric.R (rev 0)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_non_parametric.R 2017-05-04 19:18:53 UTC (rev 611)
@@ -0,0 +1,156 @@
+###Display available data
+output$changepoint_table_select <- DT::renderDataTable(options=list(scrollY = 150, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', selection = "multiple", rownames = FALSE,{
+ if (length(yuimaGUItable$series)==0){
+ NoData <- data.frame("Symb"=NA,"Please load some data first"=NA, check.names = FALSE)
+ return(NoData[-1,])
+ }
+ return (yuimaGUItable$series)
+})
+
+###Table of selected data to change point
+seriesToChangePoint <- reactiveValues(table=data.frame())
+
+###Select Button
+observeEvent(input$changepoint_button_select, priority = 1, {
+ seriesToChangePoint$table <<- rbind(seriesToChangePoint$table, yuimaGUItable$series[(rownames(yuimaGUItable$series) %in% rownames(yuimaGUItable$series)[input$changepoint_table_select_rows_selected]) & !(rownames(yuimaGUItable$series) %in% rownames(seriesToChangePoint$table)),])
+})
+
+###SelectAll Button
+observeEvent(input$changepoint_button_selectAll, priority = 1, {
+ seriesToChangePoint$table <<- rbind(seriesToChangePoint$table, yuimaGUItable$series[(rownames(yuimaGUItable$series) %in% rownames(yuimaGUItable$series)[input$changepoint_table_select_rows_all]) & !(rownames(yuimaGUItable$series) %in% rownames(seriesToChangePoint$table)),])
+})
+
+###Display Selected Data
+output$changepoint_table_selected <- DT::renderDataTable(options=list(order = list(1, 'desc'), scrollY = 150, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = FALSE, selection = "multiple",{
+ if (length(rownames(seriesToChangePoint$table))==0){
+ NoData <- data.frame("Symb"=NA,"Select from table beside"=NA, check.names = FALSE)
+ return(NoData[-1,])
+ }
+ return (seriesToChangePoint$table)
+})
+
+###Control selected data to be in yuimaGUIdata$series
+observe({
+ if(length(seriesToChangePoint$table)!=0){
+ if (length(yuimaGUItable$series)==0)
+ seriesToChangePoint$table <<- data.frame()
+ else
+ seriesToChangePoint$table <<- seriesToChangePoint$table[which(as.character(seriesToChangePoint$table[,"Symb"]) %in% as.character(yuimaGUItable$series[,"Symb"])),]
+ }
+})
+
+###Delete Button
+observeEvent(input$changepoint_button_delete, priority = 1,{
+ if (!is.null(input$changepoint_table_selected_rows_selected))
+ seriesToChangePoint$table <<- seriesToChangePoint$table[-input$changepoint_table_selected_rows_selected,]
+})
+
+###DeleteAll Button
+observeEvent(input$changepoint_button_deleteAll, priority = 1,{
+ if (!is.null(input$changepoint_table_selected_rows_all))
+ seriesToChangePoint$table <<- seriesToChangePoint$table[-input$changepoint_table_selected_rows_all,]
+})
+
+observe({
+ shinyjs::toggle("changepoint_charts", condition = (length(names(yuimaGUIdata$cp))!=0))
+})
+
+observe({
+ shinyjs::toggle("parametric_changepoint_charts", condition = (length(names(yuimaGUIdata$cpYuima))!=0))
+})
+
+output$changepoint_symb <- renderUI({
+ n <- names(yuimaGUIdata$cp)
+ if(length(n)!=0)
+ selectInput("changepoint_symb", "Symbol", choices = sort(n), selected = last(n))
+})
+
+observeEvent(input$changepoint_button_startEstimation, {
+ if (length(rownames(seriesToChangePoint$table))!=0)
+ withProgress(message = 'Analyzing: ', value = 0, {
+ errors <- c()
+ for (i in rownames(seriesToChangePoint$table)){
+ incProgress(1/length(rownames(seriesToChangePoint$table)), detail = i)
+ errors <- c(errors, addCPoint_distribution(symb = i, method = input$changepoint_method, pvalue = input$changepoint_pvalue)$error)
+ }
+ if(!is.null(errors))
+ createAlert(session = session, anchorId = "nonparametric_changepoint_alert", content = paste("Unable to estimate change points of:", paste(errors, collapse = " ")), dismiss = T, style = "error")
+ })
+})
+
+range_changePoint <- reactiveValues(x=NULL, y=NULL)
+observe({
+ if (!is.null(input$changePoint_brush) & !is.null(input$changepoint_symb)){
+ data <- yuimaGUIdata$cp[[input$changepoint_symb]]$series
+ test <- (length(index(window(data, start = input$changePoint_brush$xmin, end = input$changePoint_brush$xmax))) > 3)
+ if (test==TRUE){
+ range_changePoint$x <- c(as.Date(input$changePoint_brush$xmin), as.Date(input$changePoint_brush$xmax))
+ range_changePoint$y <- c(input$changePoint_brush$ymin, input$changePoint_brush$ymax)
+ }
+ }
+})
+
+observeEvent(input$changePoint_dbclick,{
+ range_changePoint$x <- c(NULL, NULL)
+})
+
+observeEvent(input$changepoint_symb, {
+ range_changePoint$x <- c(NULL, NULL)
+ output$changepoint_plot_series <- renderPlot({
+ if(!is.null(input$changepoint_symb)) {
+ cp <- isolate({yuimaGUIdata$cp[[input$changepoint_symb]]})
+ par(bg="black")
+ plot(window(cp$series, start = range_changePoint$x[1], end = range_changePoint$x[2]), main=cp$symb, xlab="Index", ylab=NA, log=switch(input$changepoint_scale,"Linear"="","Logarithmic (Y)"="y", "Logarithmic (X)"="x", "Logarithmic (XY)"="xy"), col="green", col.axis="grey", col.lab="grey", col.main="grey", fg="black")
+ abline(v=cp$tau, col = "red")
+ grid(col="grey")
+ }
+ })
+ output$changepoint_plot_incr <- renderPlot({
+ if(!is.null(input$changepoint_symb)) {
+ cp <- isolate({yuimaGUIdata$cp[[input$changepoint_symb]]})
+ if(cp$method=="KSdiff") {
+ x <- diff(cp$series)
+ title <- " - Increments"
+ }
+ else {
+ x <- Delt(cp$series)
+ title <- " - Percentage Increments"
+ }
+ x <- x[x[,1]!="Inf"]
+ par(bg="black")
+ plot(window(x, start = range_changePoint$x[1], end = range_changePoint$x[2]), main=paste(cp$symb, title), xlab="Index", ylab=NA, log=switch(input$changepoint_scale,"Linear"="","Logarithmic (Y)"="", "Logarithmic (X)"="x", "Logarithmic (XY)"="x"), col="green", col.axis="grey", col.lab="grey", col.main="grey", fg="black")
+ abline(v=cp$tau, col = "red")
+ grid(col="grey")
+ }
+ })
+})
+
+
+output$text_ChangePointInfo <- renderUI({
+ if(!is.null(input$changepoint_symb)){
+ info <- yuimaGUIdata$cp[[input$changepoint_symb]]
+ div(
+ h3(input$changepoint_symb, class = "hModal"),
+ h4(
+ em(switch(info$method, "KSdiff"="Increments Distriution", "KSperc"="Percentage Increments Distriution")), br(),
+ class = "hModal"
+ ),
+ align="center"
+ )
+ }
+})
+
+
+output$table_ChangePointInfo <- renderTable(digits = 4, {
+ table <- data.frame(Time = as.character(yuimaGUIdata$cp[[input$changepoint_symb]]$tau), "p.value" = yuimaGUIdata$cp[[input$changepoint_symb]]$pvalue, check.names = FALSE, row.names = yuimaGUIdata$cp[[input$changepoint_symb]]$tau)
+ return(table[order(rownames(table), decreasing = TRUE),])
+})
+
+observeEvent(input$changepoint_button_delete_estimated, {
+ yuimaGUIdata$cp[[input$changepoint_symb]] <<- NULL
+})
+
+observeEvent(input$changepoint_button_deleteAll_estimated, {
+ yuimaGUIdata$cp <<- list()
+})
+
Added: pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R (rev 0)
+++ pkg/yuimaGUI/inst/yuimaGUI/server/eda/changepoint_parametric.R 2017-05-04 19:18:53 UTC (rev 611)
@@ -0,0 +1,512 @@
+###Display available data
+output$parametric_changepoint_table_select <- DT::renderDataTable(options=list(scrollY = 150, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', selection = "multiple", rownames = FALSE,{
+ if (length(yuimaGUItable$series)==0){
+ NoData <- data.frame("Symb"=NA,"Please load some data first"=NA, check.names = FALSE)
+ return(NoData[-1,])
+ }
+ return (yuimaGUItable$series)
+})
+
+###Table of selected data to change point
+parametric_seriesToChangePoint <- reactiveValues(table=data.frame())
+
+###Select Button
+observeEvent(input$parametric_changepoint_button_select, priority = 1, {
+ parametric_seriesToChangePoint$table <<- rbind(parametric_seriesToChangePoint$table, yuimaGUItable$series[(rownames(yuimaGUItable$series) %in% rownames(yuimaGUItable$series)[input$parametric_changepoint_table_select_rows_selected]) & !(rownames(yuimaGUItable$series) %in% rownames(parametric_seriesToChangePoint$table)),])
+})
+
+###SelectAll Button
+observeEvent(input$parametric_changepoint_button_selectAll, priority = 1, {
+ parametric_seriesToChangePoint$table <<- rbind(parametric_seriesToChangePoint$table, yuimaGUItable$series[(rownames(yuimaGUItable$series) %in% rownames(yuimaGUItable$series)[input$parametric_changepoint_table_select_rows_all]) & !(rownames(yuimaGUItable$series) %in% rownames(parametric_seriesToChangePoint$table)),])
+})
+
+###Display Selected Data
+output$parametric_changepoint_table_selected <- DT::renderDataTable(options=list(order = list(1, 'desc'), scrollY = 150, scrollCollapse = FALSE, deferRender = FALSE, dom = 'frtS'), extensions = 'Scroller', rownames = FALSE, selection = "multiple",{
+ if (length(rownames(parametric_seriesToChangePoint$table))==0){
+ NoData <- data.frame("Symb"=NA,"Select from table beside"=NA, check.names = FALSE)
+ return(NoData[-1,])
+ }
+ return (parametric_seriesToChangePoint$table)
+})
+
+###Control selected data to be in yuimaGUIdata$series
+observe({
+ if(length(parametric_seriesToChangePoint$table)!=0){
+ if (length(yuimaGUItable$series)==0)
+ parametric_seriesToChangePoint$table <<- data.frame()
+ else
+ parametric_seriesToChangePoint$table <<- parametric_seriesToChangePoint$table[which(as.character(parametric_seriesToChangePoint$table[,"Symb"]) %in% as.character(yuimaGUItable$series[,"Symb"])),]
+ }
+})
+
+###Delete Button
+observeEvent(input$parametric_changepoint_button_delete, priority = 1,{
+ if (!is.null(input$parametric_changepoint_table_selected_rows_selected))
+ parametric_seriesToChangePoint$table <<- parametric_seriesToChangePoint$table[-input$parametric_changepoint_table_selected_rows_selected,]
+})
+
+###DeleteAll Button
+observeEvent(input$parametric_changepoint_button_deleteAll, priority = 1,{
+ if (!is.null(input$parametric_changepoint_table_selected_rows_all))
+ parametric_seriesToChangePoint$table <<- parametric_seriesToChangePoint$table[-input$parametric_changepoint_table_selected_rows_all,]
+})
+
+output$parametric_changepoint_model <- renderUI({
+ choices <- as.vector(defaultModels[names(defaultModels)=="Diffusion process"])
+ sel <- choices[1]
+ for(i in names(yuimaGUIdata$usr_model))
+ if (yuimaGUIdata$usr_model[[i]]$class=="Diffusion process") choices <- c(i, choices)
+ selectInput("parametric_changepoint_model", label = "Model", choices = choices, multiple = FALSE, selected = sel)
+})
+
+
+###Interactive range of selectRange chart
+parametric_range_selectRange <- reactiveValues(x=NULL, y=NULL)
+observe({
+ if (!is.null(input$parametric_selectRange_brush) & !is.null(input$parametric_plotsRangeSeries)){
+ data <- getData(input$parametric_plotsRangeSeries)
+ test <- (length(index(window(data, start = input$parametric_selectRange_brush$xmin, end = input$parametric_selectRange_brush$xmax))) > 3)
+ if (test==TRUE){
+ parametric_range_selectRange$x <- c(as.Date(input$parametric_selectRange_brush$xmin), as.Date(input$parametric_selectRange_brush$xmax))
+ parametric_range_selectRange$y <- c(input$parametric_selectRange_brush$ymin, input$parametric_selectRange_brush$ymax)
+ }
+ }
+})
+
+
+observe({
+ shinyjs::toggle(id="parametric_plotsRangeErrorMessage", condition = nrow(parametric_seriesToChangePoint$table)==0)
+ shinyjs::toggle(id="parametric_plotsRangeAll", condition = nrow(parametric_seriesToChangePoint$table)!=0)
+})
+
+###Display charts: series and its increments
+observe({
+ symb <- input$parametric_plotsRangeSeries
+ if(!is.null(symb))
+ if (symb %in% rownames(yuimaGUItable$series)){
+ data <- getData(symb)
+ incr <- na.omit(Delt(data, type = "arithmetic"))
+ condition <- all(is.finite(incr))
+ shinyjs::toggle("parametric_selectRangeReturns", condition = condition)
+ parametric_range_selectRange$x <- NULL
+ parametric_range_selectRange$y <- NULL
+ start <- as.character(parametric_seriesToChangePoint$table[input$parametric_plotsRangeSeries,"From"])
+ end <- as.character(parametric_seriesToChangePoint$table[input$parametric_plotsRangeSeries,"To"])
+ if(class(index(data))=="numeric"){
+ start <- as.numeric(start)
+ end <- as.numeric(end)
+ }
+ output$parametric_selectRange <- renderPlot({
+ if ((symb %in% rownames(yuimaGUItable$series) & (symb %in% rownames(parametric_seriesToChangePoint$table)))){
+ par(bg="black")
+ plot.zoo(window(data, start = parametric_range_selectRange$x[1], end = parametric_range_selectRange$x[2]), main=symb, xlab="Index", ylab=NA, log=switch(input$parametric_scale_selectRange,"Linear"="","Logarithmic (Y)"="y", "Logarithmic (X)"="x", "Logarithmic (XY)"="xy"), col="grey", col.axis="grey", col.lab="grey", col.main="grey", fg="black")
+ lines(window(data, start = start, end = end), col = "green")
+ grid(col="grey")
+ }
+ })
+ output$parametric_selectRangeReturns <- renderPlot({
+ if (symb %in% rownames(yuimaGUItable$series) & (symb %in% rownames(parametric_seriesToChangePoint$table)) & condition){
+ par(bg="black")
+ plot.zoo( window(incr, start = parametric_range_selectRange$x[1], end = parametric_range_selectRange$x[2]), main=paste(symb, " - Percentage Increments"), xlab="Index", ylab=NA, log=switch(input$parametric_scale_selectRange,"Linear"="","Logarithmic (Y)"="", "Logarithmic (X)"="x", "Logarithmic (XY)"="x"), col="grey", col.axis="grey", col.lab="grey", col.main="grey", fg="black")
+ lines(window(incr, start = start, end = end), col = "green")
+ grid(col="grey")
+ }
+ })
+ }
+})
+
+
+output$parametric_plotsRangeSeries <- renderUI({
+ selectInput("parametric_plotsRangeSeries", label = "Series", choices = rownames(parametric_seriesToChangePoint$table), selected = input$parametric_plotsRangeSeries)
+})
+
+###Choose Range input set to "Select range from charts" if charts have been brushed
+output$parametric_chooseRange <- renderUI({
+ sel <- "full"
+ if (!is.null(parametric_range_selectRange$x)) sel <- "selected"
+ selectInput("parametric_chooseRange", label = "Range", choices = c("Full Range" = "full", "Select Range from Charts" = "selected", "Specify Range" = "specify"), selected = sel)
+})
+
+output$parametric_chooseRange_specify <- renderUI({
+ if(!is.null(input$parametric_plotsRangeSeries)) {
+ data <- getData(input$parametric_plotsRangeSeries)
+ if(class(index(data))=="numeric")
+ return(div(
+ column(6,numericInput("parametric_chooseRange_specify_t0", label = "From", min = start(data), max = end(data), value = start(data))),
+ column(6,numericInput("parametric_chooseRange_specify_t1", label = "To", min = start(data), max = end(data), value = end(data)))
+ ))
+ if(class(index(data))=="Date")
+ return(dateRangeInput("parametric_chooseRange_specify_date", start = start(data), end = end(data), label = "Specify Range"))
+ }
+})
+
+
+observe({
+ shinyjs::toggle(id = "parametric_chooseRange_specify", condition = (input$parametric_chooseRange)=="specify")
+})
+
+###Function to update data range to use to estimate models
+updateRange_parametric_seriesToChangePoint <- function(symb, range = c("full","selected","specify"), type = c("Date", "numeric")){
+ for (i in symb){
+ data <- getData(i)
+ if (range == "full"){
+ levels(parametric_seriesToChangePoint$table[,"From"]) <- c(levels(parametric_seriesToChangePoint$table[,"From"]), as.character(start(data)))
+ levels(parametric_seriesToChangePoint$table[,"To"]) <- c(levels(parametric_seriesToChangePoint$table[,"To"]), as.character(end(data)))
+ parametric_seriesToChangePoint$table[i,"From"] <<- as.character(start(data))
+ parametric_seriesToChangePoint$table[i,"To"] <<- as.character(end(data))
+ }
+ if (range == "selected"){
+ if(!is.null(parametric_range_selectRange$x) & class(index(data))==type){
+ start <- parametric_range_selectRange$x[1]
+ end <- parametric_range_selectRange$x[2]
+ if(class(index(data))=="numeric"){
+ start <- as.numeric(start)
+ end <- as.numeric(end)
+ }
+ start <- max(start(data),start)
+ end <- min(end(data), end)
+ levels(parametric_seriesToChangePoint$table[,"From"]) <- c(levels(parametric_seriesToChangePoint$table[,"From"]), as.character(start))
+ levels(parametric_seriesToChangePoint$table[,"To"]) <- c(levels(parametric_seriesToChangePoint$table[,"To"]), as.character(end))
+ parametric_seriesToChangePoint$table[i,"From"] <<- as.character(start)
+ parametric_seriesToChangePoint$table[i,"To"] <<- as.character(end)
+ }
+ }
+ if (range == "specify"){
+ if(class(index(data))==type){
+ if(class(index(data))=="Date"){
+ start <- input$parametric_chooseRange_specify_date[1]
+ end <- input$parametric_chooseRange_specify_date[2]
+ }
+ if(class(index(data))=="numeric"){
+ start <- input$parametric_chooseRange_specify_t0
+ end <- input$parametric_chooseRange_specify_t1
+ }
+ start <- max(start(data),start)
+ end <- min(end(data), end)
+ levels(parametric_seriesToChangePoint$table[,"From"]) <- c(levels(parametric_seriesToChangePoint$table[,"From"]), as.character(start))
+ levels(parametric_seriesToChangePoint$table[,"To"]) <- c(levels(parametric_seriesToChangePoint$table[,"To"]), as.character(end))
+ parametric_seriesToChangePoint$table[i,"From"] <<- as.character(start)
+ parametric_seriesToChangePoint$table[i,"To"] <<- as.character(end)
+ }
+ }
+ }
+}
+
+###Apply selected range by double click
+observeEvent(input$parametric_selectRange_dbclick, priority = 1, {
+ updateRange_parametric_seriesToChangePoint(input$parametric_plotsRangeSeries, range = "selected", type = class(index(getData(input$parametric_plotsRangeSeries))))
+})
+
+###Apply selected range
+observeEvent(input$parametric_buttonApplyRange, priority = 1, {
+ updateRange_parametric_seriesToChangePoint(input$parametric_plotsRangeSeries, range = input$parametric_chooseRange, type = class(index(getData(input$parametric_plotsRangeSeries))))
+})
+
+###ApplyAll selected range
+observeEvent(input$parametric_buttonApplyAllRange, priority = 1, {
+ updateRange_parametric_seriesToChangePoint(rownames(parametric_seriesToChangePoint$table), range = input$parametric_chooseRange, type = class(index(getData(input$parametric_plotsRangeSeries))))
+})
+
+
+### Estimation Settings
+parametric_modal_prev_buttonDelta <- 0
+parametric_modal_prev_buttonAllDelta <- 0
+observe({
+ 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)))
+ 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"){
+ if (is.null(yuimaGUIsettings$estimation[[modName]]))
+ yuimaGUIsettings$estimation[[modName]] <<- list()
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]]))
+ yuimaGUIsettings$estimation[[modName]][[symb]] <<- list()
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["fixed"]]) | parametric_modal_prev_buttonDelta!=input$parametric_modal_button_applyDelta | parametric_modal_prev_buttonAllDelta!=input$parametric_modal_button_applyAllDelta)
+ yuimaGUIsettings$estimation[[modName]][[symb]][["fixed"]] <<- list()
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["start"]]) | parametric_modal_prev_buttonDelta!=input$parametric_modal_button_applyDelta | parametric_modal_prev_buttonAllDelta!=input$parametric_modal_button_applyAllDelta)
+ yuimaGUIsettings$estimation[[modName]][[symb]][["start"]] <<- list()
+
+ startMinMax <- defaultBounds(name = modName,
+ jumps = NA,
+ AR_C = NA,
+ MA_C = NA,
+ strict = FALSE,
+ data = data,
+ delta = yuimaGUIsettings$delta[[symb]])
+ upperLower <- defaultBounds(name = modName,
+ jumps = NA,
+ AR_C = NA,
+ MA_C = NA,
+ strict = TRUE,
+ data = data,
+ delta = yuimaGUIsettings$delta[[symb]])
+
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["startMin"]]) | parametric_modal_prev_buttonDelta!=input$parametric_modal_button_applyDelta | parametric_modal_prev_buttonAllDelta!=input$parametric_modal_button_applyAllDelta)
+ yuimaGUIsettings$estimation[[modName]][[symb]][["startMin"]] <<- startMinMax$lower
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["startMax"]]) | parametric_modal_prev_buttonDelta!=input$parametric_modal_button_applyDelta | parametric_modal_prev_buttonAllDelta!=input$parametric_modal_button_applyAllDelta)
+ yuimaGUIsettings$estimation[[modName]][[symb]][["startMax"]] <<- startMinMax$upper
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["upper"]]) | parametric_modal_prev_buttonDelta!=input$parametric_modal_button_applyDelta | parametric_modal_prev_buttonAllDelta!=input$parametric_modal_button_applyAllDelta)
+ yuimaGUIsettings$estimation[[modName]][[symb]][["upper"]] <<- upperLower$upper
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["lower"]]) | parametric_modal_prev_buttonDelta!=input$parametric_modal_button_applyDelta | parametric_modal_prev_buttonAllDelta!=input$parametric_modal_button_applyAllDelta)
+ yuimaGUIsettings$estimation[[modName]][[symb]][["lower"]] <<- upperLower$lower
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["method"]])){
+ yuimaGUIsettings$estimation[[modName]][[symb]][["method"]] <<- "L-BFGS-B"
+ }
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["trials"]]))
+ yuimaGUIsettings$estimation[[modName]][[symb]][["trials"]] <<- 1
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["seed"]]))
+ yuimaGUIsettings$estimation[[modName]][[symb]][["seed"]] <<- NA
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["joint"]]))
+ yuimaGUIsettings$estimation[[modName]][[symb]][["joint"]] <<- FALSE
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["aggregation"]]))
+ yuimaGUIsettings$estimation[[modName]][[symb]][["aggregation"]] <<- TRUE
+ if (is.null(yuimaGUIsettings$estimation[[modName]][[symb]][["threshold"]]))
+ yuimaGUIsettings$estimation[[modName]][[symb]][["threshold"]] <<- NA
+ }
+ }
+ }
+ parametric_modal_prev_buttonDelta <<- input$advancedSettingsButtonApplyDelta
+ parametric_modal_prev_buttonAllDelta <<- input$advancedSettingsButtonApplyAllDelta
+})
+
+observe({
+ shinyjs::toggle(id="parametric_modal_body", condition = nrow(parametric_seriesToChangePoint$table)!=0)
+ shinyjs::toggle(id="parametric_modal_errorMessage", condition = nrow(parametric_seriesToChangePoint$table)==0)
+})
+output$parametric_modal_series <- renderUI({
+ if (nrow(parametric_seriesToChangePoint$table)!=0)
+ selectInput(inputId = "parametric_modal_series", label = "Series", choices = rownames(parametric_seriesToChangePoint$table))
+})
+output$parametric_modal_delta <- renderUI({
+ if (!is.null(input$parametric_modal_series))
+ return (numericInput("parametric_modal_delta", label = paste("delta", input$parametric_modal_series), value = yuimaGUIsettings$delta[[input$parametric_modal_series]]))
+})
+output$parametric_modal_toLog <- renderUI({
+ if (!is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series)){
+ choices <- FALSE
+ if (all(getData(input$parametric_modal_series)>0)) choices <- c(FALSE, TRUE)
+ return (selectInput("parametric_modal_toLog", label = "Convert to log", choices = choices, selected = yuimaGUIsettings$toLog[[input$parametric_modal_series]]))
+ }
+})
+output$parametric_modal_model <- renderUI({
+ if(!is.null(input$parametric_changepoint_model))
+ selectInput(inputId = "parametric_modal_model", label = "Model", choices = input$parametric_changepoint_model)
+})
+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
+ selectInput(inputId = "parametric_modal_parameter", label = "Parameter", choices = par)
+ }
+})
+output$parametric_modal_start <- renderUI({
+ if (!is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series) & !is.null(input$parametric_modal_parameter))
+ numericInput(inputId = "parametric_modal_start", label = "start", value = yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["start"]][[input$parametric_modal_parameter]])
+})
+output$parametric_modal_startMin <- renderUI({
+ input$parametric_modal_button_applyDelta
+ input$parametric_modal_button_applyAllDelta
+ if (!is.null(input$parametric_modal_start) & !is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series) & !is.null(input$parametric_modal_parameter))
+ if (is.na(input$parametric_modal_start))
+ numericInput(inputId = "parametric_modal_startMin", label = "start: Min", value = yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["startMin"]][[input$parametric_modal_parameter]])
+})
+output$parametric_modal_startMax <- renderUI({
+ input$parametric_modal_button_applyDelta
+ input$parametric_modal_button_applyAllDelta
+ if (!is.null(input$parametric_modal_start) & !is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series) & !is.null(input$parametric_modal_parameter))
+ if (is.na(input$parametric_modal_start))
+ numericInput(inputId = "parametric_modal_startMax", label = "start: Max", value = yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["startMax"]][[input$parametric_modal_parameter]])
+})
+output$parametric_modal_lower <- renderUI({
+ if (!is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series) & !is.null(input$parametric_modal_parameter))
+ if (input$parametric_modal_method=="L-BFGS-B" | input$parametric_modal_method=="Brent")
+ numericInput("parametric_modal_lower", label = "lower", value = yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["lower"]][[input$parametric_modal_parameter]])
+})
+output$parametric_modal_upper <- renderUI({
+ if (!is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series) & !is.null(input$parametric_modal_parameter))
+ if (input$parametric_modal_method=="L-BFGS-B" | input$parametric_modal_method=="Brent")
+ numericInput("parametric_modal_upper", label = "upper", value = yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["upper"]][[input$parametric_modal_parameter]])
+})
+output$parametric_modal_method <- renderUI({
+ if (!is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series))
+ selectInput("parametric_modal_method", label = "method", choices = c("L-BFGS-B", "Nelder-Mead", "BFGS", "CG", "SANN", "Brent"), selected = yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["method"]])
+})
+output$parametric_modal_trials <- renderUI({
+ if (!is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series) & !is.null(input$parametric_modal_method))
+ numericInput("parametric_modal_trials", label = "trials", min = 1, value = ifelse(input$parametric_modal_method=="SANN" & yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["method"]]!="SANN",1,yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["trials"]]))
+})
+output$parametric_modal_seed <- renderUI({
+ if (!is.null(input$parametric_modal_model) & !is.null(input$parametric_modal_series))
+ numericInput("parametric_modal_seed", label = "seed", min = 1, value = yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["seed"]])
+})
+
+
+
+observeEvent(input$parametric_modal_button_applyDelta, {
+ yuimaGUIsettings$delta[[input$parametric_modal_series]] <<- input$parametric_modal_delta
+ yuimaGUIsettings$toLog[[input$parametric_modal_series]] <<- input$parametric_modal_toLog
+})
+observeEvent(input$parametric_modal_button_applyAllDelta, {
+ for (symb in rownames(parametric_seriesToChangePoint$table)){
+ yuimaGUIsettings$delta[[symb]] <<- input$parametric_modal_delta
+ if (input$parametric_modal_toLog==FALSE) yuimaGUIsettings$toLog[[symb]] <<- input$parametric_modal_toLog
+ else if (all(getData(symb)>0)) yuimaGUIsettings$toLog[[symb]] <<- input$parametric_modal_toLog
+ }
+})
+observeEvent(input$parametric_modal_button_applyModel,{
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["start"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_start
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["startMin"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_startMin
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["startMax"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_startMax
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["lower"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_lower
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["upper"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_upper
+})
+observeEvent(input$parametric_modal_button_applyAllModel,{
+ for (symb in rownames(parametric_seriesToChangePoint$table)){
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[symb]][["start"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_start
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[symb]][["startMin"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_startMin
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[symb]][["startMax"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_startMax
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[symb]][["lower"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_lower
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[symb]][["upper"]][[input$parametric_modal_parameter]] <<- input$parametric_modal_upper
+ }
+})
+observeEvent(input$parametric_modal_button_applyGeneral,{
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["method"]] <<- input$parametric_modal_method
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["trials"]] <<- input$parametric_modal_trials
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[input$parametric_modal_series]][["seed"]] <<- input$parametric_modal_seed
+})
+observeEvent(input$parametric_modal_button_applyAllModelGeneral,{
+ for (symb in rownames(parametric_seriesToChangePoint$table)){
+ yuimaGUIsettings$estimation[[input$parametric_modal_model]][[symb]][["method"]] <<- input$parametric_modal_method
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 611
More information about the Yuima-commits
mailing list