From 665d2502aa0536c85a3c8871a8865a13c1c22307 Mon Sep 17 00:00:00 2001 From: vwmaus Date: Wed, 8 Feb 2017 15:07:13 +0100 Subject: [PATCH] Include twdtwXtable to create latex tables from accuracy metrics --- DESCRIPTION | 4 +- NAMESPACE | 4 +- R/class-crossValidation.R | 46 ++++- R/class-twdtwAssessment.R | 35 +--- R/methods.R | 21 +- R/twdtwApply.R | 4 +- R/twdtwAssess.R | 93 +++++++-- ...CrossValidation.R => twdtwCrossValidate.R} | 45 ++-- R/twdtwXtable.R | 194 ++++++++++++++++++ R/xtable.R | 75 ------- man/twdtwApply.Rd | 4 +- man/twdtwAssess.Rd | 113 ++++++++++ man/twdtwAssessment-class.Rd | 109 +--------- man/twdtwCrossValidate.Rd | 74 +++++++ man/twdtwCrossValidation-class.Rd | 30 +-- man/twdtwXtable.Rd | 96 +++++++++ 16 files changed, 659 insertions(+), 288 deletions(-) rename R/{twdtwCrossValidation.R => twdtwCrossValidate.R} (61%) create mode 100644 R/twdtwXtable.R delete mode 100644 R/xtable.R create mode 100644 man/twdtwAssess.Rd create mode 100644 man/twdtwCrossValidate.Rd create mode 100644 man/twdtwXtable.Rd diff --git a/DESCRIPTION b/DESCRIPTION index e90a88f..ebdc21f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -89,7 +89,7 @@ Collate: 'twdtwApply.R' 'twdtwAssess.R' 'twdtwClassify.R' - 'twdtwCrossValidation.R' - 'xtable.R' + 'twdtwCrossValidate.R' + 'twdtwXtable.R' 'zzz.R' VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 1bad4ce..755195b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -63,11 +63,11 @@ exportMethods(summary) exportMethods(twdtwApply) exportMethods(twdtwAssess) exportMethods(twdtwClassify) -exportMethods(twdtwCrossValidation) +exportMethods(twdtwCrossValidate) exportMethods(twdtwMatches) exportMethods(twdtwRaster) exportMethods(twdtwTimeSeries) -exportMethods(xtable) +exportMethods(twdtwXtable) import(ggplot2) import(methods) import(raster) diff --git a/R/class-crossValidation.R b/R/class-crossValidation.R index 8e6dd5a..5995e9a 100644 --- a/R/class-crossValidation.R +++ b/R/class-crossValidation.R @@ -20,18 +20,12 @@ #' #' @description This class stores the results of the cross-validation. #' -#' @param object an object of class \code{\link[dtwSat]{twdtwTimeSeries}}. -#' -#' @param times Number of partitions to create. -#' -#' @param p the percentage of data that goes to training. -#' See \code{\link[caret]{createDataPartition}} for details. +#' @param object an object of class twdtwCrossValidation. #' #' @param conf.int specifies the confidence level (0-1) for interval estimation of the #' population mean. For more details see \code{\link[ggplot2]{mean_cl_boot}}. #' -#' @param ... Other arguments to be passed to \code{\link[dtwSat]{createPatterns}} and -#' to \code{\link[dtwSat]{twdtwApply}}. +#' @param ... Other arguments. Not used. #' #' @seealso #' \code{\link[dtwSat]{twdtwMatches-class}}, @@ -45,8 +39,42 @@ #' data partitions.} #' } #' -#' @examples +#' @examples #' \dontrun{ +#' # Data folder +#' data_folder = system.file("lucc_MT/data", package = "dtwSat") +#' +#' # Read dates +#' dates = scan(paste(data_folder,"timeline", sep = "/"), what = "dates") +#' +#' # Read raster time series +#' evi = brick(paste(data_folder,"evi.tif", sep = "/")) +#' raster_timeseries = twdtwRaster(evi, timeline = dates) +#' +#' # Read field samples +#' field_samples = read.csv(paste(data_folder,"samples.csv", sep = "/")) +#' table(field_samples[["label"]]) +#' +#' # Read field samples projection +#' proj_str = scan(paste(data_folder,"samples_projection", sep = "/"), +#' what = "character") +#' +#' # Get sample time series from raster time series +#' field_samples_ts = getTimeSeries(raster_timeseries, +#' y = field_samples, proj4string = proj_str) +#' field_samples_ts +#' +#' # Run cross validation +#' set.seed(1) +#' # Define TWDTW weight function +#' log_fun = logisticWeight(alpha=-0.1, beta=50) +#' cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, +#' freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) +#' cross_validation +#' +#' summary(cross_validation) +#' +#' plot(cross_validation) #' #' } NULL diff --git a/R/class-twdtwAssessment.R b/R/class-twdtwAssessment.R index a38b528..66c17e7 100644 --- a/R/class-twdtwAssessment.R +++ b/R/class-twdtwAssessment.R @@ -18,34 +18,13 @@ #' @aliases twdtwAssessment #' @author Victor Maus, \email{vwmaus1@@gmail.com} #' -#' @description This class stores the map assessment. +#' @description This class stores the map assessment metrics. #' -#' @param object an object of class \code{\link[dtwSat]{twdtwRaster}} resulting from -#' the classification, i.e. \code{\link[dtwSat]{twdtwClassify}}. +#' @param object an object of class twdtwAssessment. #' -#' @param y a \code{\link[base]{data.frame}} whose attributes are: longitude, -#' latitude, the start ''from'' and the end ''to'' of the time interval -#' for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} -#' whose attributes are the start ''from'' and the end ''to'' of the time interval. -#' If missing ''from'' and/or ''to'', they are set to the time range of the -#' \code{object}. -#' -#' @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 (0-1). -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwRaster-class}}, and -#' \code{\link[dtwSat]{twdtwClassify}}. +#' @seealso \code{\link[dtwSat]{twdtwClassify}}, +#' \code{\link[dtwSat]{twdtwAssess}}, and +#' \code{\link[dtwSat]{twdtwXtable}}. #' #' @section Slots : #' \describe{ @@ -63,10 +42,6 @@ #' surface area in km2 of each cell (pixel). If the twdtwRaster is projected the estimated area is calculated #' using the the pixel resolution in the map unit. #' -#' @examples -#' \dontrun{ -#' -#' } NULL setClass( Class = "twdtwAssessment", diff --git a/R/methods.R b/R/methods.R index db2bb0e..9730d9c 100644 --- a/R/methods.R +++ b/R/methods.R @@ -449,13 +449,22 @@ show.twdtwAssessment = function(object){ cat("Number of classification intervals:",length(object@accuracyByPeriod),"\n") cat("Accuracy metrics summary\n") cat("\nOverall\n") - print(object@accuracySummary$OverallAccuracy, digits=2) - cat("\nUsers\n") - print(object@accuracySummary$UsersAccuracy, digits=2) - cat("\nProducers\n") - print(object@accuracySummary$ProducersAccuracy, digits=2) + aux = object@accuracySummary$OverallAccuracy + names(aux) = gsub("ci", "ci*", names(aux)) + print(aux, digits=2) + cat("\nUser's\n") + aux = object@accuracySummary$UsersAccuracy + colnames(aux) = gsub("ci", "ci*", colnames(aux)) + print(aux, digits=2) + cat("\nProducer's\n") + aux = object@accuracySummary$ProducersAccuracy + colnames(aux) = gsub("ci", "ci*", colnames(aux)) + print(aux, digits=2) cat("\nArea and uncertainty\n") - print(object@accuracySummary$AreaUncertainty, digits=2) + aux = object@accuracySummary$AreaUncertainty + colnames(aux) = gsub("ci", "ci*", colnames(aux)) + print(aux, digits=2) + cat("\n*",100*object@accuracySummary$conf.int,"% confidence interval\n") invisible(NULL) } diff --git a/R/twdtwApply.R b/R/twdtwApply.R index 60abfc5..267e8b2 100644 --- a/R/twdtwApply.R +++ b/R/twdtwApply.R @@ -79,8 +79,8 @@ #' @references #' [1] Maus V, Camara G, Cartaxo R, Sanchez A, Ramos FM, de Queiroz, GR. #' (2016). A Time-Weighted Dynamic Time Warping method for land use and land cover -#' mapping. Selected Topics in Applied Earth Observations and Remote Sensing, -#' IEEE Journal of, vol.PP, no.99, pp.1-11. +#' mapping. IEEE Journal of Selected Topics in Applied Earth Observations and Remote +#' Sensing, vol.9, no.8, pp.3729-3739. #' @references #' [2] Giorgino, T. (2009). Computing and Visualizing Dynamic Time Warping Alignments in R: #' The dtw Package. Journal of Statistical Software, 31, 1-24. diff --git a/R/twdtwAssess.R b/R/twdtwAssess.R index 1bb95f4..5e862b0 100644 --- a/R/twdtwAssess.R +++ b/R/twdtwAssess.R @@ -3,15 +3,54 @@ setGeneric("twdtwAssess", def = function(object, ...) standardGeneric("twdtwAssess") ) -#' @inheritParams twdtwAssessment-class -#' @aliases twdtwAssess -#' -#' @describeIn twdtwAssessment This function performs an accuracy assessment +#' @title Assess TWDTW classification +#' @name twdtwAssess +#' @author Victor Maus, \email{vwmaus1@@gmail.com} +#' +#' @description Performs an accuracy assessment #' of the classified maps. The function returns Overall Accuracy, #' User's Accuracy, Produce's Accuracy, error matrix (confusion matrix), -#' and estimated area according to [1]. The function returns the metrics +#' and estimated area according to [1-2]. The function returns the metrics #' for each time interval and a summary considering all classified intervals. +#' +#' @param object an object of class \code{\link[dtwSat]{twdtwRaster}} resulting from +#' the classification, i.e. \code{\link[dtwSat]{twdtwClassify}}. +#' +#' @param y a \code{\link[base]{data.frame}} whose attributes are: longitude, +#' latitude, the start ''from'' and the end ''to'' of the time interval +#' for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} +#' whose attributes are the start ''from'' and the end ''to'' of the time interval. +#' If missing ''from'' and/or ''to'', they are set to the time range of the +#' \code{object}. +#' +#' @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 (0-1). +#' +#' @references +#' [1] Olofsson, P., Foody, G.M., Stehman, S.V., Woodcock, C.E. (2013). +#' Making better use of accuracy data in land change studies: Estimating +#' accuracy and area and quantifying uncertainty using stratified estimation. +#' Remote Sensing of Environment, 129, pp.122-131. +#' +#' @references +#' [2] Olofsson, P., Foody G.M., Herold M., Stehman, S.V., Woodcock, C.E., Wulder, M.A. (2014) +#' Good practices for estimating area and assessing accuracy of land change. Remote Sensing of +#' Environment, 148, pp. 42-57. #' +#' @seealso \code{\link[dtwSat]{twdtwClassify}}, +#' \code{\link[dtwSat]{twdtwAssessment}}, and +#' \code{\link[dtwSat]{twdtwXtable}}. +#' #' @examples #' \dontrun{ #' @@ -52,15 +91,21 @@ setGeneric("twdtwAssess", #' plot(r_lucc) #' #' # Assess classification -#' twdtw_assess = twdtwAssess(r_lucc, validation_samples, proj4string=proj_str) +#' twdtw_assess = twdtwAssess(object = r_lucc, y = validation_samples, +#' proj4string = proj_str, conf.int=.95) #' twdtw_assess #' -#' -#' xtable(twdtw_assess, type="matrix") -#' xtable(twdtw_assess, type="accuracy") -#' xtable(twdtw_assess, type="area") +#' # Create latex tables +#' xtable(twdtw_assess, table.type="matrix") +#' xtable(twdtw_assess, table.type="accuracy") +#' xtable(twdtw_assess, table.type="area") #' #' } +NULL + +#' @aliases twdtwAssess-twdtwRaster +#' @inheritParams twdtwAssess +#' @rdname twdtwAssess #' @export setMethod(f = "twdtwAssess", signature = "twdtwRaster", definition = function(object, y, labels=NULL, id.labels=NULL, proj4string=NULL, conf.int=.95) @@ -111,6 +156,7 @@ twdtwAssess.twdtwRaster = function(object, y, labels, id.labels, proj4string, co # Compute accuracy assessment accuracy_by_period = lapply(seq_along(error_matrix_by_period), function(i) .twdtwAssess(x = error_matrix_by_period[[i]], a_by_interval[[i]], conf.int=conf.int)) + names(accuracy_by_period) = index(object) accuracy_summary = .twdtwAssess(error_matrix_summary, area_by_class, conf.int=conf.int) new("twdtwAssessment", accuracySummary=accuracy_summary, accuracyByPeriod=accuracy_by_period, data=samples_all) @@ -214,13 +260,28 @@ twdtwAssess.twdtwRaster = function(object, y, labels, id.labels, proj4string, co } .getPredRefClasses = function(i, r_intervals, pred, pred_distance, y, rlevels, rnames){ - I = which((r_intervals$to[i] - as.Date(y$from) > 30) & (as.Date(y$to) - r_intervals$from[i] > 30) ) - if(length(I)<1) + i_leng = as.numeric(r_intervals$to[i] - r_intervals$from[i]) + from = as.Date(y$from) + to = as.Date(y$to) + # Select overlapping alignments + J = which(from <= r_intervals$to[i] & to >= r_intervals$from[i]) + # Adjust overlapping + from = sapply(from[J], function(x) ifelse(x < r_intervals$from[i], r_intervals$from[i], x)) + to = sapply(to[J], function(x) ifelse(x > r_intervals$to[i], r_intervals$to[i], x)) + # Compute overlapping proportion + i_over = to - from + print(i_leng) + print(i_over) + prop_over = abs(i_over / i_leng) + # Select alignments + I = which(prop_over > .5) + # I = which((r_intervals$to[i] - as.Date(y$from) > 30) & (as.Date(y$to) - r_intervals$from[i] > 30) ) + if(length(J[I])<1) return(NULL) - J = match(pred[I,i], rlevels) - Predicted = factor(as.character(rnames[J]), levels = rnames, labels = rnames) - Reference = factor(as.character(y$label[I]), levels = rnames, labels = rnames) - #d = pred_distance[J] + K = match(pred[J[I],i], rlevels) + Predicted = factor(as.character(rnames[K]), levels = rnames, labels = rnames) + Reference = factor(as.character(y$label[J[I]]), levels = rnames, labels = rnames) + #d = pred_distance[K] data.frame(Period=i, from=r_intervals$from[i], to=r_intervals$to[i], Predicted, Reference) } diff --git a/R/twdtwCrossValidation.R b/R/twdtwCrossValidate.R similarity index 61% rename from R/twdtwCrossValidation.R rename to R/twdtwCrossValidate.R index 2d7d777..20e894d 100644 --- a/R/twdtwCrossValidation.R +++ b/R/twdtwCrossValidate.R @@ -1,20 +1,30 @@ -setGeneric("twdtwCrossValidation", - def = function(object, ...) standardGeneric("twdtwCrossValidation") +setGeneric("twdtwCrossValidate", + def = function(object, ...) standardGeneric("twdtwCrossValidate") ) -#' @inheritParams twdtwCrossValidation-class -#' @aliases twdtwCrossValidation +#' @title Cross Validate temporal patterns +#' @name twdtwCrossValidate +#' @author Victor Maus, \email{vwmaus1@@gmail.com} #' -#' @describeIn twdtwCrossValidation -#' Splits the set of time series into training and validation. -#' The function uses stratified sampling and a simple random sampling for -#' each stratum. For each data partition this function performs a TWDTW -#' analysis and returns the Overall Accuracy, User's Accuracy, Produce's Accuracy, -#' error matrix (confusion matrix), and a \code{\link[base]{data.frame}} with -#' the classification (Predicted), the reference classes (Reference), +#' @description Splits the set of time series into training and validation and +#' compute accuracy metrics. The function uses stratified sampling and a simple +#' random sampling for each stratum. For each data partition this function +#' performs a TWDTW analysis and returns the Overall Accuracy, User's Accuracy, +#' Produce's Accuracy, error matrix (confusion matrix), and a \code{\link[base]{data.frame}} +#' with the classification (Predicted), the reference classes (Reference), #' and the results of the TWDTW analysis. #' +#' @param object an object of class \code{\link[dtwSat]{twdtwTimeSeries}}. +#' +#' @param times Number of partitions to create. +#' +#' @param p the percentage of data that goes to training. +#' See \code{\link[caret]{createDataPartition}} for details. +#' +#' @param ... Other arguments to be passed to \code{\link[dtwSat]{createPatterns}} and +#' to \code{\link[dtwSat]{twdtwApply}}. +#' #' @examples #' \dontrun{ #' # Data folder @@ -44,7 +54,7 @@ setGeneric("twdtwCrossValidation", #' set.seed(1) #' # Define TWDTW weight function #' log_fun = logisticWeight(alpha=-0.1, beta=50) -#' cross_validation = twdtwCrossValidation(field_samples_ts, times=3, p=0.1, +#' cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, #' freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) #' cross_validation #' @@ -53,11 +63,16 @@ setGeneric("twdtwCrossValidation", #' plot(cross_validation) #' #' } +NULL + +#' @aliases twdtwCrossValidate-twdtwTimeSeries +#' @inheritParams twdtwCrossValidate +#' @rdname twdtwCrossValidate #' @export -setMethod(f = "twdtwCrossValidation", - definition = function(object, times, p, ...) twdtwCrossValidation.twdtwTimeSeries(object, times, p, ...)) +setMethod(f = "twdtwCrossValidate", signature = "twdtwTimeSeries", + definition = function(object, times, p, ...) twdtwCrossValidate.twdtwTimeSeries(object, times, p, ...)) -twdtwCrossValidation.twdtwTimeSeries = function(object, times, p, ...){ +twdtwCrossValidate.twdtwTimeSeries = function(object, times, p, ...){ partitions = createDataPartition(y = labels(object), times, p, list = TRUE) diff --git a/R/twdtwXtable.R b/R/twdtwXtable.R new file mode 100644 index 0000000..aa78232 --- /dev/null +++ b/R/twdtwXtable.R @@ -0,0 +1,194 @@ +setGeneric("twdtwXtable", + def = function(object, ...) standardGeneric("twdtwXtable") +) + +#' @title Latex table from accuracy metrics +#' @name twdtwXtable +#' @author Victor Maus, \email{vwmaus1@@gmail.com} +#' +#' @description Creates Latex table from accuracy metrics +#' +#' @inheritParams twdtwAssessment-class +#' +#' @param table.type table type, 'accuracy' for User's and Producer's Accuracy, +#' 'matrix' for error matrix, and 'area' for area and uncertainty. +#' Default is 'accuracy'. +#' +#' @param time.labels a character or numeric for the time period or NULL to +#' include all classified periods. Default is NULL. +#' +#' @param category.name a character vector defining the class names. If NULL +#' then use the classe names in the object \code{x}. Default is NULL. +#' +#' @param category.type a character defining the categories type "numeric" +#' or "letter", if NULL then use the class names. Default is NULL. +#' +#' @param show.prop if TRUE shows the the estimated proportion of area. +#' Used with \code{table.type='accuracy'}. Default is TRUE. +#' +#' @param ... other arguments to pass to \code{\link[xtable]{xtable}}. +#' +#' @seealso \code{\link[dtwSat]{twdtwAssess}} and +#' \code{\link[dtwSat]{twdtwAssessment}}. +#' +#' @examples +#' \dontrun{ +#' +#' # Create raster time series +#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) +#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) +#' red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) +#' blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) +#' nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) +#' mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) +#' doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) +#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") +#' rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) +#' +#' # Read fiels samples +#' field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) +#' proj_str = scan(system.file("lucc_MT/data/samples_projection", +#' package="dtwSat"), what = "character") +#' +#' # Split samples for training (10%) and validation (90%) using stratified sampling +#' library(caret) +#' set.seed(1) +#' I = unlist(createDataPartition(field_samples$label, p = 0.1)) +#' training_samples = field_samples[I,] +#' validation_samples = field_samples[-I,] +#' +#' # Create temporal patterns +#' training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) +#' temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) +#' +#' # Run TWDTW analysis for raster time series +#' log_fun = weight.fun=logisticWeight(-0.1,50) +#' r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", +#' overwrite=TRUE) +#' +#' # Classify raster based on the TWDTW analysis +#' r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) +#' plot(r_lucc) +#' +#' # Assess classification +#' twdtw_assess = twdtwAssess(object = r_lucc, y = validation_samples, +#' proj4string = proj_str, conf.int=.95) +#' twdtw_assess +#' +#' # Create latex tables +#' xtable(twdtw_assess, table.type="matrix", category.type="letter") +#' xtable(twdtw_assess, table.type="accuracy", category.type="letter") +#' xtable(twdtw_assess, table.type="area", category.type="letter") +#' +#' } +NULL + +#' @aliases twdtwXtable-twdtwAssessment +#' @inheritParams twdtwXtable +#' @rdname twdtwXtable +#' @export +setMethod("twdtwXtable", + signature = signature(object = "twdtwAssessment"), + definition = function(object, table.type="accuracy", show.prop=TRUE, category.name=NULL, + category.type=NULL, time.labels=NULL, ...){ + xtable(object@accuracySummary$ErrorMatrix, ...) + y = object@accuracySummary + if(!is.null(time.labels)) + y = object@accuracyByPeriod[[time.labels]] + if(is.null(y)) + stop("time.labels out of bounds", call. = TRUE) + n = nrow(object@accuracySummary$ProportionMatrix) - 1 + if(is.null(category.name)) + category.name = rownames(object@accuracySummary$ProportionMatrix)[-(n+1)] + if(!is.null(category.type)) + category.name = switch(pmatch(category.type,c("numeric","letter")), + as.character(seq(1:n)), + LETTERS[1:n] + ) + pt = pmatch(table.type,c("accuracy","matrix","area")) + switch(pt, + .xtable.accuracy(x=y, category.name, show.prop, ...), + .xtable.matrix(x=y, category.name, ...), + .xtable.area(x=y, category.name, ...) + ) + } +) + +.xtable.accuracy = function(x, category.name, show.prop, ...){ + + prop = x$ProportionMatrix + prop = data.frame(apply(prop[,!names(prop)%in%c("Area","w")], 1, FUN = sprintf, fmt="%.2f"), stringsAsFactors = FALSE) + rownames(prop) = names(prop) + prop$`User's*` = "" + prop$`Producers's*` = "" + prop$`Overall*` = "" + + ua = sprintf("%.2f$\\pm$%.2f", round(x$UsersAccuracy[,"Accuracy"],2), round(x$UsersAccuracy[,"ci"], 2)) + pa = sprintf("%.2f$\\pm$%.2f", round(x$ProducersAccuracy[,"Accuracy"],2), round(x$ProducersAccuracy[,"ci"], 2)) + oa = sprintf("%.2f$\\pm$%.2f", round(x$OverallAccuracy["Accuracy"],2), round(x$OverallAccuracy["ci"], 2)) + + prop$`User's*`[1:length(ua)] = ua + prop$`Producers's*`[1:length(pa)] = pa + prop$`Overall*`[1:length(oa)] = oa + names(prop)[1:length(category.name)] = category.name + rownames(prop)[1:length(category.name)] = category.name + tbl = xtable(prop, ...) + + comment = list() + comment$pos = list() + comment$pos[[1]] = c(0) + comment$pos[[2]] = c(nrow(tbl)) + comment$command = c(paste0("&\\multicolumn{",ncol(tbl)-1,"}{c}{Reference class}\\\\\n", + paste(c("Map class",names(tbl)), collapse = " & "),"\\\\\n"), + paste("\\hline \n", "\\multicolumn{",ncol(tbl),"}{l}{* ",x$conf.int*100,"\\% confidence interval.}\n", sep = "")) + + print.xtable(tbl, add.to.row = comment, include.rownames=TRUE, include.colnames = FALSE, + hline.after = c(-1, 0), sanitize.text.function = function(x) x) +} + +.xtable.matrix = function(x, category.name, ...){ + m = x$ErrorMatrix + names(m)[ncol(m)] = "Estimation weight" + names(m)[1:length(category.name)] = category.name + rownames(m)[1:length(category.name)] = category.name + + tbl = xtable(m, digits = c(rep(0, ncol(m)-1), 2, 2), ...) + comment = list() + comment$pos = list() + comment$pos[[1]] = c(0) + comment$command = c(paste0("&\\multicolumn{",ncol(tbl)-1,"}{c}{Reference class}\\\\\n", + paste(c("Map class",names(tbl)), collapse = " & "),"\\\\\n")) + + print.xtable(tbl, add.to.row = comment, include.rownames=TRUE, include.colnames = FALSE, + hline.after = c(-1, 0), sanitize.text.function = function(x) x) + +} + +.xtable.area = function(x, category.name, ...){ + + a = x$AreaUncertainty + a = data.frame(a) + + mp = sprintf("%.2f", round(unlist(a$Mapped),2)) + ad = sprintf("%.2f", round(unlist(a$Adjusted),2)) + ci = sprintf("$\\pm$%.2f", round(unlist(a$ci),2)) + + tbl = data.frame(mp, ad, ci) + rownames(tbl) = category.name + names(tbl) = c("Mapped area", "Adjusted area", "Margin of error*") + tbl = xtable(tbl, ...) + + comment = list() + comment$pos = list() + comment$pos[[1]] = c(0) + comment$pos[[2]] = c(nrow(tbl)) + comment$command = c(paste0(paste(c("Class",names(tbl)), collapse = " & "), "\\\\\n"), + paste("\\hline \n", "\\multicolumn{",ncol(tbl),"}{l}{* ",x$conf.int*100,"\\% confidence interval.}\n", sep = "")) + + print.xtable(tbl, add.to.row = comment, include.rownames=TRUE, include.colnames = FALSE, + hline.after = c(-1, 0), sanitize.text.function = function(x) x) + +} + + + diff --git a/R/xtable.R b/R/xtable.R deleted file mode 100644 index 5d5ccb2..0000000 --- a/R/xtable.R +++ /dev/null @@ -1,75 +0,0 @@ -#' @aliases xtable -#' @inheritParams twdtwAssessment-class -#' @rdname twdtwAssessment-class -#' -#' @param x an object of class \code{\link[dtwSat]{twdtwAssessment}}. -#' @param type table type, 'accuracy' for User's and Producer's Accuracy, -#' 'matrix' for error matrix, and 'area' for area and uncertainty. -#' Default is 'accuracy'. -#' @param time.labels a character or numeric for the time period or NULL to -#' include all classified periods. Default is NULL. -#' @param ... other arguments to pass to \code{\link[xtable]{xtable}}. -#' -#' @export -setMethod("xtable", - signature = signature(x = "twdtwAssessment"), - definition = function(x, type="accuracy", time.labels=NULL, ...){ - xtable(x@accuracySummary$ErrorMatrix, ...) - pt = pmatch(type,c("accuracy","matrix","area")) - switch(pt, - .xtable.accuracy(x=x@accuracySummary, ...), - .xtable.matrix(x=x@accuracySummary$ErrorMatrix, ...), - .xtable.area(x=x@accuracySummary$AreaUncertainty, ...) - ) - } -) - -.xtable.accuracy = function(x, ...){ - - prop = x$ProportionMatrix - prop = data.frame(apply(prop[,!names(prop)%in%c("Area","w")], 1, FUN = sprintf, fmt="%.2f"), stringsAsFactors = FALSE) - prop$`User's` = "" - prop$`Producers's` = "" - prop$`Overall` = "" - - ua = sprintf("%.2f$\\pm$%.2f", round(x$UsersAccuracy[,"Accuracy"],2), round(x$UsersAccuracy[,"ci"], 2)) - pa = sprintf("%.2f$\\pm$%.2f", round(x$ProducersAccuracy[,"Accuracy"],2), round(x$ProducersAccuracy[,"ci"], 2)) - oa = sprintf("%.2f$\\pm$%.2f", round(x$OverallAccuracy["Accuracy"],2), round(x$OverallAccuracy["ci"], 2)) - - prop$`User's`[1:length(ua)] = ua - prop$`Producers's`[1:length(pa)] = pa - prop$`Overall`[1:length(oa)] = oa - tbl = xtable(prop) - - comment = list() - comment$pos = list() - comment$pos[[1]] = c(nrow(tbl)) - comment$command = c(paste("\\hline \n", "Test foot note. \n", sep = "")) - - print.xtable(tbl, add.to.row = comment, sanitize.text.function = function(x) x) -} - -.xtable.matrix = function(x, ...){ - tbl = xtable(x, digits = c(rep(0, ncol(x)-1), 2, 2), ...) - print.xtable(tbl, sanitize.text.function = function(x) x) -} - -.xtable.area = function(x, ...){ - - x=twdtw_assess@accuracySummary$AreaUncertainty - x = data.frame(x) - - mp = sprintf("%.2f", round(unlist(x$Mapped),2)) - ad = sprintf("%.2f", round(unlist(x$Adjusted),2)) - ci = sprintf("$\\pm$%.2f", round(unlist(x$ci),2)) - - tbl = data.frame(mp, ad, ci) - names(tbl) = c("Mapped", "Adjusted", "Margin of error (95\\% CI)") - - tbl = xtable(tbl) - - print.xtable(tbl, sanitize.text.function = function(x) x) -} - - - diff --git a/man/twdtwApply.Rd b/man/twdtwApply.Rd index 9d2ec01..d5b7114 100644 --- a/man/twdtwApply.Rd +++ b/man/twdtwApply.Rd @@ -156,8 +156,8 @@ Victor Maus, \email{vwmaus1@gmail.com} \references{ [1] Maus V, Camara G, Cartaxo R, Sanchez A, Ramos FM, de Queiroz, GR. (2016). A Time-Weighted Dynamic Time Warping method for land use and land cover -mapping. Selected Topics in Applied Earth Observations and Remote Sensing, -IEEE Journal of, vol.PP, no.99, pp.1-11. +mapping. IEEE Journal of Selected Topics in Applied Earth Observations and Remote +Sensing, vol.9, no.8, pp.3729-3739. [2] Giorgino, T. (2009). Computing and Visualizing Dynamic Time Warping Alignments in R: The dtw Package. Journal of Statistical Software, 31, 1-24. diff --git a/man/twdtwAssess.Rd b/man/twdtwAssess.Rd new file mode 100644 index 0000000..e06d003 --- /dev/null +++ b/man/twdtwAssess.Rd @@ -0,0 +1,113 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/twdtwAssess.R +\docType{methods} +\name{twdtwAssess} +\alias{twdtwAssess} +\alias{twdtwAssess,twdtwRaster-method} +\alias{twdtwAssess-twdtwRaster} +\title{Assess TWDTW classification} +\usage{ +\S4method{twdtwAssess}{twdtwRaster}(object, y, labels = NULL, + id.labels = NULL, proj4string = NULL, conf.int = 0.95) +} +\arguments{ +\item{object}{an object of class \code{\link[dtwSat]{twdtwRaster}} resulting from +the classification, i.e. \code{\link[dtwSat]{twdtwClassify}}.} + +\item{y}{a \code{\link[base]{data.frame}} whose attributes are: longitude, +latitude, the start ''from'' and the end ''to'' of the time interval +for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} +whose attributes are the start ''from'' and the end ''to'' of the time interval. +If missing ''from'' and/or ''to'', they are set to the time range of the +\code{object}.} + +\item{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.} + +\item{id.labels}{a numeric or character with an column name from \code{y} to +be used as samples labels. Optional.} + +\item{proj4string}{projection string, see \code{\link[sp]{CRS-class}}. Used +if \code{y} is a \code{\link[base]{data.frame}}.} + +\item{conf.int}{specifies the confidence level (0-1).} +} +\description{ +Performs an accuracy assessment +of the classified maps. The function returns Overall Accuracy, +User's Accuracy, Produce's Accuracy, error matrix (confusion matrix), +and estimated area according to [1-2]. The function returns the metrics +for each time interval and a summary considering all classified intervals. +} +\examples{ +\dontrun{ + +# Create raster time series +evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) +ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) +red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) +blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) +nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) +mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) +doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) +timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") +rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) + +# Read fiels samples +field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) +proj_str = scan(system.file("lucc_MT/data/samples_projection", + package="dtwSat"), what = "character") + +# Split samples for training (10\%) and validation (90\%) using stratified sampling +library(caret) +set.seed(1) +I = unlist(createDataPartition(field_samples$label, p = 0.1)) +training_samples = field_samples[I,] +validation_samples = field_samples[-I,] + +# Create temporal patterns +training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) +temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) + +# Run TWDTW analysis for raster time series +log_fun = weight.fun=logisticWeight(-0.1,50) +r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", + overwrite=TRUE) + +# Classify raster based on the TWDTW analysis +r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) +plot(r_lucc) + +# Assess classification +twdtw_assess = twdtwAssess(object = r_lucc, y = validation_samples, + proj4string = proj_str, conf.int=.95) +twdtw_assess + +# Create latex tables +xtable(twdtw_assess, table.type="matrix") +xtable(twdtw_assess, table.type="accuracy") +xtable(twdtw_assess, table.type="area") + +} +} +\author{ +Victor Maus, \email{vwmaus1@gmail.com} +} +\references{ +[1] Olofsson, P., Foody, G.M., Stehman, S.V., Woodcock, C.E. (2013). +Making better use of accuracy data in land change studies: Estimating +accuracy and area and quantifying uncertainty using stratified estimation. +Remote Sensing of Environment, 129, pp.122-131. + +[2] Olofsson, P., Foody G.M., Herold M., Stehman, S.V., Woodcock, C.E., Wulder, M.A. (2014) +Good practices for estimating area and assessing accuracy of land change. Remote Sensing of +Environment, 148, pp. 42-57. +} +\seealso{ +\code{\link[dtwSat]{twdtwClassify}}, +\code{\link[dtwSat]{twdtwAssessment}}, and +\code{\link[dtwSat]{twdtwXtable}}. +} + diff --git a/man/twdtwAssessment-class.Rd b/man/twdtwAssessment-class.Rd index ddfac98..594b800 100644 --- a/man/twdtwAssessment-class.Rd +++ b/man/twdtwAssessment-class.Rd @@ -1,75 +1,25 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-twdtwAssessment.R, R/methods.R, R/twdtwAssess.R, R/xtable.R +% Please edit documentation in R/class-twdtwAssessment.R, R/methods.R \docType{methods} \name{twdtwAssessment-class} \alias{show,twdtwAssessment-method} -\alias{twdtwAssess} -\alias{twdtwAssess,twdtwRaster-method} \alias{twdtwAssessment} \alias{twdtwAssessment-class} -\alias{xtable} -\alias{xtable,twdtwAssessment-method} \title{class "twdtwAssessment"} \usage{ \S4method{show}{twdtwAssessment}(object) - -\S4method{twdtwAssess}{twdtwRaster}(object, y, labels = NULL, - id.labels = NULL, proj4string = NULL, conf.int = 0.95) - -\S4method{xtable}{twdtwAssessment}(x, type = "accuracy", time.labels = NULL, - ...) } \arguments{ -\item{object}{an object of class \code{\link[dtwSat]{twdtwRaster}} resulting from -the classification, i.e. \code{\link[dtwSat]{twdtwClassify}}.} - -\item{y}{a \code{\link[base]{data.frame}} whose attributes are: longitude, -latitude, the start ''from'' and the end ''to'' of the time interval -for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} -whose attributes are the start ''from'' and the end ''to'' of the time interval. -If missing ''from'' and/or ''to'', they are set to the time range of the -\code{object}.} - -\item{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.} - -\item{id.labels}{a numeric or character with an column name from \code{y} to -be used as samples labels. Optional.} - -\item{proj4string}{projection string, see \code{\link[sp]{CRS-class}}. Used -if \code{y} is a \code{\link[base]{data.frame}}.} - -\item{conf.int}{specifies the confidence level (0-1).} - -\item{x}{an object of class \code{\link[dtwSat]{twdtwAssessment}}.} - -\item{type}{table type, 'accuracy' for User's and Producer's Accuracy, -'matrix' for error matrix, and 'area' for area and uncertainty. -Default is 'accuracy'.} - -\item{time.labels}{a character or numeric for the time period or NULL to -include all classified periods. Default is NULL.} - -\item{...}{other arguments to pass to \code{\link[xtable]{xtable}}.} +\item{object}{an object of class twdtwAssessment.} } \description{ -This class stores the map assessment. +This class stores the map assessment metrics. } \details{ If the twdtwRaster is unprojected (longitude/latitude) the estimated area is sum of the approximate surface area in km2 of each cell (pixel). If the twdtwRaster is projected the estimated area is calculated using the the pixel resolution in the map unit. } -\section{Methods (by generic)}{ -\itemize{ -\item \code{twdtwAssess}: This function performs an accuracy assessment -of the classified maps. The function returns Overall Accuracy, -User's Accuracy, Produce's Accuracy, error matrix (confusion matrix), -and estimated area according to [1]. The function returns the metrics -for each time interval and a summary considering all classified intervals. -}} \section{Slots }{ \describe{ @@ -80,61 +30,14 @@ for each time interval and a summary considering all classified intervals. 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{ -\dontrun{ - -} -\dontrun{ - -# Create raster time series -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Read fiels samples -field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -proj_str = scan(system.file("lucc_MT/data/samples_projection", - package="dtwSat"), what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -library(caret) -set.seed(1) -I = unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples = field_samples[I,] -validation_samples = field_samples[-I,] - -# Create temporal patterns -training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) -temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Run TWDTW analysis for raster time series -log_fun = weight.fun=logisticWeight(-0.1,50) -r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", - overwrite=TRUE) - -# Classify raster based on the TWDTW analysis -r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) -plot(r_lucc) - -# Assess classification -twdtw_assess = twdtwAssess(r_lucc, validation_samples, proj4string=proj_str) -twdtw_assess - } } \author{ Victor Maus, \email{vwmaus1@gmail.com} } \seealso{ -\code{\link[dtwSat]{twdtwRaster-class}}, and -\code{\link[dtwSat]{twdtwClassify}}. +\code{\link[dtwSat]{twdtwClassify}}, +\code{\link[dtwSat]{twdtwAssess}}, and +\code{\link[dtwSat]{twdtwXtable}}. } diff --git a/man/twdtwCrossValidate.Rd b/man/twdtwCrossValidate.Rd new file mode 100644 index 0000000..dd65c82 --- /dev/null +++ b/man/twdtwCrossValidate.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/twdtwCrossValidate.R +\docType{methods} +\name{twdtwCrossValidate} +\alias{twdtwCrossValidate} +\alias{twdtwCrossValidate,twdtwTimeSeries-method} +\alias{twdtwCrossValidate-twdtwTimeSeries} +\title{Cross Validate temporal patterns} +\usage{ +\S4method{twdtwCrossValidate}{twdtwTimeSeries}(object, times, p, ...) +} +\arguments{ +\item{object}{an object of class \code{\link[dtwSat]{twdtwTimeSeries}}.} + +\item{times}{Number of partitions to create.} + +\item{p}{the percentage of data that goes to training. +See \code{\link[caret]{createDataPartition}} for details.} + +\item{...}{Other arguments to be passed to \code{\link[dtwSat]{createPatterns}} and +to \code{\link[dtwSat]{twdtwApply}}.} +} +\description{ +Splits the set of time series into training and validation and +compute accuracy metrics. The function uses stratified sampling and a simple +random sampling for each stratum. For each data partition this function +performs a TWDTW analysis and returns the Overall Accuracy, User's Accuracy, +Produce's Accuracy, error matrix (confusion matrix), and a \code{\link[base]{data.frame}} +with the classification (Predicted), the reference classes (Reference), +and the results of the TWDTW analysis. +} +\examples{ +\dontrun{ +# Data folder +data_folder = system.file("lucc_MT/data", package = "dtwSat") + +# Read dates +dates = scan(paste(data_folder,"timeline", sep = "/"), what = "dates") + +# Read raster time series +evi = brick(paste(data_folder,"evi.tif", sep = "/")) +raster_timeseries = twdtwRaster(evi, timeline = dates) + +# Read field samples +field_samples = read.csv(paste(data_folder,"samples.csv", sep = "/")) +table(field_samples[["label"]]) + +# Read field samples projection +proj_str = scan(paste(data_folder,"samples_projection", sep = "/"), + what = "character") + +# Get sample time series from raster time series +field_samples_ts = getTimeSeries(raster_timeseries, + y = field_samples, proj4string = proj_str) +field_samples_ts + +# Run cross validation +set.seed(1) +# Define TWDTW weight function +log_fun = logisticWeight(alpha=-0.1, beta=50) +cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, + freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) +cross_validation + +summary(cross_validation) + +plot(cross_validation) + +} +} +\author{ +Victor Maus, \email{vwmaus1@gmail.com} +} + diff --git a/man/twdtwCrossValidation-class.Rd b/man/twdtwCrossValidation-class.Rd index fcbb76b..19d3a04 100644 --- a/man/twdtwCrossValidation-class.Rd +++ b/man/twdtwCrossValidation-class.Rd @@ -1,47 +1,28 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-crossValidation.R, R/methods.R, R/twdtwCrossValidation.R +% Please edit documentation in R/class-crossValidation.R, R/methods.R \docType{methods} \name{twdtwCrossValidation-class} \alias{show,twdtwCrossValidation-method} \alias{summary,twdtwCrossValidation-method} \alias{twdtwCrossValidation} -\alias{twdtwCrossValidation,ANY-method} \alias{twdtwCrossValidation-class} \title{class "twdtwCrossValidation"} \usage{ \S4method{show}{twdtwCrossValidation}(object) \S4method{summary}{twdtwCrossValidation}(object, conf.int = 0.95, ...) - -\S4method{twdtwCrossValidation}{ANY}(object, times, p, ...) } \arguments{ -\item{object}{an object of class \code{\link[dtwSat]{twdtwTimeSeries}}.} +\item{object}{an object of class twdtwCrossValidation.} \item{conf.int}{specifies the confidence level (0-1) for interval estimation of the population mean. For more details see \code{\link[ggplot2]{mean_cl_boot}}.} -\item{...}{Other arguments to be passed to \code{\link[dtwSat]{createPatterns}} and -to \code{\link[dtwSat]{twdtwApply}}.} - -\item{times}{Number of partitions to create.} - -\item{p}{the percentage of data that goes to training. -See \code{\link[caret]{createDataPartition}} for details.} +\item{...}{Other arguments. Not used.} } \description{ This class stores the results of the cross-validation. } -\section{Methods (by generic)}{ -\itemize{ -\item \code{twdtwCrossValidation}: Splits the set of time series into training and validation. -The function uses stratified sampling and a simple random sampling for -each stratum. For each data partition this function performs a TWDTW -analysis and returns the Overall Accuracy, User's Accuracy, Produce's Accuracy, -error matrix (confusion matrix), and a \code{\link[base]{data.frame}} with -the classification (Predicted), the reference classes (Reference), -and the results of the TWDTW analysis. -}} \section{Slots }{ \describe{ @@ -52,9 +33,6 @@ and the results of the TWDTW analysis. } \examples{ \dontrun{ - -} -\dontrun{ # Data folder data_folder = system.file("lucc_MT/data", package = "dtwSat") @@ -82,7 +60,7 @@ field_samples_ts set.seed(1) # Define TWDTW weight function log_fun = logisticWeight(alpha=-0.1, beta=50) -cross_validation = twdtwCrossValidation(field_samples_ts, times=3, p=0.1, +cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) cross_validation diff --git a/man/twdtwXtable.Rd b/man/twdtwXtable.Rd new file mode 100644 index 0000000..32e6092 --- /dev/null +++ b/man/twdtwXtable.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/twdtwXtable.R +\docType{methods} +\name{twdtwXtable} +\alias{twdtwXtable} +\alias{twdtwXtable,twdtwAssessment-method} +\alias{twdtwXtable-twdtwAssessment} +\title{Latex table from accuracy metrics} +\usage{ +\S4method{twdtwXtable}{twdtwAssessment}(object, table.type = "accuracy", + show.prop = TRUE, category.name = NULL, category.type = NULL, + time.labels = NULL, ...) +} +\arguments{ +\item{object}{an object of class twdtwAssessment.} + +\item{table.type}{table type, 'accuracy' for User's and Producer's Accuracy, +'matrix' for error matrix, and 'area' for area and uncertainty. +Default is 'accuracy'.} + +\item{show.prop}{if TRUE shows the the estimated proportion of area. +Used with \code{table.type='accuracy'}. Default is TRUE.} + +\item{category.name}{a character vector defining the class names. If NULL +then use the classe names in the object \code{x}. Default is NULL.} + +\item{category.type}{a character defining the categories type "numeric" +or "letter", if NULL then use the class names. Default is NULL.} + +\item{time.labels}{a character or numeric for the time period or NULL to +include all classified periods. Default is NULL.} + +\item{...}{other arguments to pass to \code{\link[xtable]{xtable}}.} +} +\description{ +Creates Latex table from accuracy metrics +} +\examples{ +\dontrun{ + +# Create raster time series +evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) +ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) +red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) +blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) +nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) +mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) +doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) +timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") +rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) + +# Read fiels samples +field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) +proj_str = scan(system.file("lucc_MT/data/samples_projection", + package="dtwSat"), what = "character") + +# Split samples for training (10\%) and validation (90\%) using stratified sampling +library(caret) +set.seed(1) +I = unlist(createDataPartition(field_samples$label, p = 0.1)) +training_samples = field_samples[I,] +validation_samples = field_samples[-I,] + +# Create temporal patterns +training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) +temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) + +# Run TWDTW analysis for raster time series +log_fun = weight.fun=logisticWeight(-0.1,50) +r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", + overwrite=TRUE) + +# Classify raster based on the TWDTW analysis +r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) +plot(r_lucc) + +# Assess classification +twdtw_assess = twdtwAssess(object = r_lucc, y = validation_samples, + proj4string = proj_str, conf.int=.95) +twdtw_assess + +# Create latex tables +xtable(twdtw_assess, table.type="matrix", category.type="letter") +xtable(twdtw_assess, table.type="accuracy", category.type="letter") +xtable(twdtw_assess, table.type="area", category.type="letter") + +} +} +\author{ +Victor Maus, \email{vwmaus1@gmail.com} +} +\seealso{ +\code{\link[dtwSat]{twdtwAssess}} and +\code{\link[dtwSat]{twdtwAssessment}}. +} +