Fix plot factor

DESCRIPTION

@@ -32,7 +32,6 @@ Imports:
     RColorBrewer,
     plyr,
     stats,
-    parallel,
     sp,
     lubridate,
     caret,

NAMESPACE

@@ -85,7 +85,6 @@ importFrom(lubridate,month)
 importFrom(lubridate,year)
 importFrom(mgcv,gam)
 importFrom(mgcv,predict.gam)
-importFrom(parallel,mclapply)
 importFrom(plyr,alply)
 importFrom(proxy,dist)
 importFrom(reshape2,melt)

R/class-twdtwTimeSeries.R

@@ -131,7 +131,7 @@ setMethod(f = "twdtwTimeSeries",
               } else {}
               if(check_class[2]){
                   list_obj = c(do.call("c", timeseries[which(timeseries_class=="list")]))
-                  if(is.null(names(list_obj))) names(list_obj) = paste0("ts",seq_along(list_obj))
+                  if(is.null(names(list_obj))) names(list_obj) = paste0("ts", seq_along(list_obj))
                   joint_timeseries = c(joint_timeseries, list_obj)
               } else {}
               if(check_class[3]){

R/methods.R

@@ -332,9 +332,12 @@ setMethod("[[", "twdtwRaster", function(x, i) {
 setMethod("[", "twdtwMatches", function(x, i, j, drop=TRUE) {
   if(length(x@alignments)<1) return(x@alignments)
   if(missing(i)) i = 1:length(x@alignments)
+  # if(missing(j)) j = 2:length(x@patterns)
   if(any(is.na(i))) stop("NA index not permitted")
+  if(class(i)=="character") i = match(i, names(x@timeseries@timeseries))
   res = x@alignments[i]
   if(missing(j)) j = 1:length(res[[1]])
+  if(class(j)=="character") j = match(j, names(x@patterns@timeseries))
   if(any(is.na(j))) stop("NA index not permitted")
   res = lapply(res, function(x) x[j])
   res = res[sapply(res, length)>0]
@@ -360,13 +363,13 @@ setMethod("[[", c("twdtwMatches", "numeric"), function(x, i, j,drop=TRUE) {
 #' @rdname twdtwTimeSeries-class
 #' @export
 setMethod("labels", signature = signature(object="twdtwTimeSeries"),
-          definition = function(object) object@labels)
+          definition = function(object) as.character(object@labels))
 
 #' @inheritParams twdtwTimeSeries-class
 #' @rdname twdtwTimeSeries-class
 #' @export
 setMethod("levels", "twdtwTimeSeries",
-          definition = function(x) levels(labels(x)))
+          definition = function(x) levels(factor(labels(x))))
 
 #' @inheritParams twdtwRaster-class
 #' @rdname twdtwRaster-class

R/plotTimeSeries.R

@@ -42,8 +42,8 @@ plotTimeSeries = function(x, labels=NULL, attr){
 
   if(is(x, "twdtwMatches")) x = subset(x@timeseries, labels)
   if(is(x, "twdtwTimeSeries")) x = subset(x, labels) 
-  if(is.null(labels)) labels = labels(x) 
-  new_labels = as.character(labels(x))
+  if(is.null(labels)) labels = labels(x)
+  new_labels = labels(x)
   labels_tabel = table(new_labels)
   if(any(labels_tabel>1))
     for(p in names(labels_tabel)){

R/twdtwApply.R

@@ -29,8 +29,7 @@
 #' @param y an object of class \link[dtwSat]{twdtwTimeSeries}. 
 #' The temporal patterns. 
 #' 
-#' @param ... arguments to pass to \code{\link[raster]{writeRaster}} and for parallel 
-#' processing to pass to \code{\link[parallel]{mclapply}}.
+#' @param ... arguments to pass to \code{\link[raster]{writeRaster}}
 #'
 #' @param resample resample the patterns to have the same length. Default is TRUE.
 #' See \link[dtwSat]{resampleTimeSeries} for details.
@@ -265,30 +264,26 @@ twdtwApply.twdtwRaster = function(x, y, weight.fun, dist.method, step.matrix, n,
       if(!mc.silent) print(paste0("Procesing chunk ",i,"/",threads[length(threads)]))
 
       # Get time series from raster 
-      #ts_list = lapply(as.list(x), FUN=getValuesBlock, row=blocks$row[i], nrows=blocks$nrows[i])
-      ts_list = mclapply(as.list(x), FUN=getValuesBlock, row=blocks$row[i], nrows=blocks$nrows[i], mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.silent = mc.silent, mc.cores = mc.cores, mc.cleanup = mc.cleanup)
+      ts_list = lapply(as.list(x), FUN=getValuesBlock, row=blocks$row[i], nrows=blocks$nrows[i])
 
       # Create a dummy array 
       nts = seq(1, nrow(ts_list[[1]]))
       m = length(levels)
       n = length(breaks)-1
 
       # Create zoo time series  
-      #ts_zoo = lapply(nts, FUN=.bulidZoo, x=ts_list, timeline=timeline)
-      ts_zoo = mclapply(nts, FUN=.bulidZoo, x=ts_list, timeline=timeline, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.silent = mc.silent, mc.cores = mc.cores, mc.cleanup = mc.cleanup)
+      ts_zoo = lapply(nts, FUN=.bulidZoo, x=ts_list, timeline=timeline)
 
       # Create twdtwTimeSeries object  
       ts = try(twdtwTimeSeries(ts_zoo), silent = TRUE)
       if(is(ts, "try-error"))
          return(lapply(levels, function(l) writeValues(b_files[[l]], matrix(9999, nrow=length(nts), ncol=n), blocks$row[i])))
 
       # Apply TWDTW analysis  
-      #twdtw_results = lapply(as.list(ts), FUN=get_aligs)
-      twdtw_results = mclapply(as.list(ts), FUN=get_aligs, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.silent = mc.silent, mc.cores = mc.cores, mc.cleanup = mc.cleanup)
+      twdtw_results = lapply(as.list(ts), FUN=get_aligs)
 
       # Get best mathces for each point, period, and pattern 
-      #A = lapply(twdtw_results, FUN=.lowestDistances, m=m, n=n, levels=levels, breaks=breaks, overlap=overlap, fill=9999)  
-      A = mclapply(twdtw_results, FUN=.lowestDistances, m=m, n=n, levels=levels, breaks=breaks, overlap=overlap, fill=9999, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.silent = mc.silent, mc.cores = mc.cores, mc.cleanup = mc.cleanup)
+      A = lapply(twdtw_results, FUN=.lowestDistances, m=m, n=n, levels=levels, breaks=breaks, overlap=overlap, fill=9999)
 
       # Reshape list to array 
       A = sapply(A, matrix, nrow=n, ncol=m, simplify = 'array')

R/twdtwClassify.R

@@ -79,7 +79,7 @@ setGeneric(name = "twdtwClassify",
 #' 
 #' \dontrun{
 #' require(parallel)
-#' best_mat = mclapply(as.list(mat), mc.cores=4, FUN=twdtwClassify, breaks=time_intervals, overlap=0.5)
+#' best_mat = mclapply(as.list(mat), mc.cores=2, FUN=twdtwClassify, breaks=time_intervals, overlap=0.5)
 #' best_mat = twdtwMatches(alignments=best_mat)
 #' }
 #' @export
@@ -110,8 +110,8 @@ setMethod("twdtwClassify", "twdtwMatches",
                       breaks = seq(from, to, paste(by,"month"))
                     }
                     breaks = as.Date(breaks)
-                  twdtwClassify.twdtwMatches(x, patterns.labels=patterns.labels, breaks=breaks, 
-                            overlap=overlap, thresholds=thresholds, fill=fill)
+                    twdtwClassify.twdtwMatches(x, patterns.labels=patterns.labels, breaks=breaks, 
+                              overlap=overlap, thresholds=thresholds, fill=fill)
            })
 
 #' @rdname twdtwClassify
@@ -181,7 +181,6 @@ twdtwClassify.twdtwMatches = function(x, patterns.labels, breaks, overlap, thres
     m = length(levels)
     n = length(breaks)-1
     aligs = lapply(as.list(x), FUN=.bestIntervals, m=m, n=n, levels=levels, breaks=breaks, overlap=overlap)
-    # res = lapply(as.list(x), FUN = classifyIntervals, patterns.labels, breaks, overlap, thresholds, fill)
     twdtwMatches(x@timeseries, patterns=x@patterns, alignments=aligs)
 }
 

R/zzz.R

@@ -29,7 +29,6 @@
 #' @importFrom scales pretty_breaks date_format percent
 #' @importFrom grDevices terrain.colors gray.colors
 #' @importFrom plyr alply
-#' @importFrom parallel mclapply
 #' @importFrom sp Polygon Polygons SpatialPoints SpatialPolygons SpatialPointsDataFrame over CRS spTransform coordinates bbox 
 #' @importFrom mgcv gam predict.gam 
 #' @importFrom RColorBrewer brewer.pal 

README.Rmd

@@ -13,7 +13,7 @@ knitr::opts_chunk$set(
   warning = FALSE,
   message = FALSE,
   error = FALSE, 
-  cache = TRUE,
+  cache = FALSE,
   results = "hide"
 )
 ```

README.md

@@ -31,7 +31,7 @@ plot(ts, type="timeseries")
 
 <img src="figure/plot-MOD13Q1.ts-ts-1.png" alt="Fig. 1. MOD13Q1.ts time series."  />
 <p class="caption">
-Fig. 1. example\_ts time series.
+Fig. 1. MOD13Q1.ts time series.
 </p>
 
 We know that in the region where the time series was observed we have *soybean*, *cotton*, and *maize*, whose typical temporal pattern are: