R/evaluation.R

In joshmarsh/TSTestDataUtil: TimeSeries Test Data Creation Utility

#'Query Lots of Patterns
#'
#'@param patterns the patterns list
#'@param method must be "dtw" or "tb
#'@export
QueryLotsOfPatterns <- function(patterns, method){

  if(method=="dtw"){
    # Querying synth patterns with dtw
    results<-list()
    results$headshoulders <- list()
    results$doubletop <- list()
    results$tripletop <- list()
    results$spiketop <- list()
    for( i in 1:27){
      results$headshoulders[[i]] <- list()
      results$doubletop[[i]] <- list()
      results$tripletop[[i]] <- list()
      results$spiketop[[i]] <- list()
    }
    results$time <- system.time(
      for(i in 1:27){
        print(paste("Currently at index", i, "out of 27."))
        for(j in 1:200){
          results$headshoulders[[i]][[j]] <- dtw(
            head.shoulders,
            patterns$headshoulders[[i]][[j]],
            step.pattern = symmetric2
          )$normalizedDistance

          results$doubletop[[i]][[j]] <- dtw(
            double.top,
            patterns$doubletop[[i]][[j]],
            step.pattern = symmetric2
          )$normalizedDistance

          results$tripletop[[i]][[j]] <- dtw(
            triple.top,
            patterns$tripletop[[i]][[j]],
            step.pattern = symmetric2
          )$normalizedDistance

          results$spiketop[[i]][[j]] <- dtw(
            spike.top,
            patterns$spiketop[[i]][[j]],
            step.pattern = symmetric2
          )$normalizedDistance
        }
      }
    )
  }

  if(method=="tb"){
    #Query synth patterns with TB
    print("Querying with TB")
    results <- list()
    results$headshoulders <- list()
    results$doubletop <- list()
    results$tripletop <- list()
    results$spiketop <- list()
    for( i in 1:27){
      results$headshoulders[[i]] <- list()
      results$doubletop[[i]] <- list()
      results$tripletop[[i]] <- list()
      results$spiketop[[i]] <- list()
    }
    results$time <- system.time(
      for(i in 1:27){
        print(paste("Currently at index", i, "out of 27."))
        for(j in 1:200){

          results$headshoulders[[i]][[j]] <- Query(
            patterns$headshoulders[[i]][[j]],
            head.shoulders,
            spearmans.rho.threshold = -1
          )[[1]]
          results$doubletop[[i]][[j]] <- Query(
            patterns$doubletop[[i]][[j]],
            double.top,
            spearmans.rho.threshold = -1
          )[[1]]
          results$tripletop[[i]][[j]] <- Query(
            patterns$tripletop[[i]][[j]],
            triple.top,
            spearmans.rho.threshold = -1
          )[[1]]
          results$spiketop[[i]][[j]] <- Query(
            patterns$spiketop[[i]][[j]],
            spike.top,
            spearmans.rho.threshold = -1
          )[[1]]
        }
      }
    )
  }

    return(results)
}








