|
54 | 54 | rast <- .raster_open_rast(.tile_path(cube)) |
55 | 55 | block <- .raster_file_blocksize(rast) |
56 | 56 | # 1st case - split samples by tiles |
57 | | - if (.raster_nrows(rast) == block[["nrows"]] && |
58 | | - .raster_ncols(rast) == block[["ncols"]]) { |
| 57 | + if ((.raster_nrows(rast) == block[["nrows"]] && |
| 58 | + .raster_ncols(rast) == block[["ncols"]]) || |
| 59 | + inherits(cube, "dem_cube")) { |
59 | 60 | # split samples by bands and tile |
60 | 61 | ts_tbl <- .data_by_tile( |
61 | 62 | cube = cube, |
|
78 | 79 | progress = progress |
79 | 80 | ) |
80 | 81 | } |
| 82 | + if (.has(cube[["base_info"]])) { |
| 83 | + cube_base <- cube[["base_info"]][[1]] |
| 84 | + bands_base <- .cube_bands(cube_base) |
| 85 | + base_tbl <- .data_get_ts( |
| 86 | + cube = cube_base, |
| 87 | + samples = samples, |
| 88 | + bands = bands_base, |
| 89 | + impute_fn = impute_fn, |
| 90 | + multicores = multicores, |
| 91 | + progress = progress |
| 92 | + ) |
| 93 | + } |
81 | 94 | return(ts_tbl) |
82 | 95 | } |
83 | 96 |
|
|
102 | 115 | } |
103 | 116 | .check_cube_bands(cube, bands = bands) |
104 | 117 | # get cubes timeline |
105 | | - tl <- sits_timeline(cube) |
| 118 | + tl <- .cube_timeline(cube)[[1]] |
106 | 119 | # create tile-band pairs for parallelization |
107 | 120 | tiles_bands <- tidyr::expand_grid( |
108 | 121 | tile = .cube_tiles(cube), |
|
126 | 139 | # select tile and band |
127 | 140 | tile_id <- tile_band[[1]] |
128 | 141 | band <- tile_band[[2]] |
129 | | - tile <- sits_select(cube, bands = band, tiles = tile_id) |
| 142 | + tile <- .select_raster_cube(cube, bands = band, tiles = tile_id) |
130 | 143 | # create a hash to store temporary samples file |
131 | 144 | hash_bundle <- digest::digest(list(tile, samples), algo = "md5") |
132 | 145 | filename <- .file_path( |
|
252 | 265 | hash_bundle <- purrr::map_chr(tiles_bands, function(tile_band) { |
253 | 266 | tile_id <- tile_band[[1]] |
254 | 267 | band <- tile_band[[2]] |
255 | | - tile <- sits_select(cube, bands = band, tiles = tile_id) |
| 268 | + tile <- .select_raster_cube(cube, bands = band, tiles = tile_id) |
256 | 269 | digest::digest(list(tile, samples), algo = "md5") |
257 | 270 | }) |
258 | 271 | # recreate file names to delete them |
|
308 | 321 | #' |
309 | 322 | #' @return A sits tibble with the average of all points by each polygon. |
310 | 323 | .data_avg_polygon <- function(data) { |
311 | | - bands <- sits_bands(data) |
| 324 | + bands <- .samples_bands(data) |
312 | 325 | columns_to_avg <- c(bands, "latitude", "longitude") |
313 | 326 | data_avg <- data |> |
314 | 327 | tidyr::unnest(cols = "time_series") |> |
|
351 | 364 | progress) { |
352 | 365 | .check_set_caller(".data_by_tile") |
353 | 366 | # Get cube timeline |
354 | | - tl <- sits_timeline(cube) |
| 367 | + tl <- .cube_timeline(cube)[[1]] |
355 | 368 | # Get tile-band combination |
356 | 369 | tiles_bands <- .cube_split_tiles_bands(cube = cube, bands = bands) |
357 | 370 | # Set output_dir |
|
371 | 384 | tile_id <- tile_band[[1]] |
372 | 385 | band <- tile_band[[2]] |
373 | 386 |
|
374 | | - tile <- sits_select( |
| 387 | + tile <- .select_raster_cube( |
375 | 388 | data = cube, |
376 | 389 | bands = c(band, cld_band), |
377 | 390 | tiles = tile_id |
|
508 | 521 | hash_bundle <- purrr::map_chr(tiles_bands, function(tile_band) { |
509 | 522 | tile_id <- tile_band[[1]] |
510 | 523 | band <- tile_band[[2]] |
511 | | - tile <- sits_select(cube, bands = c(band, cld_band), tiles = tile_id) |
| 524 | + tile <- .select_raster_cube(cube, bands = c(band, cld_band), |
| 525 | + tiles = tile_id |
| 526 | + ) |
512 | 527 | digest::digest(list(tile, samples), algo = "md5") |
513 | 528 | }) |
514 | 529 | # recreate file names to delete them |
|
550 | 565 | multicores, |
551 | 566 | progress) { |
552 | 567 | # Get cube timeline |
553 | | - tl <- sits_timeline(cube) |
| 568 | + tl <- .cube_timeline(cube)[[1]] |
554 | 569 | # transform sits tibble to sf |
555 | 570 | samples_sf <- sits_as_sf(samples) |
556 | 571 | # Get chunks samples |
|
571 | 586 | on.exit(.parallel_stop(), add = TRUE) |
572 | 587 | # Get the samples in parallel using tile-band combination |
573 | 588 | samples_tiles_bands <- .parallel_map(chunks_samples, function(chunk) { |
574 | | - tile <- sits_select( |
| 589 | + tile <- .select_raster_cube( |
575 | 590 | data = cube, |
576 | 591 | bands = c(bands, cld_band), |
577 | 592 | tiles = chunk[["tile"]] |
|
666 | 681 | # bind rows to get a melted tibble of samples |
667 | 682 | ts_tbl <- dplyr::bind_rows(samples_tiles_bands) |
668 | 683 | if (!.has_ts(ts_tbl)) { |
669 | | - warning(.conf("messages", ".get_data_by_chunks"), |
| 684 | + warning(.conf("messages", ".data_by_chunks"), |
670 | 685 | immediate. = TRUE, call. = FALSE |
671 | 686 | ) |
672 | 687 | return(.tibble()) |
|
705 | 720 | dplyr::ungroup() |
706 | 721 | # recreate hash values |
707 | 722 | hash_bundle <- purrr::map_chr(chunks_samples, function(chunk) { |
708 | | - tile <- sits_select( |
| 723 | + tile <- .select_raster_cube( |
709 | 724 | data = cube, |
710 | 725 | bands = c(bands, cld_band), |
711 | 726 | tiles = chunk[["tile"]] |
|
733 | 748 | } |
734 | 749 | return(ts_tbl) |
735 | 750 | } |
| 751 | +#' @title get time series from base tiles |
| 752 | +#' @name .data_base_tiles |
| 753 | +#' @keywords internal |
| 754 | +#' @noRd |
| 755 | +#' @param cube Data cube from where data is to be retrieved. |
| 756 | +#' @param samples Samples to be retrieved. |
| 757 | +#' @param ts_time Time series from multitemporal bands |
| 758 | +#' |
| 759 | +#' @return Time series information with base tile data |
| 760 | +#' |
| 761 | +.data_base_tiles <- function(cube, samples) { |
| 762 | + # retrieve values from samples |
| 763 | + # |
| 764 | + # read each tile |
| 765 | + samples <- slider::slide_dfr(cube, function(tile){ |
| 766 | + # get XY |
| 767 | + xy_tb <- .proj_from_latlong( |
| 768 | + longitude = samples[["longitude"]], |
| 769 | + latitude = samples[["latitude"]], |
| 770 | + crs = .cube_crs(tile) |
| 771 | + ) |
| 772 | + # join lat-long with XY values in a single tibble |
| 773 | + samples <- dplyr::bind_cols(samples, xy_tb) |
| 774 | + # filter the points inside the data cube space-time extent |
| 775 | + samples <- dplyr::filter( |
| 776 | + samples, |
| 777 | + .data[["X"]] > tile[["xmin"]], |
| 778 | + .data[["X"]] < tile[["xmax"]], |
| 779 | + .data[["Y"]] > tile[["ymin"]], |
| 780 | + .data[["Y"]] < tile[["ymax"]] |
| 781 | + ) |
| 782 | + |
| 783 | + # are there points to be retrieved from the cube? |
| 784 | + if (nrow(samples) == 0) { |
| 785 | + return(NULL) |
| 786 | + } |
| 787 | + # create a matrix to extract the values |
| 788 | + xy <- matrix( |
| 789 | + c(samples[["X"]], samples[["Y"]]), |
| 790 | + nrow = nrow(samples), |
| 791 | + ncol = 2 |
| 792 | + ) |
| 793 | + colnames(xy) <- c("X", "Y") |
| 794 | + |
| 795 | + # get the values of the time series as matrix |
| 796 | + base_bands <- .tile_base_bands(tile) |
| 797 | + samples <- purrr::map_dbl(base_bands, function(band){ |
| 798 | + values_base_band <- .tile_base_extract( |
| 799 | + tile = tile, |
| 800 | + band = band, |
| 801 | + xy = xy |
| 802 | + ) |
| 803 | + samples[[band]] <- values_base_band |
| 804 | + return(samples) |
| 805 | + }) |
| 806 | + return(samples) |
| 807 | + }) |
| 808 | +} |
| 809 | + |
0 commit comments