[Yuima-commits] r513 - pkg/yuimaGUI/inst/yuimaGUI
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Nov 10 21:28:09 CET 2016
Author: phoenix844
Date: 2016-11-10 21:28:09 +0100 (Thu, 10 Nov 2016)
New Revision: 513
Modified:
pkg/yuimaGUI/inst/yuimaGUI/global.R
pkg/yuimaGUI/inst/yuimaGUI/server.R
pkg/yuimaGUI/inst/yuimaGUI/ui.R
Log:
fixed some graphical bugs
Modified: pkg/yuimaGUI/inst/yuimaGUI/global.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-08 20:58:14 UTC (rev 512)
+++ pkg/yuimaGUI/inst/yuimaGUI/global.R 2016-11-10 20:28:09 UTC (rev 513)
@@ -893,8 +893,8 @@
addCPoint <- function(modelName, symb, trials, frac = 0.2, delta = 0.01, session, anchorId, alertId = NULL){
series <- getData(symb)
mod <- setModelByName(name = modelName)
- bounds <- defaultBounds(name = modelName)
- startBounds <- defaultBounds(name = modelName, lower = -100, upper = 100)
+ bounds <- defaultBounds(name = modelName, delta = delta)
+ startBounds <- defaultBounds(name = modelName, delta = delta, lower = -100, upper = 100)
yuima <- setYuima(data = setDataGUI(series, delta = delta), model = mod)
start <- list()
startMin <- startBounds$lower
@@ -1184,44 +1184,42 @@
-MYdist <- function(object){
+MYdist <- function(object, percentage = TRUE){
l <- length(colnames(object))
d <- matrix(ncol = l, nrow = l)
f <- function(x, dens){
res <- c()
- for(xi in x){
- if(xi %in% dens$x)
- res <- c(res,dens$y[which(dens$x==xi)])
- else{
- if (xi > max(dens$x) | xi < min(dens$x))
- res <- c(res,0)
- else{
+ getY <- function(xi){
+ i <- which(dens$x==xi)
+ if (length(i)!=0) return(dens$y[i])
+ else {
i_x1 <- which.min(abs(dens$x-xi))
i_x2 <- min(i_x1+1,length(dens$x))
- res <- c(res, 0.5*(dens$y[i_x1]+dens$y[i_x2]))
+ return(0.5*(dens$y[i_x1]+dens$y[i_x2]))
}
- }
}
+ res <- sapply(X = x, FUN = getY)
return(res)
}
withProgress(message = 'Clustering: ', value = 0, {
k <- 1
for(i in 1:l){
- delta_i <- as.numeric(abs(mean(diff(index(object)[!is.na(object[,i])]))))
- data_i <- as.vector(Delt(na.omit(object[,i])))
+ delta_i <- as.numeric(abs(mean(diff(index(object)[!is.na(object[,i])]), na.rm = TRUE)))
+ if (percentage == TRUE) data_i <- as.vector(na.omit(Delt(object[,i])))
+ else data_i <- as.vector(na.omit(diff(object[,i])))
data_i <- data_i[data_i!="Inf"]
dens1 <- density(data_i/sqrt(delta_i)+mean(data_i, na.rm = TRUE)*(1/delta_i-1/sqrt(delta_i)), na.rm = TRUE)
for(j in i:l)
if (i!=j){
incProgress(2/(l*(l-1)), detail = paste(k,"(/", l*(l-1)/2 ,")"))
- delta_j <- as.numeric(abs(mean(diff(index(object)[!is.na(object[,j])]))))
- data_j <- as.vector(Delt(na.omit(object[,j])))
+ delta_j <- as.numeric(abs(mean(diff(index(object)[!is.na(object[,j])]), na.rm = TRUE)))
+ if (percentage == TRUE) data_j <- as.vector(na.omit(Delt(object[,j])))
+ else data_j <- as.vector(na.omit(diff(object[,j])))
data_j <- data_j[data_j!="Inf"]
dens2 <- density(data_j/sqrt(delta_j)+mean(data_j, na.rm = TRUE)*(1/delta_j-1/sqrt(delta_j)), na.rm = TRUE)
- f_dist <- function(x) {abs(f(x,dens1)-f(x,dens2))}
- npoints <- 1000
- dist <- (max(tail(dens1$x,1), tail(dens2$x,1))-min(dens1$x[1],dens2$x[1]))/npoints*0.5*sum(f_dist(seq(from=min(dens1$x[1], dens2$x[1]), to=max(tail(dens1$x,1), tail(dens2$x,1)), length.out = npoints)))
- d[j,i] <- ifelse(dist > 1, 1, dist)
+ f_dist <- function(x) {0.5*abs(f(x,dens1)-f(x,dens2))}
+ dist <- try(integrate(f_dist, lower = min(dens1$x[1],dens2$x[1]), upper = max(last(dens1$x), last(dens2$x)), subdivisions = 100000, rel.tol = 0.01))
+ d[j,i] <- min(1, ifelse(class(dist)=="try-error", 1, dist$value))
k <- k + 1
}
}
Modified: pkg/yuimaGUI/inst/yuimaGUI/server.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-08 20:58:14 UTC (rev 512)
+++ pkg/yuimaGUI/inst/yuimaGUI/server.R 2016-11-10 20:28:09 UTC (rev 513)
@@ -6,12 +6,20 @@
###Save all available data
saveData <- function() {
dataDownload_series <- reactive({
- data <- data.frame()
- for (symb in names(yuimaGUIdata$series))
- data <- as.data.frame(rbind.fill(as.data.frame(data),as.data.frame(t(getData(symb)))))
- data <- as.data.frame(t(data))
- colnames(data) <- names(yuimaGUIdata$series)
- return(data)
+ for (symb in names(yuimaGUIdata$series)){
+ data <- getData(symb)
+ if(class(index(data)[1])=="numeric") {
+ if (!exists("data_num", inherits = FALSE)) data_num <- data
+ else data_num <- merge(data_num, data)
+ }
+ else {
+ if (!exists("data_date", inherits = FALSE)) data_date <- data
+ else data_date <- merge(data_date, data)
+ }
+ }
+ if (exists("data_date") & !exists("data_num")) return(as.data.frame(data_date[order(index(data_date)), ]))
+ if (!exists("data_date") & exists("data_num")) return(as.data.frame(data_num[order(index(data_num)), ]))
+ if (exists("data_date") & exists("data_num")) return(rbind.fill(as.data.frame(data_num[order(index(data_num)), ]), as.data.frame(data_date[order(index(data_date)), ])))
})
downloadHandler(
filename = "yuimaGUIdata.txt",
@@ -1819,7 +1827,8 @@
d <- switch(
input$cluster_distance,
"MOdist" = try(MOdist(na.omit(x))),
- "MYdist" = try(MYdist(x)),
+ "MYdist_perc" = try(MYdist(x, percentage = TRUE)),
+ "MYdist_ass" = try(MYdist(x, percentage = FALSE)),
"euclidean" = try(dist(t(as.data.frame(x)), method = "euclidean")),
"maximum" = try(dist(t(as.data.frame(x)), method = "maximum")),
"manhattan" = try(dist(t(as.data.frame(x)), method = "manhattan")),
Modified: pkg/yuimaGUI/inst/yuimaGUI/ui.R
===================================================================
--- pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-08 20:58:14 UTC (rev 512)
+++ pkg/yuimaGUI/inst/yuimaGUI/ui.R 2016-11-10 20:28:09 UTC (rev 513)
@@ -553,7 +553,7 @@
column(4,br(),br(),
div(align="center",
selectInput("cluster_linkage", "Linkage", choices = c("Complete"="complete", "Single"="single", "Average"="average", "Ward"="ward.D", "Ward squared"="ward.D2", "McQuitty"="mcquitty", "Median"="median", "Centroid"="centroid")),
- selectInput("cluster_distance", "Distance", choices = c("Markov Operator"="MOdist", "Distribution of Returns"="MYdist", "Euclidean"="euclidean", "Maximum"="maximum", "Manhattan"="manhattan", "Canberra"="canberra", "Minkowski"="minkowski")),
+ selectInput("cluster_distance", "Distance", choices = c("Markov Operator"="MOdist", "Percentage Increments Distribution"="MYdist_perc", "Increments Distribution"="MYdist_ass", "Euclidean"="euclidean", "Maximum"="maximum", "Manhattan"="manhattan", "Canberra"="canberra", "Minkowski"="minkowski")),
shinyjs::hidden(numericInput("cluster_distance_minkowskiPower", label = "Power", value = 2, width = "30%")))
)
)),
More information about the Yuima-commits
mailing list