[Yuima-commits] r516 - pkg/yuimaGUI/inst/yuimaGUI
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 12 22:10:06 CET 2016
Author: phoenix844
Date: 2016-11-12 22:10:05 +0100 (Sat, 12 Nov 2016)
New Revision: 516
Modified:
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
Log:
added video in home page
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-11 16:03:12 UTC (rev 515)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-12 21:10:05 UTC (rev 516)
@@ -546,6 +546,7 @@
changeBase <- function(table, yuimaGUI, newBase = input$baseModels, session = session, choicesUI="baseModels", anchorId = "modelsAlert", alertId = "modelsAlert_conversion"){
closeAlert(session, alertId)
+<<<<<<< .mine
shinyjs::toggle(id = choicesUI, condition = (class(index(yuimaGUI$model at data@original.data))=="Date"))
outputTable <- data.frame()
for (param in unique(colnames(table))){
@@ -567,8 +568,43 @@
else if(test$stationary==FALSE | test$positivity==FALSE) createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("The estimated model does not satisfy theoretical properties.", temp$msg), style = "warning")
else createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste(msg, temp$msg), style = style)
}
+ # else if (yuimaGUI$info$class=="CARMA") {
+ # test <- try(Diagnostic.Carma(yuimaGUI$qmle))
+ # if (class(test)=="try-error") createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("The estimated model does not satisfy theoretical properties.", temp$msg), style = "warning")
+ # else if(test==FALSE) createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("The estimated model does not satisfy theoretical properties.", temp$msg), style = "warning")
+ # else createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste(msg, temp$msg), style = style)
+ # }
else if (!is.null(temp$msg) | !is.null(msg)) createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste(msg, temp$msg), style = style)
return(outputTable)
+||||||| .r483
+ createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("No parameters conversion available for this model. Parameters have been obtained using delta = ", delta), style = "warning")
+ shinyjs::hide(choicesUI)
+ return(list("Estimate"= param, "Std. Error"=StdErr))
+=======
+ shinyjs::toggle(id = choicesUI, condition = (class(index(yuimaGUI$model at data@original.data))=="Date"))
+ outputTable <- data.frame()
+ for (param in unique(colnames(table))){
+ temp <- changeBaseP(param = as.numeric(table["Estimate",param]), StdErr = as.numeric(table["Std. Error",param]), delta = yuimaGUI$model at sampling@delta, original.data = yuimaGUI$model at data@original.data, paramName = param, modelName = yuimaGUI$info$modName, newBase = newBase, allParam = table["Estimate",])
+ outputTable["Estimate",param] <- as.character(signifDigits(temp[["Estimate"]],temp[["Std. Error"]]))
+ outputTable["Std. Error",param] <- as.character(signifDigits(temp[["Std. Error"]],temp[["Std. Error"]]))
+ }
+ colnames(outputTable) <- unique(colnames(table))
+ style <- "info"
+ msg <- NULL
+ if (any(outputTable["Std. Error",] %in% c(0, "NA", "NaN"))){
+ msg <- "The estimated model does not satisfy theoretical properties."
+ style <- "warning"
+ }
+ if (!is.null(temp$conversion)) if (temp$conversion==FALSE) shinyjs::hide(choicesUI)
+ if (yuimaGUI$info$class=="COGARCH") {
+ test <- try(Diagnostic.Cogarch(yuimaGUI$model, param = as.list(coef(yuimaGUI$qmle))))
+ if (class(test)=="try-error") createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("The estimated model does not satisfy theoretical properties.", temp$msg), style = "warning")
+ else if(test$stationary==FALSE | test$positivity==FALSE) createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste("The estimated model does not satisfy theoretical properties.", temp$msg), style = "warning")
+ else createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste(msg, temp$msg), style = style)
+ }
+ else if (!is.null(temp$msg) | !is.null(msg)) createAlert(session = session, anchorId = anchorId, alertId = alertId, content = paste(msg, temp$msg), style = style)
+ return(outputTable)
+>>>>>>> .r515
}
@@ -1043,11 +1079,21 @@
is.valid <- FALSE
break()
}
+<<<<<<< .mine
+ else if (any(is.na(as.numeric(simulation at data@zoo.data[[1]])) | !is.finite(as.numeric(simulation at data@zoo.data[[1]])) | (toLog==TRUE & !is.finite(exp(as.numeric(simulation at data@zoo.data[[1]])))))){
+ is.valid <- FALSE
+ break()
+ }
+ else {
+||||||| .r483
+ if(is.valid){
+=======
else if (any(is.na(as.numeric(simulation at data@zoo.data[[1]])))){
is.valid <- FALSE
break()
}
else {
+>>>>>>> .r515
if (saveTraj==TRUE)
trajectory <- merge(trajectory, simulation at data@zoo.data[[1]])
if (saveTraj==FALSE)
@@ -1240,29 +1286,32 @@
x_incr <- switch (method,
"KSdiff" = na.omit(diff(x)),
"KSperc" = na.omit(Delt(x)))
+ index_x_incr <- index(x_incr)
x_incr_num <- as.numeric(x_incr)
- tau <- c()
- p.value<-c()
- nTot <-length(x_incr_num)
- n0 <- 1
- repeat{
- ks<-c()
- for (i in seq(from = n0, to=(nTot-1), by = as.integer(1+(nTot-n0)/100))){
- ks[i]<- suppressWarnings(ks.test(x_incr_num[n0:i],x_incr_num[(i+1):nTot])$p.value)
+ tau <- NULL
+ p.value <- NULL
+ getCPoint <- function(n0, nTot){
+ if(abs(nTot-n0)<10) return()
+ grid <- seq(from = n0, to=(nTot-1), by = as.integer(1+(nTot-n0)/100))
+ ks<-matrix(nrow = length(grid), ncol = 2, dimnames = list(NULL, c("index", "pvalue")))
+ j <- 1
+ for (i in grid){
+ ks[j,"index"] <- i
+ ks[j, "pvalue"]<- suppressWarnings(ks.test(x_incr_num[n0:i],x_incr_num[(i+1):nTot])$p.value)
+ j <- j+1
}
- ifelse(
- min(ks, na.rm=TRUE) > pvalue,
- {
- break
- },
- {
- n0 <- which.min(ks)
- tau <- c(index(x_incr)[n0], tau)
- p.value <- c(ks[n0], p.value)
- }
- )
+ if(min(ks[,"pvalue"], na.rm=TRUE) > pvalue) return()
+ else {
+ new_n0 <- as.integer(ks[which.min(ks[,"pvalue"]), "index"])
+ env <- environment(getCPoint)
+ assign(x = "tau", value = append(x = get("tau", envir = env), values = index_x_incr[new_n0]), envir = env)
+ assign(x = "p.value", value = append(x = get("p.value", envir = env), values = as.numeric(ks[which(ks[,"index"]==new_n0), "pvalue"])), envir = env)
+ getCPoint(n0 = n0, nTot = new_n0)
+ getCPoint(n0 = new_n0+1, nTot = nTot)
+ }
}
- if (length(tau)==0){
+ getCPoint(n0 = 1, nTot = length(x_incr_num))
+ if (is.null(tau)){
tau <- NA
p.value <- NA
}
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-11 16:03:12 UTC (rev 515)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-12 21:10:05 UTC (rev 516)
@@ -33,6 +33,10 @@
switch(class, "Diffusion process" = NA, "Fractional process" = NA,"Compound Poisson" = jumps, "COGARCH"=NA, "CARMA" = NA)
}
+ ### Home
+ output$video_intro <- renderUI({
+ HTML('<iframe width="90%" height="250px" src="//www.youtube.com/embed/XX_bmCrI_gc" frameborder="0" allowfullscreen></iframe>')
+ })
########################Load Economic and Financial Data
@@ -1087,10 +1091,11 @@
output$simulate_model_usr_selectModel <- renderUI({
choices <- as.vector(defaultModels[names(defaultModels)==input$simulate_model_usr_selectClass])
+ sel <- choices[1]
for(i in names(usr_models$model))
if (usr_models$model[[i]]$class==input$simulate_model_usr_selectClass)
- choices <- c(choices, i)
- selectInput("simulate_model_usr_selectModel", label = "Model Name", choices = choices)
+ choices <- c(i, choices)
+ selectInput("simulate_model_usr_selectModel", label = "Model Name", choices = choices, selected = sel)
})
output$simulate_model_usr_selectJumps <- renderUI({
@@ -2008,7 +2013,7 @@
if ((input$changepoint_symb %in% rownames(yuimaGUItable$series))){
par(bg="black")
plot(window(getData(input$changepoint_symb), start = range_changePoint$x[1], end = range_changePoint$x[2]), main=input$changepoint_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=yuimaGUIdata$cp[[input$changepoint_symb]]$tau, col = "yellow")
+ abline(v=yuimaGUIdata$cp[[input$changepoint_symb]]$tau, col = "red")
grid(col="grey")
}
})
@@ -2026,7 +2031,7 @@
x <- x[x[,1]!="Inf"]
par(bg="black")
plot(window(x, start = range_changePoint$x[1], end = range_changePoint$x[2]), main=paste(input$changepoint_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=yuimaGUIdata$cp[[input$changepoint_symb]]$tau, col = "yellow")
+ abline(v=yuimaGUIdata$cp[[input$changepoint_symb]]$tau, col = "red")
grid(col="grey")
}
})
@@ -2048,7 +2053,8 @@
output$table_ChangePointInfo <- renderTable(digits = 2, {
- data.frame(Time = as.character(yuimaGUIdata$cp[[input$changepoint_symb]]$tau), "p.value (%)" = yuimaGUIdata$cp[[input$changepoint_symb]]$pvalue*100, check.names = FALSE)
+ table <- data.frame(Time = as.character(yuimaGUIdata$cp[[input$changepoint_symb]]$tau), "p.value (%)" = yuimaGUIdata$cp[[input$changepoint_symb]]$pvalue*100, check.names = FALSE, row.names = yuimaGUIdata$cp[[input$changepoint_symb]]$tau)
+ return(table[order(rownames(table), decreasing = TRUE),])
})
@@ -2155,7 +2161,7 @@
if ((input$parametric_changepoint_symb %in% rownames(yuimaGUItable$series))){
par(bg="black")
plot(window(getData(input$parametric_changepoint_symb), start = parametric_range_changePoint$x[1], end = parametric_range_changePoint$x[2]), main=input$parametric_changepoint_symb, xlab="Index", ylab=NA, log=switch(input$parametric_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=yuimaGUIdata$cpYuima[[input$parametric_changepoint_symb]]$tau, col = "yellow")
+ abline(v=yuimaGUIdata$cpYuima[[input$parametric_changepoint_symb]]$tau, col = "red")
grid(col="grey")
}
})
Modified: pkg/yuimaGUI/inst/yuimaGUI/ui.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-11 16:03:12 UTC (rev 515)
+++ pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-12 21:10:05 UTC (rev 516)
@@ -39,8 +39,11 @@
h1("Welcome on yuimaGUI", style="color:#edeeed", align = "center"),
h4("an amazingly powerful tool for your analysis", style="color:#edeeed; font-family: Times New Roman, Georgia, Serif;", align = "center"),
hr(class = "hrHeader"),
- br(),
h4("Get acquainted with yuimaGUI and learn how to best exploit it in a few simple steps:", style="color:#edeeed", align = "center"),
+ br()
+ )),
+ fluidRow(
+ column(8,
h4("Step 1", style="color:#edeeed"),
h4("Load data you wish to analyze (section 'Data I/O').", br(),
"An easy way to load economic data (i.e. GDP) or financial series (stocks and shares) directly from the Internet is provided. Otherwise you can load data from your own files.",br(),
@@ -51,6 +54,10 @@
"Now you are ready to use the estimated models for simulation purposes in section 'Simulate'.", style="color:#CDCECD; font-family: Times New Roman, Georgia, Serif;"),
h4("Step 3", style="color:#edeeed"),
h4("Read the short explanation at the beginning of every (sub)section.", style="color:#CDCECD; font-family: Times New Roman, Georgia, Serif;")
+ ),
+ column(4,
+ br(), br(),
+ uiOutput("video_intro", align = "center")
)
),
fluidRow(
@@ -612,7 +619,7 @@
),
column(4,br(),br(),br(),br(),
div(align="center", selectInput("changepoint_method", "Method", choices = c("Percentage Increments Distribution"="KSperc", "Increments Distribution"="KSdiff"))),
- div(align="center", shinyjs::hidden(sliderInput("changepoint_pvalue", label = "p-value (%)", value=1, min=0, max=10, step = 0.1)))
+ div(align="center", shinyjs::hidden(sliderInput("changepoint_pvalue", label = "p-value (%)", value=1, min=0, max=5, step = 0.01)))
)
)),
br(),
More information about the Yuima-commits
mailing list