Skip to content

Commit 11b943d

Browse files
gilbertocamaragilbertocamara
committed
add MPC collections MOD10A1-6.1 and MOD09A1-6.1
1 parent b3fdc13 commit 11b943d

File tree

9 files changed

+237
-20
lines changed

9 files changed

+237
-20
lines changed

‎NAMESPACE

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -158,6 +158,8 @@ S3method(.source_item_get_bands,stac_cube)
158158
S3method(.source_item_get_cloud_cover,cdse_cube)
159159
S3method(.source_item_get_cloud_cover,sdc_cube)
160160
S3method(.source_item_get_cloud_cover,stac_cube)
161+
S3method(.source_item_get_date,"mpc_cube_mod09a1-6.1")
162+
S3method(.source_item_get_date,"mpc_cube_mod10a1-6.1")
161163
S3method(.source_item_get_date,"mpc_cube_mod13q1-6.1")
162164
S3method(.source_item_get_date,cdse_cube)
163165
S3method(.source_item_get_date,deafrica_cube)
@@ -175,7 +177,6 @@ S3method(.source_items_new,"deafrica_cube_sentinel-1-rtc")
175177
S3method(.source_items_new,"deafrica_cube_sentinel-2-l2a")
176178
S3method(.source_items_new,"mpc_cube_cop-dem-glo-30")
177179
S3method(.source_items_new,"mpc_cube_landsat-c2-l2")
178-
S3method(.source_items_new,"mpc_cube_mod13q1-6.1")
179180
S3method(.source_items_new,"mpc_cube_sentinel-1-grd")
180181
S3method(.source_items_new,"mpc_cube_sentinel-1-rtc")
181182
S3method(.source_items_new,"mpc_cube_sentinel-2-l2a")
@@ -184,6 +185,7 @@ S3method(.source_items_new,bdc_cube)
184185
S3method(.source_items_new,cdse_cube)
185186
S3method(.source_items_new,deafrica_cube)
186187
S3method(.source_items_new,hls_cube)
188+
S3method(.source_items_new,mpc_cube)
187189
S3method(.source_items_new,sdc_cube)
188190
S3method(.source_items_new,usgs_cube)
189191
S3method(.source_items_tile,"aws_cube_landsat-c2-l2")
@@ -192,6 +194,8 @@ S3method(.source_items_tile,"deafrica_cube_rainfall-chirps-daily")
192194
S3method(.source_items_tile,"deafrica_cube_rainfall-chirps-monthly")
193195
S3method(.source_items_tile,"mpc_cube_cop-dem-glo-30")
194196
S3method(.source_items_tile,"mpc_cube_landsat-c2-l2")
197+
S3method(.source_items_tile,"mpc_cube_mod09a1-6.1")
198+
S3method(.source_items_tile,"mpc_cube_mod10a1-6.1")
195199
S3method(.source_items_tile,"mpc_cube_mod13q1-6.1")
196200
S3method(.source_items_tile,"mpc_cube_sentinel-1-grd")
197201
S3method(.source_items_tile,"mpc_cube_sentinel-1-rtc")

‎R/api_source_mpc.R

