Version 1.3.9.9001 (#358)

_This is a candidate release, which for now is not moved to CRAN for now because performed changes could have undesired effects._ ## Minor changes - Manage images split in two SAFE products (#353). - Do not return error in tests in case of SciHub server down (#354). ## Changes in default values - Pixels outside footprints (because of previous point, or - more frequently - because outside orbits coverage) are always set to NA even if no cloud masking is performed. - `s2_download()` no more uses existing SAFE products instead than downloading new equivalent ones (this in order to manage images split in two SAFE archives).
ranghetti · Nov 9, 2020 · d641315 · d641315
1 parent d05824b
commit d641315
Show file tree

Hide file tree

Showing 29 changed files with 844 additions and 148 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: sen2r
 Type: Package
 Title: Find, Download and Process Sentinel-2 Data
-Version: 1.3.9
+Version: 1.3.9.9001
 Authors@R: c(person("Luigi", "Ranghetti",
                     email = "[email protected]",
                     role = c("aut", "cre"),
@@ -61,5 +61,5 @@ SystemRequirements: GDAL (>= 2.1.2), PROJ (>= 4.9.1), GEOS (>= 3.4.2),
   Cairo, Curl, NetCDF, jq, Protocol Buffers, V8, OpenSSL, Libxml2.
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Language: en-GB
diff --git a/NAMESPACE b/NAMESPACE
@@ -111,6 +111,7 @@ importFrom(sf,st_as_sfc)
 importFrom(sf,st_as_text)
 importFrom(sf,st_bbox)
 importFrom(sf,st_cast)
+importFrom(sf,st_centroid)
 importFrom(sf,st_collection_extract)
 importFrom(sf,st_combine)
 importFrom(sf,st_convex_hull)

diff --git a/R/add_tile_suffix.R b/R/add_tile_suffix.R
@@ -0,0 +1,106 @@
+#' @title Add/remove suffixes for split tiles
+#' @description `add_tile_suffix()` adds specific suffixes to tile IDs
+#'  in order to distinguish tiled filenames referring to different original
+#'  SAFE products.
+#' @details In some sporadic cases, a tiled Sentinel-2 image is split in two 
+#'  SAFE products (see e.g. products
+#'  [`S2A_MSIL1C_20200408T101021_N0209_R022_T32TNL_20200408T153254`](https://storage.cloud.google.com/gcp-public-data-sentinel-2/tiles/32/T/NL/S2A_MSIL1C_20200408T101021_N0209_R022_T32TNL_20200408T153254.SAFE/GRANULE/L1C_T32TNL_A025044_20200408T101022/QI_DATA/T32TNL_20200408T101021_PVI.jp2) and
+#'  [`S2A_MSIL1C_20200408T101021_N0209_R022_T32TNL_20200408T171107`](https://storage.cloud.google.com/gcp-public-data-sentinel-2/tiles/32/T/NL/S2A_MSIL1C_20200408T101021_N0209_R022_T32TNL_20200408T171107.SAFE/GRANULE/L1C_T32TNL_A025044_20200408T101923/QI_DATA/T32TNL_20200408T101021_PVI.jp2)).
+#'  This split, probably a consequence of the division of the whole orbit image, 
+#'  creates ambiguity in the association among SAFE images and `sen2r` products,
+#'  since the sen2r naming convention is not sufficient to manage them as separate
+#'  products.
+#'  So, in the definition of the filenames of intermediate tiled products
+#'  (output of `s2_translate()`) it is necessary to add a suffix to be able to
+#'  manage them separately and then merge them in `s2_merge()`.
+#'  A lowercase letter ("a" and "b", but potentially "a" to "z") is used.
+#'  Functions `add_tile_suffix()` and `remove_tile_suffix()` are used in the
+#'  `sen2r()` main code as a workaround.
+#' @param paths Paths of the input tiled products
+#' @param suffix Character (1-length): if provided, the specified suffix is
+#'  appended to the tile ID of each path;
+#'  if not provided (default), a sequential suffix is appended only to the tile 
+#'  ID of the duplicated paths.
+#' @return The input paths with/without the tile suffix.
+#'
+#' @author Luigi Ranghetti, phD (2020) \email{luigi@@ranghetti.info}
+#' @references L. Ranghetti, M. Boschetti, F. Nutini, L. Busetto (2020).
+#'  "sen2r": An R toolbox for automatically downloading and preprocessing 
+#'  Sentinel-2 satellite data. _Computers & Geosciences_, 139, 104473. DOI: 
+#'  \href{https://doi.org/10.1016/j.cageo.2020.104473}{10.1016/j.cageo.2020.104473}, 
+#'  URL: \url{http://sen2r.ranghetti.info/}.
+#' @note License: GPL 3.0
+#' @examples
+#' safe_names <- c(
+#'   "S2A_MSIL2A_20200408T101021_N0214_R022_T32TNK_20200408T175711.SAFE",
+#'   "S2A_MSIL2A_20200408T101021_N0214_R022_T32TNL_20200408T175711.SAFE",
+#'   "S2A_MSIL2A_20200408T101021_N0214_R022_T32TNL_20200408T161405.SAFE"
+#' )
+#' prod_names <- safe_shortname(safe_names, ext = ".tif", allow_duplicated = TRUE)
+#' ( prod_names_univoc <- sen2r:::add_tile_suffix(prod_names) )
+#' ( prod_names_custom <- sen2r:::add_tile_suffix(prod_names, "a") )
+#' sen2r:::remove_tile_suffix(prod_names_univoc)
+
+add_tile_suffix <- function(paths, suffix) {
+  if (missing(suffix)) {
+    # Default behaviour: add default suffixes to duplicated paths
+    for (sel_upath in names(table(paths))[table(paths)>1]) {
+      n_paths <- sum(paths==sel_upath)
+      paths[paths==sel_upath] <- sapply(seq_len(n_paths), function(i) {
+        gsub(
+          "(S2[AB][12][AC]\\_[0-9]{8}\\_[0-9]{3})\\_([0-9]{2}[A-Z]{3})\\_([^\\_\\.]+\\_[126]0\\.?[^\\_]*$)",
+          paste0("\\1_\\2",letters[i],"_\\3"),
+          sel_upath
+        )
+      })
+    }
+    paths
+  } else {
+    # Custom behaviour: add specific suffix to all the paths
+    gsub(
+      "(S2[AB][12][AC]\\_[0-9]{8}\\_[0-9]{3})\\_([0-9]{2}[A-Z]{3})\\_([^\\_\\.]+\\_[126]0\\.?[^\\_]*$)",
+      paste0("\\1_\\2",suffix,"_\\3"),
+      paths
+    )
+  }
+}
+
+
+#' @name remove_tile_suffix
+#' @rdname add_tile_suffix
+#' @description `remove_tile_suffix()` removes existing suffixes from tile IDs.
+
+remove_tile_suffix <- function(paths) {
+  accepted_suffixes <- "[a-z]?" # Define here the accepted suffixes
+  sapply(paths, function(p) {
+    gsub(
+      paste0(
+        "(S2[AB][12][AC]\\_[0-9]{8}\\_[0-9]{3})\\_([0-9]{2}[A-Z]{3})",
+        accepted_suffixes,
+        "\\_([^\\_\\.]+\\_[126]0\\.?[^\\_]*$)"
+      ),
+      "\\1_\\2_\\3",
+      p
+    )
+  }, simplify = TRUE, USE.NAMES = FALSE)
+}
+
+
+#' @name extract_tile_suffix
+#' @rdname add_tile_suffix
+#' @description `extract_tile_suffix()` extracts suffixes from input paths.
+
+extract_tile_suffix <- function(paths) {
+  accepted_suffixes <- "[a-z]?" # Define here the accepted suffixes
+  sapply(paths, function(p) {
+    gsub(
+      paste0(
+        "^.*S2[AB][12][AC]\\_[0-9]{8}\\_[0-9]{3}\\_[0-9]{2}[A-Z]{3}",
+        "(",accepted_suffixes,")",
+        "\\_[^\\_\\.]+\\_[126]0\\.?[^\\_]*$"
+      ),
+      "\\1",
+      p
+    )
+  }, simplify = TRUE, USE.NAMES = FALSE)
+}
diff --git a/R/compute_s2_paths.R b/R/compute_s2_paths.R
@@ -382,7 +382,7 @@ compute_s2_paths <- function(pm,
   # tiles
   if (steps_todo["tiles"]) {
     exp_paths[["tiles"]] <- sapply(list_prods, function(prod){
-      remove_duplicates(nn(
+      nn(
         unlist(c(
           sapply(
             if (prod %in% l1c_prods) {file.path(pm$path_l1c,names(s2_list_l1c))} else
@@ -414,8 +414,14 @@ compute_s2_paths <- function(pm,
           ),
           exi_paths$tiles[[prod]]
         ))
-      ))
+      )
     }, simplify = FALSE, USE.NAMES = TRUE)
+    # Add suffixes in case of splitted tiles (#353)
+    if (any(duplicated(exp_paths[["tiles"]][[1]]))) {
+      exp_paths[["tiles"]] <- sapply(exp_paths[["tiles"]], function(p) {
+        add_tile_suffix(p)
+      }, simplify = FALSE, USE.NAMES = TRUE)
+    }
   }
 
   # merged
@@ -810,7 +816,7 @@ compute_s2_paths <- function(pm,
             level,"_",
             strftime(sensing_date,"%Y%m%d"),"_",
             id_orbit,"_",
-            "[0-9]{2}[A-Z]{3}_",
+            "[0-9]{2}[A-Z]{3}[a-z]?_",
             prod,"_",
             substr(res,1,2),".",
             out_ext[output_dep["merged"]]
@@ -850,10 +856,25 @@ compute_s2_paths <- function(pm,
         "[126]0\\.",
         out_ext["tiles"]
       )]
+      # add proper suffixes in case of multiple SAFE for the same date-tile (#353)
+      if (any(duplicated(tiles_basenames_av))) {
+        for (sel_basename_av in names(table(tiles_basenames_av))[table(tiles_basenames_av)>1]) {
+          tiles_basenames_av[tiles_basenames_av==sel_basename_av] <- sapply(
+            letters[seq_len(sum(tiles_basenames_av==sel_basename_av))], 
+            function(l) {
+              gsub(
+                "_([0-9]{2}[A-Z]{3})_", 
+                paste0("_\\1",l,"_"), 
+                sel_basename_av
+              )
+            }
+          )
+        }
+      }
       list(
         "L1C" = file.path(
           pm$path_l1c,
-          names(s2_list_l1c)[unlist(
+          basename(names(s2_list_l1c))[unlist(
             lapply(
               tiles_basenames_av[safe_dt_av$level=="1C"],
               function(x){length(grep(x,unlist(new_paths[["tiles"]]))) > 0}
@@ -862,7 +883,7 @@ compute_s2_paths <- function(pm,
         ),
         "L2A" = file.path(
           pm$path_l2a,
-          names(s2_list_l2a)[unlist(
+          basename(names(s2_list_l2a))[unlist(
             lapply(
               tiles_basenames_av[safe_dt_av$level=="2A"],
               function(x){length(grep(x,unlist(new_paths[["tiles"]]))) > 0}

diff --git a/R/s2_download.R b/R/s2_download.R
@@ -120,6 +120,9 @@ s2_download <- function(
   s2_prodlist <- as(s2_prodlist, "safelist")
   # TODO add input checks
   s2_meta <- safe_getMetadata(s2_prodlist, info = "nameinfo")
+  # if (!is.null(attr(s2_prodlist, "footprint"))) {
+  #   s2_meta[,footprint:=attr(s2_prodlist, "footprint")]
+  # }
 
   # check input server
   s2_server <- ifelse(
@@ -232,6 +235,15 @@ s2_download <- function(
   # to avoid NOTE on check
   i <- mission <- level <- sensing_datetime <- id_orbit <- id_tile <- NULL
 
+  # Check connection
+  if (!check_scihub_connection()) {
+    print_message(
+      type = "error", 
+      "Impossible to reach the SciHub server ",
+      "(internet connection or SciHub may be down)." 
+    )
+  }
+
   # read credentials
   if (length(s2_prodlist) > 0) {
     creds <- read_scihub_login(apihub)
@@ -261,15 +273,25 @@ s2_download <- function(
     zip_path <- file.path(outdir, paste0(names(s2_prodlist[i]),".zip"))
     safe_path <- gsub("\\.zip$", "", zip_path)
 
-    # regular expression to detect if equivalent products already exist
-    safe_regex <- s2_meta[i,paste0(
-      "^S",mission,"\\_MSIL",level,"\\_",strftime(sensing_datetime,"%Y%m%dT%H%M%S"),
-      "\\_N[0-9]{4}\\_R",id_orbit,"\\_T",id_tile,"\\_[0-9]{8}T[0-9]{6}\\.SAFE$"
-    )]
-    safe_existing <- list.files(dirname(zip_path), safe_regex, full.names = TRUE)
+    # # regular expression to detect if equivalent products already exist
+    # safe_regex <- s2_meta[i,paste0(
+    #   "^S",mission,"\\_MSIL",level,"\\_",strftime(sensing_datetime,"%Y%m%dT%H%M%S"),
+    #   "\\_N[0-9]{4}\\_R",id_orbit,"\\_T",id_tile,"\\_[0-9]{8}T[0-9]{6}\\.SAFE$"
+    # )]
+    # safe_existing <- list.files(dirname(zip_path), safe_regex, full.names = TRUE)
+    # safe_existing <- safe_existing[safe_isvalid(safe_existing)]
+
+    # if footprint exists, check if existing SAFEs are actually equivalent
+    if (!is.null(s2_meta$footprint)) {
+      safe_existing_footprint <- safe_getMetadata(safe_existing, "footprint")
+      safe_existing_centroid <- st_centroid(st_transform(st_as_sfc(safe_existing_footprint, crs = 4326), 3857))
+      safe_centroid <- st_centroid(st_transform(st_as_sfc(s2_meta[i,footprint], crs = 4326), 3857))
+      centroid_distance <- st_distance(safe_existing_centroid, safe_centroid)[1,1]
+      # TODO
+    }
+
+    if (any(overwrite == TRUE, !dir.exists(safe_path))) {
 
-    if (any(overwrite == TRUE, length(safe_existing) == 0)) {
-
       print_message(
         type = "message",
         date = TRUE,
@@ -335,8 +357,8 @@ s2_download <- function(
         suppressWarnings(file.remove(paste0(zip_path,".aria2")))
         print_message(
           type = "error",
-          "Download of file", link, "failed more than 10 times. ",
-          "Internet connection or SciHub may be down."
+          "Download of file", link, "failed more than 10 times ",
+          "(internet connection or SciHub may be down)."
         )
       } else {
         # check md5
@@ -383,19 +405,21 @@ s2_download <- function(
       }
 
     } else {
-      
+
       print_message(
         type = "message",
         date = TRUE,
         "Skipping Sentinel-2 image ", i,
         " of ",length(s2_prodlist)," ",
         "since the corresponding folder already exists."
       )
+
 
-      safe_existing_meta <- safe_getMetadata(safe_existing, info = "nameinfo")
-      safe_newname <- safe_existing_meta$name[
-        order(nn(safe_existing_meta$creation_datetime), decreasing = TRUE)[1]
-        ]
+      # safe_existing_meta <- safe_getMetadata(safe_existing, info = "nameinfo")
+      # safe_newname <- safe_existing_meta$name[
+      #   order(nn(safe_existing_meta$creation_datetime), decreasing = TRUE)[1]
+      #   ]
+      safe_newname <- basename(safe_path)
 
     }
 

diff --git a/R/s2_gui.R b/R/s2_gui.R
@@ -3272,7 +3272,9 @@ s2_gui <- function(param_list = NULL,
           "Enter an alphanumeric label, which cannot contain spaces, points",
           "nor underscores, and that cannot be a five-length string with",
           "the same structure of a tile ID",
-          "(two numeric and three uppercase character values).",
+          "(two numeric and three uppercase character values),",
+          "nor a six-length string with the structure of a tile ID",
+          "followed by a lowercase letter.",
           "The label can not be empty.",
           "This label is used in the output file names."
         ),

diff --git a/R/s2_list.R b/R/s2_list.R
@@ -63,7 +63,7 @@
 #' @importFrom methods is
 #' @importFrom sf st_as_sfc st_sfc st_point st_as_text st_bbox st_coordinates
 #'  st_geometry st_intersection st_geometry st_convex_hull st_transform st_cast
-#'  st_union st_simplify
+#'  st_union st_simplify st_centroid
 #' @importFrom httr RETRY authenticate content
 #' @importFrom XML htmlTreeParse saveXML xmlRoot
 #' @importFrom utils head read.table
@@ -306,7 +306,7 @@ s2_list <- function(spatial_extent = NULL,
   if (nrow(out_dt) == 0) {return(as(setNames(character(0), character(0)), "safelist"))}
   # compute date (to ignore duplicated dates)
   out_dt[,date := as.Date(substr(as.character(out_dt$sensing_datetime), 1, 10))]
-
+  
   if (nrow(out_dt) == 0) {return(as(setNames(character(0), character(0)), "safelist"))}
   out_names <- names(out_dt)
   # first, order by level (L2A, then L1C) and ingestion time (newers first)
@@ -322,7 +322,13 @@ s2_list <- function(spatial_extent = NULL,
     out_dt <- out_dt[grepl("^2Ap?$", level),]
   } # for level = "auto", do nothing because unuseful products are filtered below
   # filter (univocity)
-  out_dt <- out_dt[,head(.SD, 1), by = .(date, id_tile, id_orbit)]
+  suppressWarnings({
+    out_dt[,centroid:=st_centroid(st_as_sfc(footprint, crs = 4326))]
+  })
+  out_dt <- out_dt[,head(.SD, 1), by = .(
+    date, id_tile, id_orbit, 
+    apply(round(st_coordinates(centroid), 2), 1, paste, collapse = " ")
+  )]
   out_dt <- out_dt[,out_names,with=FALSE]
   if (nrow(out_dt) == 0) {return(as(setNames(character(0), character(0)), "safelist"))}
   out_dt <- out_dt[order(sensing_datetime),]