improve codecov

Author: gilbertocamara

NAMESPACE

@@ -10,7 +10,6 @@ S3method("sits_labels<-",class_cube)
 S3method("sits_labels<-",default)
 S3method("sits_labels<-",probs_cube)
 S3method("sits_labels<-",sits)
-S3method("sits_labels<-",tbl_df)
 S3method(.band_rename,raster_cube)
 S3method(.band_rename,sits)
 S3method(.check_samples,default)
@@ -22,6 +21,7 @@ S3method(.cube_as_sf,default)
 S3method(.cube_as_sf,raster_cube)
 S3method(.cube_bands,default)
 S3method(.cube_bands,raster_cube)
+S3method(.cube_bands,tbl_df)
 S3method(.cube_bbox,default)
 S3method(.cube_bbox,raster_cube)
 S3method(.cube_collection,default)
@@ -48,8 +48,6 @@ S3method(.cube_filter_tiles,raster_cube)
 S3method(.cube_find_class,default)
 S3method(.cube_find_class,raster_cube)
 S3method(.cube_find_class,tbl_df)
-S3method(.cube_foreach_tile,default)
-S3method(.cube_foreach_tile,raster_cube)
 S3method(.cube_intersects,default)
 S3method(.cube_intersects,raster_cube)
 S3method(.cube_is_complete,default)
@@ -60,6 +58,7 @@ S3method(.cube_is_token_expired,default)
 S3method(.cube_is_token_expired,mpc_cube)
 S3method(.cube_labels,default)
 S3method(.cube_labels,raster_cube)
+S3method(.cube_labels,tbl_df)
 S3method(.cube_merge_tiles,default)
 S3method(.cube_merge_tiles,derived_cube)
 S3method(.cube_merge_tiles,raster_cube)
@@ -275,7 +274,6 @@ S3method(sits_apply,default)
 S3method(sits_apply,derived_cube)
 S3method(sits_apply,raster_cube)
 S3method(sits_apply,sits)
-S3method(sits_apply,tbl_df)
 S3method(sits_as_sf,raster_cube)
 S3method(sits_as_sf,sits)
 S3method(sits_bands,default)
@@ -329,7 +327,6 @@ S3method(sits_labels,patterns)
 S3method(sits_labels,raster_cube)
 S3method(sits_labels,sits)
 S3method(sits_labels,sits_model)
-S3method(sits_labels,tbl_df)
 S3method(sits_labels_summary,sits)
 S3method(sits_merge,default)
 S3method(sits_merge,raster_cube)

R/api_cube.R

@@ -195,6 +195,17 @@ NULL
     bands
 }
 #' @export
