Include twdtwAssess and twdtwAssessment-class

NAMESPACE

@@ -60,7 +60,7 @@ exportMethods(show)
 exportMethods(subset)
 exportMethods(summary)
 exportMethods(twdtwApply)
-exportMethods(twdtwAssessment)
+exportMethods(twdtwAssess)
 exportMethods(twdtwClassify)
 exportMethods(twdtwCrossValidation)
 exportMethods(twdtwMatches)
@@ -105,6 +105,7 @@ importFrom(sp,over)
 importFrom(sp,spTransform)
 importFrom(stats,ave)
 importFrom(stats,na.omit)
+importFrom(stats,qnorm)
 importFrom(stats,sd)
 importFrom(stats,window)
 importFrom(stats,xtabs)

R/class-crossValidation.R

@@ -55,10 +55,10 @@ setClass(
   slots = c(partitions = "list", accuracy = "list"),
   validity = function(object){
     if(!is(object@partitions, "list")){
-      stop("[twdtwTimeSeries: validation] Invalid partitions, class different from list.")
+      stop("[twdtwCrossValidation: validation] Invalid partitions, class different from list.")
     }else{}
     if(!is(object@accuracy, "list")){
-      stop("[twdtwTimeSeries: validation] Invalid accuracy, class different from list.")
+      stop("[twdtwCrossValidation: validation] Invalid accuracy, class different from list.")
     }else{}
     return(TRUE)
   }

R/class-twdtwAccuracy.R

@@ -33,20 +33,28 @@
 #' @param id.labels a numeric or character with an column name from \code{y} to 
 #' be used as samples labels. Optional.
 #' 
+#' @param labels character vector with time series labels. For signature 
+#' \code{\link[dtwSat]{twdtwRaster}} this argument can be used to set the 
+#' labels for each sample in \code{y}, or it can be combined with \code{id.labels} 
+#' to select samples with a specific label.
+#' 
 #' @param proj4string projection string, see \code{\link[sp]{CRS-class}}. Used 
 #' if \code{y} is a \code{\link[base]{data.frame}}.
 #' 
-#' @param conf.int specifies the confidence level.
+#' @param conf.int specifies the confidence level (0-1).
 #' 
 #' @seealso 
 #' \code{\link[dtwSat]{twdtwRaster-class}}, and 
 #' \code{\link[dtwSat]{twdtwClassify}}.
 #'
 #' @section Slots :
 #' \describe{
-#'  \item{\code{accuracy}:}{A list with the accuracy for each classified time period.}
-#'  \item{\code{data}:}{A \code{\link[base]{data.frame}} with reference labels, predicted labels, 
-#'  and other TWDTW information.}
+#'  \item{\code{accuracySummary}:}{Overall Accuracy, User's Accuracy, Produce's Accuracy, 
+#'  and Error Matrix (confusion matrix) considering all time periods.}
+#'  \item{\code{accuracyByPeriod}:}{Overall Accuracy, User's Accuracy, Produce's Accuracy, 
+#'  and Error Matrix (confusion matrix) for each time periods independently from each other.}
+#'  \item{\code{data}:}{A \code{\link[base]{data.frame}} with period (from - to), reference labels, 
+#'  predicted labels, and other TWDTW information.}
 #' }
 #'
 #' @examples
@@ -56,13 +64,16 @@
 NULL
 setClass(
   Class = "twdtwAssessment",
-  slots = c(accuracy = "list", data = "list"),
+  slots = c(accuracySummary = "list", accuracyByPeriod = "list", data = "data.frame"),
   validity = function(object){
-    if(!is(object@partitions, "list")){
-      stop("[twdtwTimeSeries: validation] Invalid partitions, class different from list.")
+    if(!is(object@accuracySummary, "list")){
+      stop("[twdtwAssessment: validation] Invalid partitions, class different from list.")
+    }else{}
+    if(!is(object@accuracyByPeriod, "list")){
+      stop("[twdtwAssessment: validation] Invalid accuracy, class different from list.")
     }else{}
-    if(!is(object@accuracy, "list")){
-      stop("[twdtwTimeSeries: validation] Invalid accuracy, class different from list.")
+    if(!is(object@data, "data.frame")){
+      stop("[twdtwAssessment: validation] Invalid accuracy, class different from data.frame.")
     }else{}
     return(TRUE)
   }
@@ -71,14 +82,17 @@ setClass(
 setMethod("initialize",
           signature = "twdtwAssessment",
           definition = 
-            function(.Object, partitions, accuracy){
-              .Object@partitions = list(Resample1=NULL)
-              .Object@accuracy = list(OverallAccuracy=NULL, UsersAccuracy=NULL, ProducersAccuracy=NULL, 
-                                      error.matrix=table(NULL), data=data.frame(NULL))
-              if(!missing(partitions))
-                .Object@partitions = partitions
-              if(!missing(accuracy))
-                .Object@accuracy = accuracy
+            function(.Object, accuracySummary, accuracyByPeriod, data){
+              .Object@accuracySummary = list(OverallAccuracy=NULL, UsersAccuracy=NULL, ProducersAccuracy=NULL, ErrorMatrix=table(NULL))
+              .Object@accuracyByPeriod = list(list(OverallAccuracy=NULL, UsersAccuracy=NULL, ProducersAccuracy=NULL, 
+                                                   ErrorMatrix=table(NULL)))
+              .Object@data = data.frame(Period=NULL, from=NULL, to=NULL, Distance=NULL, Predicted=NULL, Reference=NULL)
+              if(!missing(accuracySummary))
+                .Object@accuracySummary = accuracySummary
+              if(!missing(accuracyByPeriod))
+                .Object@accuracyByPeriod = accuracyByPeriod
+              if(!missing(data))
+                .Object@data = data
               validObject(.Object)
               return(.Object)
             }

R/getTimeSeries.R

@@ -116,29 +116,15 @@ getTimeSeries.twdtwTimeSeries = function(object, labels){
 setMethod("getTimeSeries", "twdtwRaster",
           function(object, y, labels=NULL, proj4string = NULL, id.labels=NULL){
 
-              if(!"label"%in%names(y)) y$label = paste0("ts",row.names(y))
-              if(!is.null(id.labels)) y$label = as.character(y[[id.labels]])
-              if(!is.null(id.labels) & !is.null(labels)){
-                I = which(!is.na(match(as.character(y$label), as.character(labels))))
-                if(length(I)<1) 
-                   stop("there is no matches between id.labels and labels")
-              } else if(!is.null(labels)) { 
-                        y$label = as.character(labels)
-              }
+              y = .adjustLabelID(y, labels, id.labels)
+
               if(!"from"%in%names(y))
                 y$from = as.Date(index(object)[1])
               if(!"to"%in%names(y))
                 y$to = as.Date(tail(index(object),1))
-              if(is(y, "data.frame")){
-                if(is.null(proj4string)){
-                  warning("Missing projection. Setting the same projection as the raster time series.", call. = FALSE)
-                  proj4string = CRS(projection(object))
-                }
-                if(!is(proj4string, "CRS")) proj4string = try(CRS(proj4string))
-                  y = SpatialPointsDataFrame(y[,c("longitude","latitude")], y, proj4string = proj4string)
-              }
-              if(!(is(y, "SpatialPoints") | is(y, "SpatialPointsDataFrame")))
-                  stop("y is not SpatialPoints or SpatialPointsDataFrame")
+
+              y = .toSpatialPointsDataFrame(y, object, proj4string)
+
               extractTimeSeries.twdtwRaster(object, y)
           })
 

R/miscellaneous.R

@@ -117,4 +117,30 @@ shiftDates.twdtwTimeSeries = function(x, year){
   data = data.frame(Predicted=pred, Reference=ref)
 }
 
+.adjustLabelID = function(y, labels, id.labels){
+  if(!"label"%in%names(y)) y$label = paste0("ts",row.names(y))
+  if(!is.null(id.labels)) y$label = as.character(y[[id.labels]])
+  if(!is.null(id.labels) & !is.null(labels)){
+    I = which(!is.na(match(as.character(y$label), as.character(labels))))
+    if(length(I)<1) 
+      stop("there is no matches between id.labels and labels")
+  } else if(!is.null(labels)) { 
+    y$label = as.character(labels)
+  }
+  y
+}
 
+.toSpatialPointsDataFrame = function(y, object, proj4string){
+  if(is(y, "data.frame")){
+    if(is.null(proj4string)){
+      warning("Missing projection. Setting the same projection as the raster time series.", call. = FALSE)
+      proj4string = CRS(projection(object))
+    }
+    if(!is(proj4string, "CRS")) proj4string = try(CRS(proj4string))
+    y = SpatialPointsDataFrame(y[,c("longitude","latitude")], y, proj4string = proj4string)
+  }
+  if(!(is(y, "SpatialPoints") | is(y, "SpatialPointsDataFrame")))
+    stop("y is not SpatialPoints or SpatialPointsDataFrame")
+  row.names(y) = 1:nrow(y)
+  y
+}