Lines changed: 94 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -469,12 +469,12 @@
469469
#' @param platform Satellite platform (optional).
470470
#' @return An object referring the images of a sits cube.
471471
#' @export
472-
`.source_items_new.mpc_cube_mod13q1-6.1` <- function(source,
473-
collection,
474-
stac_query, ...,
475-
tiles = NULL,
476-
platform = NULL) {
477-
.check_set_caller(".source_items_new_mpc_cube_mod13q1-61")
472+
.source_items_new.mpc_cube <- function(source,
473+
collection,
474+
stac_query, ...,
475+
tiles = NULL,
476+
platform = NULL) {
477+
.check_set_caller(".source_items_new_mpc_cube")
478478
.check_that(is.null(tiles))
479479
if (.has(platform)) {
480480
platform <- .stac_format_platform(
@@ -605,6 +605,55 @@
605605
`.source_items_tile.mpc_cube_mod13q1-6.1` <- function(source,
606606
items, ...,
607607
collection = NULL) {
608+
# store tile info in items object
609+
items[["features"]] <- purrr::map(items[["features"]], function(feature) {
610+
h_tile <- feature[["properties"]][["modis:horizontal-tile"]]
611+
v_tile <- feature[["properties"]][["modis:vertical-tile"]]
612+
h_tile <- paste0("h", h_tile)
613+
v_tile <- paste0("v", v_tile)
614+
feature[["properties"]][["tile"]] <- paste0(h_tile, v_tile)
615+
616+
return(feature)
617+
})
618+
tile_name <- rstac::items_reap(items, field = c("properties", "tile"))
619+
}
620+
#' @title Organizes items for MPC MOD10A1 collections
621+
#' @param source Name of the STAC provider.
622+
#' @param items \code{STACItemcollection} object from rstac package.
623+
#' @param ... Other parameters to be passed for specific types.
624+
#' @param collection Collection to be searched in the data source.
625+
#' @return A list of items.
626+
#' @keywords internal
627+
#' @noRd
628+
#' @export
629+
`.source_items_tile.mpc_cube_mod10a1-6.1` <- function(source,
630+
items, ...,
631+
collection = NULL) {
632+
633+
# store tile info in items object
634+
items[["features"]] <- purrr::map(items[["features"]], function(feature) {
635+
h_tile <- feature[["properties"]][["modis:horizontal-tile"]]
636+
v_tile <- feature[["properties"]][["modis:vertical-tile"]]
637+
h_tile <- paste0("h", h_tile)
638+
v_tile <- paste0("v", v_tile)
639+
feature[["properties"]][["tile"]] <- paste0(h_tile, v_tile)
640+
641+
return(feature)
642+
})
643+
tile_name <- rstac::items_reap(items, field = c("properties", "tile"))
644+
}
645+
#' @title Organizes items for MPC MOD09A1 collections
646+
#' @param source Name of the STAC provider.
647+
#' @param items \code{STACItemcollection} object from rstac package.
648+
#' @param ... Other parameters to be passed for specific types.
649+
#' @param collection Collection to be searched in the data source.
650+
#' @return A list of items.
651+
#' @keywords internal
652+
#' @noRd
653+
#' @export
654+
`.source_items_tile.mpc_cube_mod09a1-6.1` <- function(source,
655+
items, ...,
656+
collection = NULL) {
608657

609658
# store tile info in items object
610659
items[["features"]] <- purrr::map(items[["features"]], function(feature) {
@@ -616,7 +665,7 @@
616665

617666
return(feature)
618667
})
619-
tile_names <- rstac::items_reap(items, field = c("properties", "tile"))
668+
tile_name <- rstac::items_reap(items, field = c("properties", "tile"))
620669
}
621670
#' @title Organizes items for MPC Landsat collections
622671
#' @param source Name of the STAC provider.
@@ -691,7 +740,7 @@
691740
tiles) {
692741
return(cube)
693742
}
694-
#' @title Get date from STAC item
743+
#' @title Get date from STAC item for MOD13Q1 collection
695744
#' @keywords internal
696745
#' @noRd
697746
#' @param source Data source
@@ -704,17 +753,43 @@
704753
item, ...,
705754
collection = NULL) {
706755

707-
modis_id <- item[["id"]]
708-
modis_id_parts <- unlist(strsplit(modis_id,
709-
split = ".",
710-
fixed = TRUE))
711-
datetime <- modis_id_parts[[2]]
712-
ymd <- substring(datetime, 2, 5) |>
713-
paste0("-01-01") |>
714-
lubridate::ymd()
715-
julian_days <- as.numeric(substring(datetime, 6, 8)) |>
716-
lubridate::ddays()
717-
date <- ymd + julian_days
756+
757+
datetime <- item[["properties"]][["start_datetime"]]
758+
date <- lubridate::as_date(datetime)
759+
}
760+
#' @title Get date from STAC item for MOD10A1
761+
#' @keywords internal
762+
#' @noRd
763+
#' @param source Data source
764+
#' @param item STAC item
765+
#' @param ... Additional parameters.
766+
#' @param collection Image collection
767+
#' @return List of dates
768+
#' @export
769+
`.source_item_get_date.mpc_cube_mod10a1-6.1` <- function(source,
770+
item, ...,
771+
collection = NULL) {
772+
773+
774+
datetime <- item[["properties"]][["start_datetime"]]
775+
date <- lubridate::as_date(datetime)
776+
}
777+
#' @title Get date from STAC item for MOD09A1
778+
#' @keywords internal
779+
#' @noRd
780+
#' @param source Data source
781+
#' @param item STAC item
782+
#' @param ... Additional parameters.
783+
#' @param collection Image collection
784+
#' @return List of dates
785+
#' @export
786+
`.source_item_get_date.mpc_cube_mod09a1-6.1` <- function(source,
787+
item, ...,
788+
collection = NULL) {
789+
790+
791+
datetime <- item[["properties"]][["start_datetime"]]
792+
date <- lubridate::as_date(datetime)
718793
}
719794
#' @title Check if roi or tiles are provided
720795
#' @param source Data source

‎R/sits_histogram.R

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -97,6 +97,7 @@ hist.raster_cube <- function(x, ...,
9797
r <- terra::rast(band_file)
9898
values <- terra::spatSample(r, size = size)
9999
values <- values * band_scale + band_offset
100+
colnames(values) <- band
100101

101102
density_plot <-
102103
values |>

‎inst/extdata/shapefiles/switzerland/ch.dbf

371 Bytes
Binary file not shown.

‎inst/extdata/shapefiles/switzerland/ch.prj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
GEOGCS["GCS_WGS_1984",DATUM["D_WGS_1984",SPHEROID["WGS_1984",6378137.0,298.257223563]],PRIMEM["Greenwich",0.0],UNIT["Degree",0.0174532925199433]]

‎inst/extdata/shapefiles/switzerland/ch.shp

11.9 KB
Binary file not shown.

‎inst/extdata/shapefiles/switzerland/ch.shx

108 Bytes
Binary file not shown.

‎inst/extdata/sources/config_source_mpc.yml

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,65 @@ sources:
6262
metadata_search : "tile"
6363
ext_tolerance: 0.01
6464
grid_system : "STG"
65+
MOD10A1-6.1 : &mpc_mod10a1
66+
bands :
67+
SNOW : &mpc_modis09_snow
68+
missing_value : -1000
69+
minimum_value : 0
70+
maximum_value : 100
71+
scale_factor : 0.003921569
72+
offset_value : 0
73+
resolution : 500
74+
band_name : "NDSI_Snow_Cover"
75+
data_type : "INT1U"
76+
ALBEDO :
77+
<<: *mpc_modis09_snow
78+
band_name : "Snow_Albedo_Daily_Tile"
79+
satellite : "TERRA"
80+
sensor : "MODIS"
81+
collection_name: "modis-10A1-061"
82+
open_data : true
83+
open_data_token: false
84+
metadata_search : "tile"
85+
ext_tolerance: 0.01
86+
grid_system : "STG"
87+
MOD09A1-6.1 : &mpc_mod09a1
88+
bands :
89+
BLUE : &mpc_modis_blue
90+
missing_value : -1000
91+
minimum_value : 0
92+
maximum_value : 10000
93+
scale_factor : 0.0001
94+
offset_value : 0
95+
resolution : 500
96+
band_name : "sur_refl_b03"
97+
data_type : "INT2S"
98+
RED :
99+
<<: *mpc_modis_blue
100+
band_name : "sur_refl_b01"
101+
GREEN :
102+
<<: *mpc_modis_blue
103+
band_name : "sur_refl_b04"
104+
NIR08 :
105+
<<: *mpc_modis_blue
106+
band_name : "sur_refl_b02"
107+
LWIR12 :
108+
<<: *mpc_modis_blue
109+
band_name : "sur_refl_b05"
110+
SWIR16 :
111+
<<: *mpc_modis_blue
112+
band_name : "sur_refl_b06"
113+
SWIR22 :
114+
<<: *mpc_modis_blue
115+
band_name : "sur_refl_b07"
116+
satellite : "TERRA"
117+
sensor : "MODIS"
118+
collection_name: "modis-09A1-061"
119+
open_data : true
120+
open_data_token: false
121+
metadata_search : "tile"
122+
ext_tolerance: 0.01
123+
grid_system : "STG"
65124
COP-DEM-GLO-30 :
66125
bands:
67126
ELEVATION:

‎tests/testthat/test-cube-mpc.R

Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -278,6 +278,83 @@ test_that("Creating cubes from MPC - MOD13Q1-6.1 based on ROI using sf object",
278278
tile_h13v10 <- .cube_filter_tiles(modis_cube, "h13v10")
279279
expect_equal(nrow(tile_h13v10), 1)
280280

281+
})
282+
test_that("Creating cubes from MPC - MOD09A1-6.1 based on ROI using sf object", {
283+
shp_file <- system.file(
284+
"extdata/shapefiles/mato_grosso/mt.shp",
285+
package = "sits"
286+
)
287+
sf_mt <- sf::read_sf(shp_file)
288+
# create a raster cube file based on the information about the files
289+
modis09a1_cube <- .try(
290+
{
291+
sits_cube(
292+
source = "MPC",
293+
collection = "MOD09A1-6.1",
294+
bands = c("BLUE", "RED", "GREEN"),
295+
roi = sf_mt,
296+
start_date = "2018-09-01",
297+
end_date = "2019-08-29",
298+
progress = FALSE
299+
)
300+
},
301+
.default = NULL
302+
)
303+
testthat::skip_if(purrr::is_null(modis09a1_cube),
304+
message = "MPC is not accessible"
305+
)
306+
expect_true(all(sits_bands(modis09a1_cube) %in% c("BLUE", "RED", "GREEN")))
307+
bbox <- sits_bbox(modis09a1_cube, as_crs = "EPSG:4326")
308+
bbox_shp <- sf::st_bbox(sf_mt)
309+
expect_lt(bbox["xmin"], bbox_shp["xmin"])
310+
expect_lt(bbox["ymin"], bbox_shp["ymin"])
311+
expect_gt(bbox["xmax"], bbox_shp["xmax"])
312+
expect_gt(bbox["ymax"], bbox_shp["ymax"])
313+
intersects <- .cube_intersects(modis09a1_cube, sf_mt)
314+
expect_true(all(intersects))
315+
316+
tile_h13v10 <- .cube_filter_tiles(modis09a1_cube, "h13v10")
317+
expect_equal(nrow(tile_h13v10), 1)
318+
319+
})
320+
test_that("Creating cubes from MPC - MOD10A1-6.1 based on ROI using sf object", {
321+
shp_file <- system.file(
322+
"extdata/shapefiles/switzerland/ch.shp",
323+
package = "sits"
324+
)
325+
sf_ch <- sf::read_sf(shp_file)
326+
# create a raster cube file based on the information about the files
327+
modis10a1_cube <- .try(
328+
{
329+
sits_cube(
330+
source = "MPC",
331+
collection = "MOD10A1-6.1",
332+
bands = c("SNOW", "ALBEDO"),
333+
roi = sf_ch,
334+
start_date = "2018-11-01",
335+
end_date = "2019-03-30",
336+
progress = FALSE
337+
)
338+
},
339+
.default = NULL
340+
)
341+
testthat::skip_if(purrr::is_null(modis10a1_cube),
342+
message = "MPC is not accessible"
343+
)
344+
expect_true(all(sits_bands(modis10a1_cube) %in% c("SNOW", "ALBEDO")))
345+
bbox <- sits_bbox(modis10a1_cube, as_crs = "EPSG:4326")
346+
bbox_shp <- sf::st_bbox(sf_ch)
347+
expect_lt(bbox["xmin"], bbox_shp["xmin"])
348+
expect_lt(bbox["ymin"], bbox_shp["ymin"])
349+
expect_gt(bbox["xmax"], bbox_shp["xmax"])
350+
expect_gt(bbox["ymax"], bbox_shp["ymax"])
351+
intersects <- .cube_intersects(modis10a1_cube, sf_ch)
352+
expect_true(all(intersects))
353+
354+
355+
tile_h18v4 <- .cube_filter_tiles(modis10a1_cube, "h18v4")
356+
expect_equal(nrow(tile_h18v4), 1)
357+
281358
})
282359
test_that("Accessing COP-DEM-30 from MPC",{
283360
cube_dem <- sits_cube(

0 commit comments

Comments
 (0)