#'Seperate Results Into Vectors
#'
#'
#'@export
SeperateResultsIntoVectors <- function(results.tb, results.dtw){
  print("Seperating into vectors")
  metric<-list()
  for( i in 1:27 ){
    for(j in 1:200){
      if(i%%3==1){
        metric$headshoulders$dtw$low <- c(metric$headshoulders$dtw$low, results.dtw$headshoulders[[i]][[j]])
        metric$doubletop$dtw$low <- c(metric$doubletop$dtw$low, results.dtw$doubletop[[i]][[j]])
        metric$tripletop$dtw$low <- c(metric$tripletop$dtw$low, results.dtw$tripletop[[i]][[j]])
        metric$spiketop$dtw$low <- c(metric$spiketop$dtw$low, results.dtw$spiketop[[i]][[j]])

        metric$headshoulders$tb$low <- c(metric$headshoulders$tb$low, results.tb$headshoulders[[i]][[j]])
        metric$doubletop$tb$low <- c(metric$doubletop$tb$low, results.tb$doubletop[[i]][[j]])
        metric$tripletop$tb$low <- c(metric$tripletop$tb$low, results.tb$tripletop[[i]][[j]])
        metric$spiketop$tb$low <- c(metric$spiketop$tb$low, results.tb$spiketop[[i]][[j]])
      }
      if(i%%3==2){
        metric$headshoulders$dtw$medium <- c(metric$headshoulders$dtw$medium, results.dtw$headshoulders[[i]][[j]])
        metric$doubletop$dtw$medium <- c(metric$doubletop$dtw$medium, results.dtw$doubletop[[i]][[j]])
        metric$tripletop$dtw$medium <- c(metric$tripletop$dtw$medium, results.dtw$tripletop[[i]][[j]])
        metric$spiketop$dtw$medium <- c(metric$spiketop$dtw$medium, results.dtw$spiketop[[i]][[j]])

        metric$headshoulders$tb$medium <- c(metric$headshoulders$tb$medium, results.tb$headshoulders[[i]][[j]])
        metric$doubletop$tb$medium <- c(metric$doubletop$tb$medium, results.tb$doubletop[[i]][[j]])
        metric$tripletop$tb$medium <- c(metric$tripletop$tb$medium, results.tb$tripletop[[i]][[j]])
        metric$spiketop$tb$medium <- c(metric$spiketop$tb$medium, results.tb$spiketop[[i]][[j]])
      }
      if(i%%3==0){
        metric$headshoulders$dtw$high <- c(metric$headshoulders$dtw$high, results.dtw$headshoulders[[i]][[j]])
        metric$doubletop$dtw$high <- c(metric$doubletop$dtw$high, results.dtw$doubletop[[i]][[j]])
        metric$tripletop$dtw$high <- c(metric$tripletop$dtw$high, results.dtw$tripletop[[i]][[j]])
        metric$spiketop$dtw$high <- c(metric$spiketop$dtw$high, results.dtw$spiketop[[i]][[j]])

        metric$headshoulders$tb$high <- c(metric$headshoulders$tb$high, results.tb$headshoulders[[i]][[j]])
        metric$doubletop$tb$high <- c(metric$doubletop$tb$high, results.tb$doubletop[[i]][[j]])
        metric$tripletop$tb$high <- c(metric$tripletop$tb$high, results.tb$tripletop[[i]][[j]])
        metric$spiketop$tb$high <- c(metric$spiketop$tb$high, results.tb$spiketop[[i]][[j]])
      }
    }
  }
  return(metric)
}




#'Plot Metric Densities
#'@export
PlotMetricDensities <- function(metric, titlePref){

#dtw
plot( density(metric[[1]][[1]][[1]]), main=paste(titlePref, "DTW, All Patterns, Low Noise" ))
lines( density(metric[[2]][[1]][[1]]) )
lines( density(metric[[3]][[1]][[1]]) )
lines( density(metric[[4]][[1]][[1]]) )

plot( density(metric[[1]][[1]][[2]]), main=paste(titlePref,"DTW, All Patterns, Medium Noise"  ))
lines( density(metric[[2]][[1]][[2]]) )
lines( density(metric[[3]][[1]][[2]]) )
lines( density(metric[[4]][[1]][[2]]) )

plot( density(metric[[1]][[1]][[3]]), main=paste(titlePref, "DTW, All Patterns, High Noise"  ))
lines( density(metric[[2]][[1]][[3]]) )
lines( density(metric[[3]][[1]][[3]]) )
lines( density(metric[[4]][[1]][[3]]) )

#tb
plot( density(metric[[1]][[2]][[1]]), main=paste(titlePref,"TB, All Patterns, Low Noise"  ))
lines( density(metric[[2]][[2]][[1]]) )
lines( density(metric[[3]][[2]][[1]]) )
lines( density(metric[[4]][[2]][[1]]) )

plot( density(metric[[1]][[2]][[2]]), main=paste(titlePref,"TB, All Patterns, Medium Noise" ))
lines( density(metric[[2]][[2]][[2]]) )
lines( density(metric[[3]][[2]][[2]]) )
lines( density(metric[[4]][[2]][[2]]) )

plot( density(metric[[1]][[2]][[3]]), main=paste(titlePref,"TB, All Patterns, High Noise" ))
lines( density(metric[[2]][[2]][[3]]) )
lines( density(metric[[3]][[2]][[3]]) )
lines( density(metric[[4]][[2]][[3]]) )
}

