[Yuima-commits] r523 - in pkg/yuimaGUI: . inst/yuimaGUI inst/yuimaGUI/www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Nov 18 17:52:20 CET 2016
Author: phoenix844
Date: 2016-11-18 17:52:20 +0100 (Fri, 18 Nov 2016)
New Revision: 523
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:
added llag section
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2016-11-15 22:29:45 UTC (rev 522)
+++ pkg/yuimaGUI/DESCRIPTION 2016-11-18 16:52:20 UTC (rev 523)
@@ -1,10 +1,10 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the Yuima Package
-Version: 0.7.10
+Version: 0.7.11
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
+Imports: DT (>= 0.2), shinyjs, shiny, shinydashboard, shinyBS, yuima, quantmod, sde, corrplot
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-15 22:29:45 UTC (rev 522)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-18 16:52:20 UTC (rev 523)
@@ -6,7 +6,7 @@
require(quantmod)
require(shinydashboard)
require(shinyBS)
-#require(corrplot)
+require(corrplot)
options(warn=-1)
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-15 22:29:45 UTC (rev 522)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-18 16:52:20 UTC (rev 523)
@@ -450,7 +450,8 @@
###DeleteAll Button
observeEvent(input$buttonDeleteAll_models_Univariate, priority = 1,{
- seriesToEstimate$table <<- seriesToEstimate$table[-input$database4_rows_all,]
+ if (!is.null(input$database4_rows_all))
+ seriesToEstimate$table <<- seriesToEstimate$table[-input$database4_rows_all,]
})
###Interactive range of selectRange chart
@@ -1819,7 +1820,8 @@
###DeleteAll Button
observeEvent(input$cluster_button_deleteAll, priority = 1,{
- seriesToCluster$table <<- seriesToCluster$table[-input$cluster_table_selected_rows_all,]
+ if (!is.null(input$cluster_table_selected_rows_all))
+ seriesToCluster$table <<- seriesToCluster$table[-input$cluster_table_selected_rows_all,]
})
observe({
@@ -1830,7 +1832,7 @@
closeAlert(session, "cluster_alert_dist")
if (length(rownames(seriesToCluster$table))<=2)
createAlert(session, anchorId = "cluster_alert", alertId = "cluster_alert_dist", content = "Select at least 3 series", style = "error")
- if (length(rownames(seriesToCluster$table))>2){
+ if (length(rownames(seriesToCluster$table))>2){ withProgress(value = 1, message = "Calculating...", {
names_list <- rownames(seriesToCluster$table)
x <- yuimaGUIdata$series[[names_list[1]]]
for(i in names_list[-1])
@@ -1908,7 +1910,7 @@
plot(points, col=labelColors[g1], pch=16, cex=2, main = "Multidimensional scaling", col.main = "#FFF68F", xlab="", ylab="")
})
}
- }
+ })}
})
@@ -1966,7 +1968,8 @@
###DeleteAll Button
observeEvent(input$changepoint_button_deleteAll, priority = 1,{
- seriesToChangePoint$table <<- seriesToChangePoint$table[-input$changepoint_table_selected_rows_all,]
+ if (!is.null(input$changepoint_table_selected_rows_all))
+ seriesToChangePoint$table <<- seriesToChangePoint$table[-input$changepoint_table_selected_rows_all,]
})
observe({
@@ -2120,7 +2123,8 @@
###DeleteAll Button
observeEvent(input$parametric_changepoint_button_deleteAll, priority = 1,{
- parametric_seriesToChangePoint$table <<- parametric_seriesToChangePoint$table[-input$parametric_changepoint_table_selected_rows_all,]
+ 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({
@@ -2210,12 +2214,36 @@
###Select Button
observeEvent(input$llag_button_select, priority = 1, {
- seriesToLeadLag$table <<- rbind(seriesToLeadLag$table, yuimaGUItable$series[(rownames(yuimaGUItable$series) %in% rownames(yuimaGUItable$series)[input$llag_table_select_rows_selected]) & !(rownames(yuimaGUItable$series) %in% rownames(seriesToLeadLag$table)),])
+ if (length(input$llag_table_select_rows_selected)!=0){
+ closeAlert(session, "llag_alert_select")
+ if (nrow(seriesToLeadLag$table)==0)
+ seriesToLeadLag$table <<- rbind(seriesToLeadLag$table, yuimaGUItable$series[rownames(yuimaGUItable$series)[input$llag_table_select_rows_selected[1]],])
+ for (symb in rownames(yuimaGUItable$series)[input$llag_table_select_rows_selected]){
+ if (class(index(yuimaGUIdata$series[[symb]]))==class(index(yuimaGUIdata$series[[rownames(seriesToLeadLag$table)[1]]]))){
+ if (!(symb %in% rownames(seriesToLeadLag$table)))
+ seriesToLeadLag$table <<- rbind(seriesToLeadLag$table, yuimaGUItable$series[symb,])
+ } else {
+ createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", append = FALSE, content = "Cannot analyze Lead-Lag for series with different type of index (numeric/date)", style = "warning")
+ }
+ }
+ }
})
###SelectAll Button
observeEvent(input$llag_button_selectAll, priority = 1, {
- seriesToLeadLag$table <<- rbind(seriesToLeadLag$table, yuimaGUItable$series[(rownames(yuimaGUItable$series) %in% rownames(yuimaGUItable$series)[input$llag_table_select_rows_all]) & !(rownames(yuimaGUItable$series) %in% rownames(seriesToLeadLag$table)),])
+ if (length(input$llag_table_select_rows_all)!=0){
+ closeAlert(session, "llag_alert_select")
+ if (nrow(seriesToLeadLag$table)==0)
+ seriesToLeadLag$table <<- rbind(seriesToLeadLag$table, yuimaGUItable$series[rownames(yuimaGUItable$series)[input$llag_table_select_rows_all[1]],])
+ for (symb in rownames(yuimaGUItable$series)[input$llag_table_select_rows_all]){
+ if (class(index(yuimaGUIdata$series[[symb]]))==class(index(yuimaGUIdata$series[[rownames(seriesToLeadLag$table)[1]]]))){
+ if (!(symb %in% rownames(seriesToLeadLag$table)))
+ seriesToLeadLag$table <<- rbind(seriesToLeadLag$table, yuimaGUItable$series[symb,])
+ } else {
+ createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", append = FALSE, content = "Cannot analyze Lead-Lag for series with different type of index (numeric/date)", style = "warning")
+ }
+ }
+ }
})
###Display Selected Data
@@ -2245,9 +2273,23 @@
###DeleteAll Button
observeEvent(input$llag_button_deleteAll, priority = 1,{
- seriesToLeadLag$table <<- seriesToLeadLag$table[-input$llag_table_selected_rows_all,]
+ if (!is.null(input$llag_table_selected_rows_all))
+ seriesToLeadLag$table <<- seriesToLeadLag$table[-input$llag_table_selected_rows_all,]
})
+ observe({
+ if (length(rownames(seriesToLeadLag$table))!=0){
+ type <- try(class(index(yuimaGUIdata$series[[rownames(seriesToLeadLag$table)[1]]])[1]))
+ if(type!="try-error"){
+ shinyjs::toggle(id = "llag_range_date", condition = type=="Date")
+ shinyjs::toggle(id = "llag_range_numeric", condition = type!="Date")
+ }
+ }
+ else {
+ shinyjs::hide(id = "llag_range_date")
+ shinyjs::hide(id = "llag_range_numeric")
+ }
+ })
observeEvent(input$llag_button_startEstimation, {
closeAlert(session, alertId = "llag_alert_select")
@@ -2258,21 +2300,55 @@
if (length(series)<=1)
createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", content = "Select at least two series", style = "warning")
else {
- data <- yuimaGUIdata$series[[series[1]]]
- for (i in 2:length(series))
- data <- merge(data, yuimaGUIdata$series[[series[i]]])
- colnames(data) <- series
- delta <- 0.01
- res <- try(llag(setDataGUI(data, delta = delta), ci=TRUE, plot=FALSE, grid = seq(from = -input$llag_maxLag*delta, to = input$llag_maxLag*delta, by = delta/2)))
- shinyjs::toggle("llag_results", condition = (class(res)!="try-error"))
- if (class(res)=="try-error")
- createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", content = "Error in computing lead-lag", style = "error")
- else {
- output$llag_corrplot <- renderPlot({
- cols <- colorRampPalette(c("#7F0000", "red", "#FF7F00", "yellow", "white", "cyan", "#007FFF", "blue", "#00007F"))
- corrplot(res$lagcce, p.mat = res$p.values, is.corr = FALSE, method = "ellipse", cl.pos = "b", tl.pos = "d", tl.srt = 60, col=cols(100), outline=TRUE, bg = "white", order = "alphabet", tl.col = "black")
- })
- }
+ withProgress(message = "Calculating...", value = 1, {
+ data <- yuimaGUIdata$series[[series[1]]]
+ type <- class(index(data)[1])
+ for (i in 2:length(series))
+ data <- merge(data, yuimaGUIdata$series[[series[i]]])
+ colnames(data) <- series
+ if(type=="Date") {
+ data <- window(data, start = input$llag_range_date[1], end = input$llag_range_date[2])
+ delta <- 0.01
+ }
+ else {
+ data <- window(data, start = input$llag_range_numeric1, end = input$llag_range_numeric2)
+ delta <- NULL
+ }
+ if(is.regular(data)){
+ yuimaData <- setDataGUI(data, delta = delta)
+ res <- try(llag(yuimaData, ci=TRUE, plot=FALSE, grid = seq(from = -input$llag_maxLag*delta, to = input$llag_maxLag*delta, by = delta)))
+ if (class(res)=="try-error")
+ createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", content = "Error in computing lead-lag", style = "error")
+ else {
+ LeadLag <- res$lagcce
+ if(type=="Date") {
+ mode <- function(x) {
+ ux <- unique(x)
+ ux[which.max(tabulate(match(x, ux)))]
+ }
+ LeadLag <- LeadLag/delta*mode(na.omit(diff(index(data))))
+ }
+ if(all(LeadLag==0)){
+ shinyjs::hide("llag_plot_body")
+ shinyjs::show("llag_plot_Text")
+ } else{
+ shinyjs::hide("llag_plot_Text")
+ shinyjs::show("llag_plot_body")
+ col1 <- colorRampPalette(c("#67001F", "#B2182B", "#D6604D", "#F4A582", "#FDDBC7","#FFFFFF", "#D1E5F0", "#92C5DE", "#4393C3", "#2166AC", "#053061"))
+ col2 <- colorRampPalette(c("#FFFFFF", "#D1E5F0", "#92C5DE", "#4393C3", "#2166AC", "#053061"))
+ col3 <- colorRampPalette(c("#67001F", "#B2182B", "#D6604D", "#F4A582", "#FDDBC7","#FFFFFF"))
+ output$llag_plot <- renderPlot({
+ corrplot(LeadLag, p.mat = res$p.values, sig.level = input$llag_plot_confidence, is.corr = FALSE, method = input$llag_plot_type, type = "lower", cl.pos = "b", tl.pos = "ld", tl.srt = 60, col=get(input$llag_plot_cols)(100), outline=TRUE, bg = "grey10", order = "alphabet", tl.col = "black")
+ })
+ }
+ shinyjs::show("llag_button_showResults")
+ toggleModal(session = session, modalId = "llag_modal_plot", toggle = "open")
+ }
+ }
+ else{
+ createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", content = "Cannot compute Lead-Lag for non-regular grid of observations", style = "error")
+ }
+ })
}
}
})
Modified: pkg/yuimaGUI/inst/yuimaGUI/ui.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-15 22:29:45 UTC (rev 522)
+++ pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-18 16:52:20 UTC (rev 523)
@@ -11,19 +11,19 @@
),
menuItem("Explorative Data Analysis", tabName = "eda_section", icon = icon("map"),
menuSubItem("Change Point Estimation", tabName = "changepoint"),
- menuSubItem("Clustering", tabName = "cluster")
- #REMOVE# menuSubItem("Lead-Lag Analysis", tabName = "llag")
+ menuSubItem("Clustering", tabName = "cluster"),
+ menuSubItem("Lead-Lag Analysis", tabName = "llag")
),
menuItem("Modeling", tabName = "models_section", icon = icon("sliders"),
menuSubItem("Univariate", tabName = "models")
),
- menuItem("Simulate", tabName = "simulate_section", icon = icon("area-chart"),
- menuSubItem("Simulate", tabName = "simulate")
- ),
- hr(),
- menuItem("Finance", tabName = "finance",
- menuSubItem("P&L distribution", tabName = "hedging")
- )
+ menuItem("Simulation", tabName = "simulate_section", icon = icon("area-chart"),
+ menuSubItem("Univariate", tabName = "simulate")
+ )#,
+ #hr(),
+ #menuItem("Finance", tabName = "finance",
+ # menuSubItem("P&L distribution", tabName = "hedging")
+ # )
)
)
@@ -700,6 +700,14 @@
)))
),
tabItem(tabName = "llag",
+ fluidRow(
+ column(12,
+ h3("Here you can analyze Lead-Lag effects",style="color:#edeeed"),
+ h4("insert some description, pointing out that it is only valid for some processes (i.e. not volumes)",
+ style="color:#CDCECD; font-family: Times New Roman, Georgia, Serif;"),
+ hr(class = "hrHeader")
+ )
+ ),
fluidRow(column(12,bsAlert("llag_alert"))),
fluidRow(column(12,
column(4,
@@ -710,8 +718,17 @@
h4("Selected data", style="color:#CDCECD"),
DT::dataTableOutput("llag_table_selected")
),
- column(4,br(),br(),br(),br(),
- div(align="center", numericInput("llag_maxLag", label = "Lag max", value = 20, min = 1, step = 1))
+ column(4,br(),br(),br(),
+ div(align="center",
+ numericInput("llag_maxLag", label = "Max Lag", value = 20, min = 1, step = 1),
+ shinyjs::hidden(dateRangeInput("llag_range_date", label = "Range", start = Sys.Date()-365, end = Sys.Date())),
+ shinyjs::hidden(div(id="llag_range_numeric",
+ column(6,numericInput("llag_range_numeric1", label = "From", value = 0)),
+ column(6,numericInput("llag_range_numeric2", label = "To", value = 1))
+ )),
+ br(),
+ shinyjs::hidden(actionButton("llag_button_showResults",label = "Show Results", align = "center"))
+ )
)
)),
br(),
@@ -727,10 +744,21 @@
column(4,actionButton("llag_button_startEstimation", label = "Start Analysis", align = "center"))
)),
br(),br(),
- fluidRow(column(12,div(id="llag_results",
- hr(class = "hrHeader"),
- plotOutput("llag_corrplot")
- )))
+ bsModal(id="llag_modal_plot", trigger = "llag_button_showResults", title = div(h4(em("Lead Lag Analysis")), align="center"), size = "large",
+ shinyjs::hidden(div(id="llag_plot_Text", align="center", HTML("<h3>No Lead-Lag effects found</h3>"))),
+ div(id = "llag_plot_body", align = "center",
+ box(width = 12,
+ fluidRow(
+ column(4,selectInput("llag_plot_type", choices = c("Color"="color", "Shade"="shade", "Circle"="circle", "Square"="square", "Ellipse"="ellipse", "Number"="number"), selected = "number", label = "Plot type")),
+ column(4,selectInput("llag_plot_cols", choices = c("Red & Blue"="col1", "Red" = "col3", "Blue" = "col2"), label = "Colors")),
+ column(4,numericInput("llag_plot_confidence", label = "Confidence Level", value = 0.001, min = 0, max = 1, step = 0.0001)),
+ bsTooltip(id = "llag_plot_confidence", title = "The evaluated p-values should carefully be interpreted because they are calculated based on pointwise confidence intervals rather than simultaneous confidence intervals (so there would be a multiple testing problem). Evaluation of p-values based on the latter will be implemented in the future extension of this function: Indeed, so far no theory has been developed for this. However, it is conjectured that the error distributions of the estimated cross-correlation functions are asymptotically independent if the grid is not dense too much, so p-values evaluated by this function will still be meaningful as long as sufficiently low significance levels are used.")
+ ),
+ plotOutput("llag_plot"), br(),
+ HTML("<b>How to read the plot:</b><br/>If the lead-lag is positive: 'row.name' anticipates 'col.name of 'X' periods<br/>If the lead-lag is negative: 'row.name' follows 'col.name' with 'X' delay periods<br/><br/><b>'X'</b> are the numbers in the plot above.<br/>They are expressed in days if you are using time series, or in the same unit of measure of time if you are using numerical time index.")
+ )
+ )
+ )
),
########################hedging
tabItem(tabName = "hedging",
Modified: pkg/yuimaGUI/inst/yuimaGUI/www/custom.css
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/www/custom.css 2016-11-15 22:29:45 UTC (rev 522)
+++ pkg/yuimaGUI/inst/yuimaGUI/www/custom.css 2016-11-18 16:52:20 UTC (rev 523)
@@ -12,7 +12,7 @@
background-color: #282828;
}
-
+
.thumbnail {
background-color:silver;
border-radius:50%;
@@ -69,7 +69,7 @@
background: linear-gradient(#606D60, #202220, #606D60);
}
-#finDataDelete, #finDataDeleteAll, #finDataSave, #yourFileDelete, #yourFileDeleteAll, #yourFileSave, #buttonSelect_models_Univariate, #buttonSelectAll_models_Univariate, #buttonDelete_models_Univariate, #buttonDeleteAll_models_Univariate, #databaseModelsDelete, #databaseModelsDeleteAll, #simulation_button_deleteModels, #simulation_button_deleteAllModels, #simulate_button_selectModels, #simulate_button_selectAllModels, #simulate_monitor_button_delete, #simulate_monitor_button_deleteAll, #simulate_monitor_button_showSimulation, #simulate_model_usr_button_select, #simulate_model_usr_button_selectAll, #simulate_model_usr_button_delete, #simulate_model_usr_button_deleteAll, #cluster_button_select, #cluster_button_selectAll, #cluster_button_delete, #cluster_button_deleteAll, #changepoint_button_select, #changepoint_button_selectAll, #changepoint_button_delete, #changepoint_button_deleteAll, #hedging_button_delete, #hedging_button_deleteAll, #parametric_changepoint_button_select, #parametric_changepoint_button_selectAll, #parametric_changepoint_button_delete, #parametric_changepoint_button_deleteAll {
+#finDataDelete, #finDataDeleteAll, #finDataSave, #yourFileDelete, #yourFileDeleteAll, #yourFileSave, #buttonSelect_models_Univariate, #buttonSelectAll_models_Univariate, #buttonDelete_models_Univariate, #buttonDeleteAll_models_Univariate, #databaseModelsDelete, #databaseModelsDeleteAll, #simulation_button_deleteModels, #simulation_button_deleteAllModels, #simulate_button_selectModels, #simulate_button_selectAllModels, #simulate_monitor_button_delete, #simulate_monitor_button_deleteAll, #simulate_model_usr_button_select, #simulate_model_usr_button_selectAll, #simulate_model_usr_button_delete, #simulate_model_usr_button_deleteAll, #cluster_button_select, #cluster_button_selectAll, #cluster_button_delete, #cluster_button_deleteAll, #changepoint_button_select, #changepoint_button_selectAll, #changepoint_button_delete, #changepoint_button_deleteAll, #hedging_button_delete, #hedging_button_deleteAll, #parametric_changepoint_button_select, #parametric_changepoint_button_selectAll, #parametric_changepoint_button_delete, #parametric_changepoint_button_deleteAll, #llag_button_select, #llag_button_selectAll, #llag_button_delete, #llag_button_deleteAll {
font-size: 110%;
width: 100%;
color: black;
@@ -109,7 +109,7 @@
background: radial-gradient(#202220, #963131, #202220);
}
-#EstimateModels, #simulate_simulateModels, #cluster_button_startCluster, #changepoint_button_startEstimation, #parametric_changepoint_button_startEstimation, #hedging_button_startComputation {
+#EstimateModels, #simulate_simulateModels, #cluster_button_startCluster, #changepoint_button_startEstimation, #parametric_changepoint_button_startEstimation, #hedging_button_startComputation, #llag_button_startEstimation {
width: 100%;
color: #ffffff;
text-shadow: 1px 1px 1px #000;
@@ -209,6 +209,25 @@
color: black;
}
+#llag_maxLag {
+ border-radius:10px;
+ width:50%;
+}
+
+#llag_button_showResults {
+ width: 40%;
+ height: 39px;
+ color: #ffffff;
+ background: radial-gradient(#001a1a, #00b3b3, #001a1a);
+}
+
+#simulate_monitor_button_showSimulation {
+ color: #ffffff;
+ background: radial-gradient(#001a1a, #00b3b3, #001a1a);
+ font-size: 110%;
+ width: 100%;
+}
+
#panel_simulations, #panel_estimates, #panel_hedging, #panel_cpoint{
font-size: 120%;
}
More information about the Yuima-commits
mailing list