[Yuima-commits] r525 - in pkg/yuimaGUI: . inst/yuimaGUI inst/yuimaGUI/www
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Nov 22 02:06:01 CET 2016
Author: phoenix844
Date: 2016-11-22 02:06:01 +0100 (Tue, 22 Nov 2016)
New Revision: 525
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 correlation estimation (cce) + introducing ggplot2 to draw charts
Modified: pkg/yuimaGUI/DESCRIPTION
===================================================================
--- pkg/yuimaGUI/DESCRIPTION 2016-11-20 19:47:32 UTC (rev 524)
+++ pkg/yuimaGUI/DESCRIPTION 2016-11-22 01:06:01 UTC (rev 525)
@@ -1,10 +1,10 @@
Package: yuimaGUI
Type: Package
Title: A Graphical User Interface for the Yuima Package
-Version: 0.8.0
+Version: 0.9.0
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, corrplot
+Imports: DT (>= 0.2), shinyjs, shiny, shinydashboard, shinyBS, yuima, quantmod, sde, ggplot2, reshape2
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-20 19:47:32 UTC (rev 524)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-22 01:06:01 UTC (rev 525)
@@ -6,7 +6,8 @@
require(quantmod)
require(shinydashboard)
require(shinyBS)
-require(corrplot)
+require(ggplot2)
+require(reshape2)
options(warn=-1)
@@ -14,7 +15,7 @@
yuimaGUItable <<- reactiveValues(series=data.frame(), model=data.frame(), simulation=data.frame(), hedging=data.frame())
if(!exists("yuimaGUIdata"))
- yuimaGUIdata <<- reactiveValues(series=list(), cp=list(), cpYuima=list(), model=list(), simulation=list(), hedging = list())
+ yuimaGUIdata <<- reactiveValues(series=list(), cp=list(), cpYuima=list(), model=list(), simulation=list(), hedging = list(), llag = list(), cluster = list())
if(!exists("estimateSettings"))
estimateSettings <<- list()
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-20 19:47:32 UTC (rev 524)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-22 01:06:01 UTC (rev 525)
@@ -1845,72 +1845,130 @@
"canberra" = try(dist(t(as.data.frame(x)), method = "canberra")),
"minkowski" = try(dist(t(as.data.frame(x)), method = "minkowski", p = input$cluster_distance_minkowskiPower))
)
- shinyjs::toggle("cluster_charts", condition = (class(d)!="try-error"))
if (class(d)=="try-error")
createAlert(session, anchorId = "cluster_alert", alertId = "cluster_alert_dist", content = "Error in clustering", style = "error")
else{
hc <- hclust(d, method = input$cluster_linkage)
- labelColors <- c("#CDB380", "#FF0000", "#036564", "#FF00FF", "#EB6841", "#7FFFD4", "#EDC951","#FF8000", "#FFE4E1", "#A2CD5A", "#71C671", "#AAAAAA", "#555555", "#FFA07A", "#8B6508", "#FFC125", "#FFFACD", "#808000", "#458B00", "#54FF9F", "#43CD80", "#008B8B", "#53868B", "#B0E2FF", "#0000FF", "#F8F8FF", "#551A8B", "#AB82FF", "#BF3EFF", "#FF83FA", "#8B1C62", "#CD6839", "#8E8E38", "#1E1E1E")
- dendrClick <- reactiveValues(y = NULL)
- output$cluster_dendogram <- renderPlot({
- if(!is.null(input$cluster_dendrogram_click$y))
- dendrClick$y <- input$cluster_dendrogram_click$y
- if(!is.null(dendrClick$y)){
- clusMember = cutree(hc, h = dendrClick$y)
- colLab <- function(n) {
- if (is.leaf(n)) {
- a <- attributes(n)
- labCol <- labelColors[clusMember[which(names(clusMember) == a$label)]]
- attr(n, "nodePar") <- c(a$nodePar, lab.col = labCol)
- }
- n
+ i <- 1
+ id <- "Clustering"
+ repeat {
+ if(id %in% names(yuimaGUIdata$cluster)){
+ id <- paste("Clustering", i)
+ i <- i+1
+ } else break
+ }
+ yuimaGUIdata$cluster[[id]] <<- list(d = d, linkage = input$cluster_linkage, distance = input$cluster_distance, power = input$cluster_distance_minkowskiPower)
+ }
+ })}
+ })
+
+ output$cluster_analysis_id <- renderUI({
+ n <- names(yuimaGUIdata$cluster)
+ if(length(n)!=0)
+ selectInput("cluster_analysis_id", label = "Clustering ID", choices = sort(n), selected = last(n))
+ })
+
+ observeEvent(input$cluster_analysis_id, {
+ if(!is.null(input$cluster_analysis_id)) if (input$cluster_analysis_id %in% names(yuimaGUIdata$cluster)){
+ d <- yuimaGUIdata$cluster[[input$cluster_analysis_id]]$d
+ hc <- hclust(d, method = yuimaGUIdata$cluster[[input$cluster_analysis_id]]$linkage)
+ labelColors <- c("#CDB380", "#FF0000", "#036564", "#FF00FF", "#EB6841", "#7FFFD4", "#EDC951","#FF8000", "#FFE4E1", "#A2CD5A", "#71C671", "#AAAAAA", "#555555", "#FFA07A", "#8B6508", "#FFC125", "#FFFACD", "#808000", "#458B00", "#54FF9F", "#43CD80", "#008B8B", "#53868B", "#B0E2FF", "#0000FF", "#F8F8FF", "#551A8B", "#AB82FF", "#BF3EFF", "#FF83FA", "#8B1C62", "#CD6839", "#8E8E38", "#1E1E1E")
+ dendrClick <- reactiveValues(y = NULL)
+ output$cluster_dendogram <- renderPlot({
+ if(!is.null(input$cluster_dendrogram_click$y))
+ dendrClick$y <- input$cluster_dendrogram_click$y
+ if(!is.null(dendrClick$y)){
+ clusMember = cutree(hc, h = dendrClick$y)
+ colLab <- function(n) {
+ if (is.leaf(n)) {
+ a <- attributes(n)
+ labCol <- labelColors[clusMember[which(names(clusMember) == a$label)]]
+ attr(n, "nodePar") <- c(a$nodePar, lab.col = labCol)
}
- hc <- dendrapply(as.dendrogram(hc), colLab)
+ n
}
- if(is.null(dendrClick$y)){
- colDefault <- function(n){
- if (is.leaf(n))
- attr(n, "nodePar") <- c(attributes(n)$nodePar, lab.col = labelColors[1])
- return(n)
- }
- hc <- dendrapply(as.dendrogram(hc), colDefault)
+ hc <- dendrapply(as.dendrogram(hc), colLab)
+ }
+ if(is.null(dendrClick$y)){
+ colDefault <- function(n){
+ if (is.leaf(n))
+ attr(n, "nodePar") <- c(attributes(n)$nodePar, lab.col = labelColors[1])
+ return(n)
}
- output$cluster_button_saveDendogram <- downloadHandler(
- filename = "Dendrogram.png",
- content = function(file) {
- png(file, width = 960)
- par(bg="black", xaxt = "n", mar= c(10, 4, 4, 2)+0.1)
- plot(hc, ylab = "", xlab = "", main = "Dendrogram", edgePar=list(col="grey50"), col.main = "#FFF68F", col.axis="grey")
- dev.off()
- }
- )
- par(bg="black", xaxt = "n", mar= c(10, 4, 4, 2)+0.1)
- plot(hc, ylab = "", xlab = "", main = "Dendrogram", edgePar=list(col="grey50"), col.main = "#FFF68F", col.axis="grey")
- })
- output$cluster_scaling2D <- renderPlot({
- points <- cmdscale(d)
- if(!is.null(dendrClick$y))
- g1 <- cutree(hclust(d), h = dendrClick$y)
- else
- g1 <- 1
- output$cluster_button_saveScaling2D <- downloadHandler(
- filename = "Multidimensional scaling.png",
- content = function(file) {
- png(file)
- par(bg="black", xaxt = "n", yaxt = "n", bty="n")
- plot(points, col=labelColors[g1], pch=16, cex=2, main = "Multidimensional scaling", col.main = "#FFF68F", xlab="", ylab="")
- dev.off()
- }
- )
- par(bg="black", xaxt = "n", yaxt = "n", bty="n")
- plot(points, col=labelColors[g1], pch=16, cex=2, main = "Multidimensional scaling", col.main = "#FFF68F", xlab="", ylab="")
- })
- }
- })}
+ hc <- dendrapply(as.dendrogram(hc), colDefault)
+ }
+ output$cluster_button_saveDendogram <- downloadHandler(
+ filename = "Dendrogram.png",
+ content = function(file) {
+ png(file, width = 960)
+ par(bg="black", xaxt = "n", mar= c(10, 4, 4, 2)+0.1)
+ plot(hc, ylab = "", xlab = "", main = "Dendrogram", edgePar=list(col="grey50"), col.main = "#FFF68F", col.axis="grey")
+ dev.off()
+ }
+ )
+ par(bg="black", xaxt = "n", mar= c(10, 4, 4, 2)+0.1)
+ plot(hc, ylab = "", xlab = "", main = "Dendrogram", edgePar=list(col="grey50"), col.main = "#FFF68F", col.axis="grey")
+ })
+ output$cluster_scaling2D <- renderPlot({
+ points <- cmdscale(d)
+ if(!is.null(dendrClick$y))
+ g1 <- cutree(hclust(d), h = dendrClick$y)
+ else
+ g1 <- 1
+ output$cluster_button_saveScaling2D <- downloadHandler(
+ filename = "Multidimensional scaling.png",
+ content = function(file) {
+ png(file)
+ par(bg="black", xaxt = "n", yaxt = "n", bty="n")
+ plot(points, col=labelColors[g1], pch=16, cex=2, main = "Multidimensional scaling", col.main = "#FFF68F", xlab="", ylab="")
+ dev.off()
+ }
+ )
+ par(bg="black", xaxt = "n", yaxt = "n", bty="n")
+ plot(points, col=labelColors[g1], pch=16, cex=2, main = "Multidimensional scaling", col.main = "#FFF68F", xlab="", ylab="")
+ })
+ }
})
+ output$cluster_moreInfo <- renderUI({
+ if(!is.null(input$cluster_analysis_id)) if (input$cluster_analysis_id %in% names(isolate({yuimaGUIdata$cluster}))){
+ info <- isolate({yuimaGUIdata$cluster[[input$cluster_analysis_id]]})
+ dist <- switch(info$distance,
+ "MOdist"="Markov Operator",
+ "MYdist_perc"="Percentage Increments Distribution",
+ "MYdist_ass"="Increments Distribution",
+ "euclidean"="Euclidean",
+ "maximum"="Maximum",
+ "manhattan"="Manhattan",
+ "canberra"="Canberra",
+ "minkowski"="Minkowski")
+ linkage <- switch(info$linkage,
+ "complete"="Complete",
+ "single"="Single",
+ "average"="Average",
+ "ward.D"="Ward",
+ "ward.D2"="Ward squared",
+ "mcquitty"="McQuitty",
+ "Median"="median",
+ "centroid"="Centroid")
+ if (dist=="Minkowski") dist <- paste(dist, " (", info$power,")", sep = "")
+ return(HTML(paste("<div style='color:#CDCECD;'><h4>    Linkage:",linkage, "         Distance:", dist, "</h4></div>")))
+ }
+ })
+ observeEvent(input$cluster_button_delete_analysis, {
+ yuimaGUIdata$cluster[[input$cluster_analysis_id]] <<- NULL
+ })
+ observeEvent(input$cluster_button_deleteAll_analysis, {
+ yuimaGUIdata$cluster <<- list()
+ })
+
+ observe({
+ shinyjs::toggle("cluster_charts", condition = length(names(yuimaGUIdata$cluster))!=0)
+ })
+
+
########################Nonparametric Change Point
########################
########################
@@ -1977,7 +2035,9 @@
})
output$changepoint_symb <- renderUI({
- selectInput("changepoint_symb", "Symbol", choices = sort(names(yuimaGUIdata$cp)))
+ n <- names(yuimaGUIdata$cp)
+ if(length(n)!=0)
+ selectInput("changepoint_symb", "Symbol", choices = sort(n), selected = last(n))
})
observeEvent(input$changepoint_button_startEstimation, {
@@ -2350,6 +2410,12 @@
estimateSettings[[input$parametric_modal_model]][[symb]][["seed"]] <<- input$parametric_modal_seed
}
})
+
+ output$parametric_changepoint_symb <- renderUI({
+ n <- names(yuimaGUIdata$cpYuima)
+ if(length(n)!=0)
+ selectInput("parametric_changepoint_symb", "Symbol", choices = sort(n), selected = last(n))
+ })
### Start Estimation
observeEvent(input$parametric_changepoint_button_startEstimation, {
@@ -2382,10 +2448,6 @@
createAlert(session = session, anchorId = "parametric_changepoint_alert", alertId = "parametric_changepoint_alert_err", style = "error", dismiss = TRUE, content = paste("Unable to estimate Change Point of:", paste(errors, collapse = " ")))
})
})
-
- output$parametric_changepoint_symb <- renderUI({
- selectInput("parametric_changepoint_symb", "Symbol", choices = sort(names(yuimaGUIdata$cpYuima)))
- })
parametric_range_changePoint <- reactiveValues(x=NULL, y=NULL)
observe({
@@ -2578,6 +2640,12 @@
}
})
+ observe({
+ shinyjs::toggle("llag_maxLag", condition = input$llag_type=="llag")
+ shinyjs::toggle("llag_corr_method", condition = input$llag_type=="corr")
+ })
+
+
observeEvent(input$llag_button_startEstimation, {
closeAlert(session, alertId = "llag_alert_select")
if (is.na(input$llag_maxLag) | input$llag_maxLag <= 0)
@@ -2593,52 +2661,148 @@
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])
- else data <- window(data, start = input$llag_range_numeric1, end = input$llag_range_numeric2)
- delta <- 0.01
+ if(type=="Date") {
+ start <- input$llag_range_date[1]
+ end <- input$llag_range_date[2]
+ } else {
+ start <- input$llag_range_numeric1
+ end <- input$llag_range_numeric2
+ }
+ data <- window(data, start = start, end = end)
if(is.regular(data)){
+ mode <- function(x) {
+ ux <- unique(x)
+ ux[which.max(tabulate(match(x, ux)))]
+ }
+ delta <- mode(na.omit(diff(index(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
- mode <- function(x) {
- ux <- unique(x)
- ux[which.max(tabulate(match(x, ux)))]
+ if(input$llag_type=="llag"){
+ res <- try(llag(yuimaData, ci=TRUE, plot=FALSE, grid = seq(from = -input$llag_maxLag, to = input$llag_maxLag, 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 {
+ i <- 1
+ id <- "Lead-Lag Analysis"
+ repeat {
+ if(id %in% names(yuimaGUIdata$llag)){
+ id <- paste("Lead-Lag Analysis", i)
+ i <- i+1
+ } else break
+ }
+ yuimaGUIdata$llag[[id]] <<- list(type = "llag", maxLag = input$llag_maxLag, delta = delta, llag = res$lagcce, p.values = res$p.values, start = start, end = end)
}
- 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")
- })
+ }
+ if(input$llag_type=="corr"){
+ res <- try(cce(x = yuimaData, method = input$llag_corr_method))
+ if (class(res)=="try-error")
+ createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", content = "Error in computing the correlation matrix", style = "error")
+ else {
+ i <- 1
+ id <- "Correlation Analysis"
+ repeat {
+ if(id %in% names(yuimaGUIdata$llag)){
+ id <- paste("Correlation Analysis", i)
+ i <- i+1
+ } else break
+ }
+ yuimaGUIdata$llag[[id]] <<- list(type = "corr", covmat = res$covmat, cormat = res$cormat, method = input$llag_corr_method, start = start, end = end)
}
- 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 analyze non-regular grid of observations", style = "error")
}
- else{
- createAlert(session, anchorId = "llag_alert", alertId = "llag_alert_select", content = "Cannot compute Lead-Lag for non-regular grid of observations", style = "error")
- }
})
}
}
})
+ observe({
+ shinyjs::toggle("llag_plot_body", condition = length(names(yuimaGUIdata$llag))!=0)
+ })
+ output$llag_analysis_id <- renderUI({
+ n <- names(yuimaGUIdata$llag)
+ if(length(n)!=0)
+ selectInput("llag_analysis_id", label = "Analysis ID", choices = sort(n), selected = last(n))
+ })
+ output$llag_plot_corr_method <- renderUI({
+ if(!is.null(input$llag_analysis_id)) if (input$llag_analysis_id %in% names(isolate({yuimaGUIdata$llag}))){
+ info <- isolate({yuimaGUIdata$llag})[[input$llag_analysis_id]]
+ if (info$type=="corr"){
+ method <- switch(info$method,
+ "HY"="Hayashi-Yoshida",
+ "PHY"="Pre-averaged Hayashi-Yoshida",
+ "MRC"="Modulated Realized Covariance",
+ "TSCV"="Two Scales realized CoVariance",
+ "GME"="Generalized Multiscale Estimator",
+ "RK"="Realized Kernel",
+ "QMLE"="Quasi Maximum Likelihood Estimator",
+ "SIML"="Separating Information Maximum Likelihood",
+ "THY"="Truncated Hayashi-Yoshida",
+ "PTHY"="Pre-averaged Truncated Hayashi-Yoshida",
+ "SRC"="Subsampled Realized Covariance",
+ "SBPC"="Subsampled realized BiPower Covariation")
+ return(HTML(paste("<div style='color:#CDCECD;'><h4>    Method:", method, "</h4></div>")))
+ }
+ }
+ })
+ observe({
+ if(!is.null(input$llag_analysis_id)) if (input$llag_analysis_id %in% isolate({names(yuimaGUIdata$llag)})) {
+ type <- isolate({yuimaGUIdata$llag})[[input$llag_analysis_id]]$type
+ shinyjs::toggle("llag_plot_confidence", condition = type=="llag")
+ shinyjs::toggle("llag_plot_corr_method", condition = type=="corr")
+ shinyjs::toggle("llag_plot_howToRead", condition = type=="llag")
+ }
+ })
+
+ output$llag_plot <- renderPlot({
+ if(!is.null(input$llag_analysis_id) & !is.null(input$llag_plot_confidence)) if (input$llag_analysis_id %in% isolate({names(yuimaGUIdata$llag)})) {
+ info <- isolate({yuimaGUIdata$llag[[input$llag_analysis_id]]})
+ if(info$type=="llag"){
+ co <- ifelse(info$p.values > input$llag_plot_confidence | is.na(info$p.values), 0, info$llag)
+ co<-melt(t(co))
+ digits <- 1+as.integer(abs(log10(info$delta)))
+ }
+ if(info$type=="corr"){
+ co <- info$cormat
+ co<-melt(t(co))
+ digits <- 2
+ }
+ ggplot(co, aes(Var1, Var2)) + # x and y axes => Var1 and Var2
+ geom_tile(aes(fill = value)) + # background colours are mapped according to the value column
+ geom_text(aes(label = round(co$value, digits))) + # write the values
+ scale_fill_gradient2(low = "#ff9f80",
+ mid = "gray30",
+ high = "lightblue",
+ midpoint = 0) + # determine the colour
+ theme(panel.grid.major.x=element_blank(), #no gridlines
+ panel.grid.minor.x=element_blank(),
+ panel.grid.major.y=element_blank(),
+ panel.grid.minor.y=element_blank(),
+ panel.background=element_rect(fill="#282828"), # background=white
+ plot.background = element_rect(fill = "#282828", linetype = 0, color = "#282828"),
+ axis.text.x = element_text(angle=90,hjust = 1, size = 12,face = "bold", colour = "#CDCECD"),
+ plot.title = element_text(size=20,face="bold", colour = "#CDCECD", hjust = 0.5),
+ axis.text.y = element_text(size = 12,face = "bold", colour = "#CDCECD")) +
+ ggtitle(paste("Analyzed data from", info$start, "to", info$end)) +
+ theme(legend.title=element_text(face="bold", size=14)) +
+ scale_x_discrete(name="") +
+ scale_y_discrete(name="") +
+ labs(fill="")
+ }
+ })
+ observeEvent(input$llag_delete_analysis, {
+ yuimaGUIdata$llag[[input$llag_analysis_id]] <<- NULL
+ })
+ observeEvent(input$llag_deleteAll_analysis, {
+ yuimaGUIdata$llag <<- list()
+ })
+
########################Hedging
########################
########################
Modified: pkg/yuimaGUI/inst/yuimaGUI/ui.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-20 19:47:32 UTC (rev 524)
+++ pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-22 01:06:01 UTC (rev 525)
@@ -12,7 +12,7 @@
menuItem("Explorative Data Analysis", tabName = "eda_section", icon = icon("map"),
menuSubItem("Change Point Estimation", tabName = "changepoint"),
menuSubItem("Clustering", tabName = "cluster"),
- menuSubItem("Lead-Lag Analysis", tabName = "llag")
+ menuSubItem("Lead-Lag & Correlation", tabName = "llag")
),
menuItem("Modeling", tabName = "models_section", icon = icon("sliders"),
menuSubItem("Univariate", tabName = "models")
@@ -596,21 +596,27 @@
bsTooltip("cluster_button_deleteAll", title = "Delete all data that are displayed", placement = "top"),
column(4,actionButton("cluster_button_startCluster", label = "Start Clustering", align = "center"))
)),
- shinyjs::hidden(div(id="cluster_charts",
+ div(id="cluster_charts", align = "center",
br(),br(),
hr(class = "hrHeader"),
- br(),
+ fluidRow(
+ column(4),
+ column(4, uiOutput("cluster_analysis_id"))
+ ),
+ fluidRow(column(11, div(align="left", uiOutput("cluster_moreInfo")))),
fluidRow(column(12,
column(8, plotOutput("cluster_dendogram", click = "cluster_dendrogram_click")),
column(4, plotOutput("cluster_scaling2D"))
)),
br(),
fluidRow(column(12,
- column(3, div(align="left", downloadButton("cluster_button_saveDendogram", label = "Save dendrogram"))),
- column(7),
- column(2, div(align="right", downloadButton("cluster_button_saveScaling2D", label = "Save chart")))
+ column(2, div(actionButton("cluster_button_delete_analysis", label = "Delete"))),
+ column(2, div(actionButton("cluster_button_deleteAll_analysis", label = "Delete All"))),
+ column(4),
+ column(2, div(downloadButton("cluster_button_saveDendogram", label = "Dendrogram"))),
+ column(2, div(downloadButton("cluster_button_saveScaling2D", label = "Scaling")))
))
- ))
+ )
),
####################################################
tabItem(tabName = "changepoint",
@@ -818,19 +824,16 @@
h4("Selected data", style="color:#CDCECD"),
DT::dataTableOutput("llag_table_selected")
),
- column(4,br(),br(),br(),
+ column(4,br(),br(),
div(align="center",
+ selectInput("llag_type", label = "Type of analysis", choices = c("Lead-Lag"="llag", "Correlation"="corr"), selected = "llag"),
numericInput("llag_maxLag", label = "Max Lag", value = 20, min = 1, step = 1),
+ shinyjs::hidden(selectInput("llag_corr_method", label = "Method", choices = c("Hayashi-Yoshida"="HY", "Pre-averaged Hayashi-Yoshida"="PHY", "Modulated Realized Covariance"="MRC", "Two Scales realized CoVariance"="TSCV", "Generalized Multiscale Estimator"="GME", "Realized Kernel"="RK", "Quasi Maximum Likelihood Estimator"="QMLE", "Separating Information Maximum Likelihood"="SIML", "Truncated Hayashi-Yoshida"="THY", "Pre-averaged Truncated Hayashi-Yoshida"="PTHY", "Subsampled Realized Covariance"="SRC", "Subsampled realized BiPower Covariation"="SBPC"))),
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(),
- fluidRow(
- column(3),
- column(6, shinyjs::hidden(actionButton("llag_button_showResults",label = "Show Results", align = "center")))
- )
+ column(6,numericInput("llag_range_numeric1", label = "From", value = 0)),
+ column(6,numericInput("llag_range_numeric2", label = "To", value = 1))
+ ))
)
)
)),
@@ -846,21 +849,33 @@
bsTooltip("llag_button_deleteAll", title = "Delete all data that are displayed", placement = "top"),
column(4,actionButton("llag_button_startEstimation", label = "Start Analysis", align = "center"))
)),
- br(),br(),
- 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.")
- )
- )
+ br(),
+ fluidRow(column(12,
+ shinyjs::hidden(div(id = "llag_plot_body", align = "center",
+ hr(class = "hrHeader"),
+ fluidRow(
+ column(4),
+ column(4,uiOutput("llag_analysis_id"))
+ ),
+ fluidRow(
+ column(12,
+ div(align="center", numericInput("llag_plot_confidence", label = "Confidence Level",width = "20%", value = 0.001, min = 0, max = 1, step = 0.0001)),
+ div(align="center", uiOutput("llag_plot_corr_method"))
+ ),
+ 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.")
+ ),
+ fluidRow(
+ column(1),
+ column(10,plotOutput("llag_plot", height = "600px"))
+ ),
+ fluidRow(
+ column(1),
+ column(2,actionButton("llag_delete_analysis", label = "Delete")),
+ column(6),
+ column(2,actionButton("llag_deleteAll_analysis", label = "Delete All"))
+ ),
+ HTML("<div id = 'llag_plot_howToRead' style='color:#CDCECD;'><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.</div>")
+ )))
)
),
########################hedging
Modified: pkg/yuimaGUI/inst/yuimaGUI/www/custom.css
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/www/custom.css 2016-11-20 19:47:32 UTC (rev 524)
+++ pkg/yuimaGUI/inst/yuimaGUI/www/custom.css 2016-11-22 01:06:01 UTC (rev 525)
@@ -69,7 +69,7 @@
background: linear-gradient(#606D60, #202220, #606D60);
}
-#finDataDelete, #finDataDeleteAll, #yourFileDelete, #yourFileDeleteAll, #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, #changepoint_button_delete_estimated, #changepoint_button_deleteAll_estimated, #parametric_changepoint_button_delete_estimated, #parametric_changepoint_button_deleteAll_estimated {
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/yuima -r 525
More information about the Yuima-commits
mailing list