#'Generate Plots for Dissertation
#'
#'@export
GenerateDissertationPlots <- function(metric, metric.baseline, pattern){
  pat <- ""
  if(pattern=="headshoulders"){
    i=1
    pat <- "Head and Shoulders"
    }
  if(pattern=="doubletop"){
    i=2
    pat <- "Double Top"
    }
  if(pattern=="tripletop"){
    i=3
    pat <- "Triple Top"
    }
  if(pattern=="spiketop"){
    i=4
    pat <- "Spike Top"
    }

  #Spearman's Rho
  #Low
  plot(density(metric.baseline[[i]][[2]][[1]]), xlim=c(-1, 2), ylim=c(0, 11), col="black",
       main = paste(pat, "\nSpearman's Rho PDF Low Noise"),
       lty=2, xlab = "Spearman's Correlation")
  lines(density(metric[[i]][[2]][[1]]))
  legend(y=6, x=0.766*3-1,
         legend = c("Pattern", "Control"), col = c("black", "black"),
         lty=1:2, cex=0.8,
         bty = "n"
         )
  #Medium
  plot(density(metric.baseline[[i]][[2]][[2]]), xlim=c(-1, 2), ylim=c(0, 11), col="black",
       main = paste(pat, "\nSpearman's Rho PDF Medium Noise"),
       lty=2, xlab = "Spearman's Correlation")
  lines(density(metric[[i]][[2]][[2]]))
  legend(y=6, x=0.766*3-1,
         legend = c("Pattern", "Control"), col = c("black", "black"),
         lty=1:2, cex=0.8,
         bty = "n"
         )
  #High
    plot(density(metric.baseline[[i]][[2]][[3]]), xlim=c(-1, 2), ylim=c(0, 11), col="black",
         main = paste(pat, "\nSpearman's Rho PDF High Noise"),
       lty=2, xlab = "Spearman's Correlation")
  lines(density(metric[[i]][[2]][[3]]))
  legend(y=6, x=0.766*3-1,
         legend = c("Pattern", "Control"), col = c("black", "black"),
         lty=1:2, cex=0.8,
         bty = "n"
         )

  #DTW
  #Low
    plot(density(metric.baseline[[i]][[1]][[1]]), xlim=c(0, 3), ylim=c(0, 11), col="black",
         main = paste(pat, "\nDTW Distance PDF Low Noise"),
       lty=2, xlab = "DTW Distance")
  lines(density(metric[[i]][[1]][[1]]))
  legend(y=6, x=0.766*3,
         legend = c("Pattern", "Control"), col = c("black", "black"),
         lty=1:2, cex=0.8,
         bty = "n"
         )
  #Medium
      plot(density(metric.baseline[[i]][[1]][[2]]), xlim=c(0, 3), ylim=c(0, 11), col="black",
           main = paste(pat, "\nDTW Distance PDF Medium Noise"),
       lty=2, xlab = "DTW Distance")
  lines(density(metric[[i]][[1]][[2]]))
  legend(y=6, x=0.766*3,
         legend = c("Pattern", "Control"), col = c("black", "black"),
         lty=1:2, cex=0.8,
         bty = "n"
         )
  #High
      plot(density(metric.baseline[[1]][[1]][[3]]), xlim=c(0, 3), ylim=c(0, 11), col="black",
           main = paste(pat, "\nDTW Distance PDF High Noise"),
       lty=2, xlab = "DTW Distance")
  lines(density(metric[[i]][[1]][[3]]))
  legend(y=6, x=0.766*3,
         legend = c("Pattern", "Control"), col = c("black", "black"),
         lty=1:2, cex=0.8,
         bty = "n"
         )

}