Fixing BFIC INF values.

DESCRIPTION

@@ -20,7 +20,7 @@ Imports:
     graphics, 
     testthat,
     TDA
-RoxygenNote: 6.0.1
+RoxygenNote: 7.2.0
 Suggests: knitr,
     rmarkdown
 VignetteBuilder: knitr

NAMESPACE

@@ -1,16 +1,20 @@
 # Generated by roxygen2: do not edit by hand
 
 export(JLDetectChangePoint)
+export(SVDetectChangePoint)
 export(bootJLDetectChangePoint)
 export(computeProb)
 export(createTimeSeries)
 export(detectChangePoint)
 export(metricChangePoint)
 export(persistenceChangePoint)
 export(repJLDetectChangePoint)
+import(Rfast)
 import(TDA)
 import(ggplot2)
+import(ggpubr)
 import(grid)
+import(gridExtra)
 import(stats)
 import(testthat)
 import(utils)

R/JLDetectChangePoint.R

@@ -92,7 +92,7 @@ JLDetectChangePoint <- function(multiSeries, reducedDim = 5, useGaussian = FALSE
         print(cpbaywave::detectChangePoint(reducedData[,best_vector[1]], useBFIC = useBFIC, showplot = FALSE))
         gridExtra::grid.arrange(plt1, plt2, nrow = 1,ncol=2)
       }
-      else{
+      if (reducedDim < 2){
         best_dim <- Rfast::nth(vector, 1, descending = T,index.return=TRUE)
         best_vector <- c(best_vector,best_dim)
         print('Plot 1')

R/SVDetectChangePoint.R

@@ -0,0 +1,55 @@
+#' Singular Value of the Laplacian Change Point Detection
+#'
+#' Implements change point detection for time series of graphs by examining the singular values of the Laplacian
+#' @param multiSeries The high dimensional time series. Should be a matrix, with each row being an observation of the time series.
+#' @param useGaussian Set to TRUE if you want to use a random Gaussian projection. Default is random matrix of +- 1.
+#' @param setdetail Optional argument to set the detail level you wish to use. Default is all details.
+#' @param useBFIC Optional argument to use BFIC to decide change point location.
+#' @param showplot set to TRUE to see plot of 1-d time series and probability plot.
+#' @param useNorm use normalized Laplacian
+#' @import stats
+#' @import Rfast
+#' @import grid
+#' @import gridExtra
+#' @import igraph
+#' @export
+#'
+#'#NOTES:
+#'Take in list of time series graphs
+#'Calculate the singular values of the laplacian
+#'5-6 vertices (more than 50 use JL)
+#'expects list of dataframes with source, dest, and weight, where first thing in list is graph at time 1
+#'each row an observation (5 vertices is five columns)
+#'try ... in function declaration for showall
+#'change svd to eigen at some point (user parameter?)
+
+
+SVDetectChangePoint <- function(timeSeriesList, useNorm = TRUE, useBFIC = TRUE, showplot = TRUE, ...) {
+
+  df_list <- list()
+  for (series in 1:length(timeSeriesList)){
+    svds <- purrr::map_df(timeSeriesList[[series]], function(val) {
+      gg <- igraph::graph_from_data_frame(dplyr::select(timeSeriesList[[series]], source, receive), directed = T)
+      E(gg)$weight <- timeSeriesList[[series]]$val
+      h <- data.frame(t(svd(graph.laplacian(gg))$d)) #graph fourier transform
+
+    })
+    df_list[[length(df_list) + 1]] <- svds
+  }
+  bb <- data.table::rbindlist(df_list)
+  bb <- dplyr::bind_rows(df_list)
+
+  if (length(timeSeriesList) > 50){
+    cpbaywave::JLDetectChangePoint(as.matrix(bb),showplot=showplot, useBFIC = useBFIC, ... )
+  }
+  else{
+    cpbaywave::detectChangePoint(as.matrix(bb), useBFIC = useBFIC,showplot=showplot)
+  }
+
+}
+
+
+
+
+
+

R/changePointDetect.R

@@ -160,10 +160,10 @@ detectChangePoint <- function(a, setdetail, useBFIC = TRUE, showplot = FALSE, sh
     # If M1 > 3, good evidence of change point -
     M2 = max(probvec)
     m <- nrow(DWTmat)
-    t1 = gamma(m/2 + 0.5)
+    t1 = lgamma(m/2 + 0.5)
     A <- t(DWTmat) %*% DWTmat
     t2 = det(A)  #Numerically unstable.
-    M1 = log(t1) + (-m/2 + wid/2) * log(t2)
+    M1 = t1 + (-m/2 + wid/2) * log(t2)
 
 
     ifelse(useBFIC, value <- (M2 - M1 - 0.5 * wid * log(m)), value <- max(probvec))

R/plotChangePoint.R

@@ -39,6 +39,9 @@ plotChangePoint <- function(M1,M2,pad1,probvec,wid,m,n,data,indices,showall=FALS
     plot2 <- ggplot(probData, aes_string(x = 'x', y = 'probvec')) +
       geom_line()
 
+    plot2 <- plot2 + theme(axis.text.y=element_blank(),
+                  axis.ticks.y=element_blank())
+
     rbind(ggplotGrob(plot1), ggplotGrob(plot2), size = "last")
 
 
@@ -50,6 +53,8 @@ plotChangePoint <- function(M1,M2,pad1,probvec,wid,m,n,data,indices,showall=FALS
       geom_smooth(method = "loess",se = FALSE)
     plot2 <- ggplot(probData, aes_string(x = 'x', y = 'probvec')) +
       geom_line()
+    plot2 <- plot2 + theme(axis.text.y=element_blank(),
+                           axis.ticks.y=element_blank())
     rbind(ggplotGrob(plot1), ggplotGrob(plot2), size = "last")
 
 
@@ -68,6 +73,8 @@ plotChangePoint <- function(M1,M2,pad1,probvec,wid,m,n,data,indices,showall=FALS
         geom_line(data = plotData[(indices[1] + 1):(n-pad1 - 1),], mapping = aes_string(x = 'x', y = 'y'), stat = "smooth", method = "loess",span = 0.6, se = FALSE, alpha = 1, color = "blue")
       plot2 <- ggplot(probData, aes_string(x = 'x', y = 'probvec')) +
         geom_line()
+      plot2 <- plot2 + theme(axis.text.y=element_blank(),
+                             axis.ticks.y=element_blank())
       grid.newpage()
       grid.draw(rbind(ggplotGrob(plot1), ggplotGrob(plot2), size = "last"))
 
@@ -79,6 +86,8 @@ plotChangePoint <- function(M1,M2,pad1,probvec,wid,m,n,data,indices,showall=FALS
         geom_smooth(method = "loess",se = FALSE)
       plot2 <- ggplot(probData, aes_string(x = 'x', y = 'probvec')) +
         geom_line()
+      plot2 <- plot2 + theme(axis.text.y=element_blank(),
+                             axis.ticks.y=element_blank())
       grid.newpage()
       grid.draw(rbind(ggplotGrob(plot1), ggplotGrob(plot2), size = "last"))