+.cube_bands.tbl_df <- function(cube, add_cloud = TRUE, dissolve = TRUE) {
+    cube <- tibble::as_tibble(cube)
+    if (all(.conf("sits_cube_cols") %in% colnames(cube))) {
+        class(cube) <- c("raster_cube", class(cube))
+        bands <- .cube_bands(cube)
+    } else
+        stop("Input is not a valid data cube")
+
+    return(bands)
+}
+#' @export
 .cube_bands.default <- function(cube, add_cloud = TRUE, dissolve = TRUE) {
     if (is.list(cube)) {
         class(cube) <- c("list", class(cube))
@@ -225,6 +236,17 @@ NULL
     return(labels)
 }
 #' @export
+.cube_labels.tbl_df <- function(cube, dissolve = TRUE) {
+    cube <- tibble::as_tibble(cube)
+    if (all(.conf("sits_cube_cols") %in% colnames(cube))) {
+        class(cube) <- c("raster_cube", class(cube))
+        labels <- .cube_labels(cube)
+    } else
+        stop("Input is not a valid data cube")
+
+    return(labels)
+}
+#' @export
 .cube_labels.default <- function(cube, dissolve = TRUE) {
     if (is.list(cube)) {
         class(cube) <- c("list", class(cube))
@@ -548,19 +570,8 @@ NULL
 #' Iterates over each cube tile, passing tile to function's first argument.
 #' @returns  A processed data cube.
 .cube_foreach_tile <- function(cube, fn, ...) {
-    UseMethod(".cube_foreach_tile", cube)
-}
-#' @export
-.cube_foreach_tile.raster_cube <- function(cube, fn, ...) {
     slider::slide_dfr(cube, fn, ...)
 }
-#' @export
-.cube_foreach_tile.default <- function(cube, fn, ...) {
-    cube <- tibble::as_tibble(cube)
-    cube <- .cube_find_class(cube)
-    result <- .cube_foreach_tile(cube, fn, ...)
-    return(result)
-}
 # ---- spatial ----
 .cube_bbox <- function(cube, as_crs = NULL) {
     UseMethod(".cube_bbox", cube)
@@ -702,7 +713,7 @@ NULL
     })
     # Post-condition
     .check_that(
-        nrow(cube) > 1,
+        nrow(cube) >= 1,
         msg = "The provided 'dates' does not match any date in the cube.",
         local_msg = "invalid 'dates' parameter."
     )

R/api_summary.R

@@ -1,31 +1,3 @@
-#' @title Summary of a tile of a cube
-#' @noRd
-#' @param tile A \code{tile}.
-#' @return Called for side effects
-.summary_tile_information <- function(tile) {
-    # print the basic tile information
-    cat("class       : ", class(tile)[1], "\n")
-    cat("dimensions  : ",
-        .tile_nrows(tile), ", ",
-        .tile_ncols(tile), "  (nrow, ncol)\n",
-        sep = ""
-    )
-    cat("resolution  : ",
-        .tile_xres(tile), ", ",
-        .tile_yres(tile), "  (x, y)\n",
-        sep = ""
-    )
-    cat("extent      : ",
-        .xmin(tile), ", ",
-        .xmax(tile), ", ",
-        .ymin(tile), ", ",
-        .ymax(tile),
-        "  (xmin, xmax, ymin, ymax)\n",
-        sep = ""
-    )
-    cat("coord ref   : ", .crs_wkt_to_proj4(tile$crs), "\n")
-    return(invisible(tile))
-}
 #' @title Check in tile is available
 #' @noRd
 #' @param cube data cube

R/sits_apply.R

@@ -207,7 +207,7 @@ sits_apply.derived_cube <- function(data,...) {
 }
 #' @rdname sits_apply
 #' @export
-sits_apply.tbl_df <- function(data,...) {
+sits_apply.default <- function(data,...) {
     data <- tibble::as_tibble(data)
     if (all(.conf("sits_cube_cols") %in% colnames(data))) {
         data <- .cube_find_class(data)
@@ -218,8 +218,3 @@ sits_apply.tbl_df <- function(data,...) {
     acc <- sits_apply(data, ...)
     return(acc)
 }
-#' @rdname sits_apply
-#' @export
-sits_apply.default <- function(data, ...) {
-    stop("Input should be a sits tibble or a data cube")
-}

R/sits_labels.R

@@ -7,9 +7,6 @@
 #'                  patterns (tibble of class "patterns"),
 #'                  data cube (tibble of class "raster_cube"), or
 #'                  model (closure of class "sits_model").
-#' @param value     A character vector used to convert labels. Labels will
-#'                   be renamed to the respective value positioned at the
-#'                   labels order returned by \code{\link{sits_labels}}.
 #' @return          The labels of the input data (character vector).
 #'
 #' @examples
@@ -84,7 +81,7 @@ sits_labels.sits_model <- function(data) {
 }
 #' @rdname sits_labels
 #' @export
-sits_labels.tbl_df <- function(data) {
+sits_labels.default <- function(data) {
     data <- tibble::as_tibble(data)
     if (all(.conf("sits_cube_cols") %in% colnames(data))) {
         data <- .cube_find_class(data)
@@ -95,11 +92,6 @@ sits_labels.tbl_df <- function(data) {
     data <- sits_labels(data)
     return(data)
 }
-#' @rdname sits_labels
-#' @export
-sits_labels.default <- function(data) {
-    stop("input should be an object of class cube or class sits")
-}
 #' @title Change the labels of a set of time series
 #' @name `sits_labels<-`
 #' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
@@ -189,26 +181,19 @@ sits_labels.default <- function(data) {
     })
     return(rows)
 }
-#' @name sits_labels
+#' @name `sits_labels<-`
 #' @export
-`sits_labels<-.tbl_df` <- function(data, value) {
+`sits_labels<-.default` <- function(data, value) {
+    data <- tibble::as_tibble(data)
     if (all(.conf("sits_cube_cols") %in% colnames(data))) {
-        class(data) <- c("raster_cube", class(data))
+        data <- .cube_find_class(data)
     } else if (all(.conf("sits_tibble_cols") %in% colnames(data))) {
         class(data) <- c("sits", class(data))
     } else
         stop("Input should be a sits tibble, data cube, patterns, or model")
     sits_labels(data) <- value
     return(data)
 }
-#' @name `sits_labels<-`
-#' @export
-#'
-`sits_labels<-.default` <- function(data, value) {
-    data <- tibble::as_tibble(data)
-    sits_labels(data) <- value
-    return(data)
-}
 #' @title Inform label distribution of a set of time series
 #' @name sits_labels_summary
 #' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}

R/sits_timeline.R

@@ -69,12 +69,15 @@ sits_timeline.tbl_df <- function(data) {
         class(data) <- c("sits", class(data))
     } else
         stop("Input should be a sits tibble or a data cube")
-    data <- sits_timeline(data)
-    return(data)
+    timeline <- sits_timeline(data)
+    return(timeline)
 }
 #' @rdname sits_timeline
 #' @export
 #'
 sits_timeline.default <- function(data) {
-    stop("input should be an object of class cube or class sits")
+    data <- tibble::as_tibble(data)
+    timeline <- sits_timeline(data)
+    return(timeline)
+
 }

man/sits_apply.Rd

@@ -88,6 +88,18 @@ test_that("Testing normalized index generation", {
     start_date <- timeline[1]
     end_date <- timeline[length(timeline)]
 
+    # test with data frame
+    #
+    gc_cube2 <- gc_cube
+    class(gc_cube2) <- "data.frame"
+
+    gc_cube2 <- sits_apply(gc_cube2,
+                              NDRE = (B8A - B05) / (B8A + B05),
+                              multicores = 1,
+                              output_dir = dir_images
+    )
+    expect_true("NDRE" %in% sits_bands(gc_cube2))
+
     csv_tb <- purrr::map2_dfr(lats, longs, function(lat, long) {
         tibble::tibble(
             longitude = long,

man/sits_labels.Rd

@@ -193,6 +193,24 @@ test_that("Creating cubes from BDC - based on ROI with shapefile", {
     expect_gt(bbox["ymax"], bbox_shp["ymax"])
     intersects <- .cube_intersects(modis_cube, sf_mt)
     expect_true(all(intersects))
+
+    modis_cube2 <- modis_cube
+    class(modis_cube2) <- "data.frame"
+    in2 <- .cube_intersects(modis_cube2, sf_mt)
+    expect_true(all(in2))
+
+    modis_cube3 <- .cube_filter_spatial(modis_cube2, sf_mt)
+    expect_equal(nrow(modis_cube2), nrow(modis_cube3))
+
+    modis_cube4 <- .cube_filter_bands(modis_cube2, "EVI")
+    expect_true(.cube_bands(modis_cube4) %in% .cube_bands(modis_cube2))
+
+    modis_tiles <- .cube_tiles(modis_cube2)
+    expect_true(all(c("011009", "012010") %in% .cube_tiles(modis_cube)))
+
+    tile_011009 <- .cube_filter_tiles(modis_cube, "011009")
+    expect_equal(nrow(tile_011009), 1)
+
 })
 test_that("Creating cubes from BDC - invalid roi", {
     expect_error(
@@ -497,6 +515,21 @@ test_that("Creating Sentinel cubes from MPC with ROI", {
     cube_nrows <- .tile_nrows(s2_cube_mpc)
     expect_true(.raster_nrows(r_obj) == cube_nrows)
 })
+test_that("Creating Sentinel-1 cubes from MPC", {
+    cube_s1 <-  sits_cube(
+        source = "MPC",
+        collection = "SENTINEL-1-RTC",
+        bands = c("VV", "VH"),
+        orbit = "descending",
+        roi = c(lat_max = 3.619058, lon_max = -74.01153, lat_min = 2.625301, lon_min = -75.00018),
+        start_date = "2023-03-01",
+        end_date = "2023-09-30"
+    )
+    bbox <- sits_bbox(cube_s1)
+    expect_true(grepl("18N", bbox[["crs"]]))
+    expect_equal(381340, bbox[["xmin"]])
+    expect_equal(701860, bbox[["xmax"]])
+})
 test_that("Creating LANDSAT cubes from MPC with ROI", {
     roi <- c(
         lon_min = -48.28579, lat_min = -16.05026,