-
Notifications
You must be signed in to change notification settings - Fork 43
/
Copy pathsen2r.R
3015 lines (2794 loc) · 119 KB
/
sen2r.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#' @title Find, download and preprocess Sentinel-2 images
#' @description The function is a wrapper to perform the entire
#' processing chain to find, download and pre-process Sentinel-2
#' data. Input is a set of parameters that can be passed with a
#' list or file (parameter `param_list`) or singularly (see the
#' descriptions of all the other parameters).
#' @param param_list (optional) List of input parameters:
#' it can be both an R list or the path of a JSON file.
#' If some parameters are passed both as elements of `param_list`
#' and as function arguments, the values passed as function
#' arguments are considered.
#' If some parameters are missing in `param_list` and are not
#' provided as arguments, default values will be used.
#' Use the function `s2_gui()` to create a complete list of
#' parameters.
#' If `param_list` is NULL (default), values given with the
#' parameters below (or default values for parameters not
#' provided) are used.
#' @param gui (optional) Logical: if TRUE, function `s2_gui()` is
#' launched before starting to process in order to set or load parameters;
#' if FALSE, the function uses parameters passed with `param_list` or
#' with other function arguments. Default is FALSE if `param_list` is not
#' NULL, TRUE elsewhere.
#' @param preprocess (optional) Logical: TRUE (default) to perform also
#' preprocessing steps, FALSE not to (do only find, download
#' and atmospheric correction).
#' @param s2_levels (optional) Character vector of length 1 or 2, with
#' Sentinel-2 levels required for processing steps or as output.
#' This parameter is used only if `preprocess = FALSE` (otherwise, the
#' required levels are derived from `list_prods`).
#' Accepted values: "l1c" and "l2a"; default: "l2a".
#' @param sel_sensor (optional) Character vector of length 1 or 2, with
#' Sentinel-2 sensors to be used.
#' Accepted values: "s2a" and "s2b"; default: c("s2a","s2b").
#' @param online (optional) Logical: TRUE (default) to search for available
#' products on SciHub and/or Google Cloud (and download if needed);
#' FALSE to work only with already downloaded SAFE products.
#' @param server (deprecate) Character vector of length 1, with the names of
#' the servers on which SAFE archives are searched.
#' Currently, only `"gcloud"` (Google Cloud) is supported.
#' Old `"scihub"` (ESA Sentinel Hub) can no more be used, since November 2023,
#' when the Copernicus Sentinel Data is no longer available and has been
#' replaced by the Copernicus Data Space Ecosystem.
#' See also the section "Details" of `s2_list()`.
#' @param order_lta (optional) Logical: TRUE (default) to order products from
#' the Long Term Archive if unavailable for direct download; FALSE to simply
#' skip them (this option has effect only in online mode).
#' It takes effect only if argument `server` includes `"scihub"`.
#' @param apihub _deprecated_
#' @param downloader (optional) Character value corresponding to the executable
#' which should be used to download SAFE products. It could be one among
#' `"builtin"` (default) and `"aria2"`.
#' If `aria2` is not installed, built-in method will be used instead.
#' It takes effect only if argument `server` includes `"scihub"`.
#' @param overwrite_safe (optional) Logical: TRUE to overwrite existing
#' products with products found online or manually corrected,
#' FALSE (default) to skip download and atmospheric correction for
#' products already existing.
#' @param rm_safe (optional) Character: should SAFE products be deleted after
#' preprocessing? "yes" (or "all") means to delete all SAFE; "no" (default)
#' not to delete; "l1c" to delete only Level-1C products.
#' @param step_atmcorr (optional) Character vector to determine how to obtain
#' Level-2A SAFE products:
#' * `"auto"` (default) means that L2A is first
#' searched on SciHub: if found, it is downloaded, if not, the
#' corresponding Level-1C is downloaded and sen2cor is used to
#' produce L2A;
#' * `"scihub"` means that Sen2Cor is always used from L1C products
#' downloaded from SciHub;
#' * `"l2a"` means that they are downloaded if available on SciHub,
#' otherwise they are skipped (sen2cor is never used).
#' @param sen2cor_use_dem (optional) Logical, determining if a DEM should be
#' used for topographic correction by Sen2Cor (see the documentation of
#' [sen2cor()] - argument `use_dem` for further details).
#' Currently the default value is NA in order to grant backward compatibility:
#' in this case, the option set in the XML GIPP configuration file
#' used by sen2r (stored in the default sen2r settings directory) is respected.
#'
#' _Note_: in a future release of sen2r, the default value will be
#' set to TRUE, so to grant homogeneity between Level-2A products downloaded
#' from ESA Hub and generated using Sen2Cor.
#' @param sen2cor_gipp (optional) Ground Image Processing Parameters (GIPP)
#' to be passed to Sen2Cor (see the documentation of `sen2cor()` - argument
#' `gipp` - for details about the usage of this argument).
#' Default value (NA) corresponds to an empty list of parameters.
#' @param max_cloud_safe (optional) Integer number (0-100) containing
#' the maximum cloud level of each SAFE to be considered (default: no filter).
#' It it used to limit the research of SAFE products to "good" images,
#' so it is applied only to non-existing archives (existing SAFE are always
#' used).
#' In this sense, this parameter is different from `max_mask`, which can be
#' used to set a maximum cloud coverage over output extents.
#' Notice also that this value is used to filter on the basis of the metadata
#' "Cloud cover percentage" associated to each SAFE, so it is not based
#' on the cloud mask defined with the processing options.
#' @param timewindow (optional) Temporal window for querying: Date object
#' of length 1 (single day) or 2 (time window). Default is NA, meaning that
#' no filters are used if online = FALSE, and all found images are processed;
#' if online = TRUE, last 90 days are processed.
#' Is it possible to pass also integer (or difftime) values, which are
#' interpreted as the last n days.
#' @param timeperiod (optional) Character:
#' * "full" (default) means that all
#' the images included in the time window are considered;
#' * "seasonal" means that only the single seasonal periods in the
#' window are used (i.e., with a time window from 2015-06-01 to
#' 2017-08-31, the periods 2015-06-01 to 2015-08-31, 2016-06-01
#' to 2016-08-31 and 2017-06-01 to 2017-08-31 are considered).
#' @param extent (optional) Spatial extent on which to clip products (it can
#' be both the path of a vector file or a geoJSON).
#' Default is NA for offline mode (meaning no extent:
#' all found tiles are entirely used); in online mode, a sample extent is used
#' as default.
#' @param extent_name (optional) Name of the area set as extent, to be used in
#' the output file names. Default is "sen2r" The name is an
#' alphanumeric string which cannot contain 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).
#' @param s2tiles_selected (optional) Character vector with the Sentinel-2
#' tiles to be considered (default is NA, meaning all the tiles).
#' @param s2orbits_selected (optional) Character vector with the Sentinel-2
#' orbits to be considered (still to be implemented; for now,
#' all the accepted values are listed).
#' @param list_prods (optional) Character vector with the values of the
#' products to be processed (accepted values: "TOA", "BOA", "SCL",
#' "TCI"). Default is no one (NA).
#' @param list_rgb (optional) Character vector with the values of the
#' RGB images to be produced.
#' Images are in the form RGBrgbx, where:
#' - x is B (if source is BOA) or T (is source is TOA);
#' - r g and b are the the number of the bands to be used respectively
#' for red, green and blue, in hexadecimal format.
#' Notice that this is the [actual number name of the bands](
#' https://sentinels.copernicus.eu/web/sentinel/user-guides/sentinel-2-msi/resolutions/spatial):
#' so, to use i.e. BOA band 11 (1610nm) use the value "b", even if band 11 is
#' the 10th band of a BOA product (because band 10 is missing).
#' (e.g., RGB432B, RGB843B)
#' Default is no one (NA).
#' @param list_indices (optional) Character vector with the values of the
#' spectral indices to be computed. Default is no one (NA).
#' @param index_source (optional) Character value: if "BOA" (default), indices
#' are computed from BOA values; if "TOA", non corrected reflectances
#' are instead used (be careful to use this setting!).
#' @param rgb_ranges (optional) Range of valid values to be used for RGB products.
#' Values must be provided in the same scale used within SAFE and BOA/TOA
#' products (0-10000, corresponding to reflectances * 10000).
#' If can be a 2-length integer vector (min-max for all the 3 bands) or a 6-length vector or
#' 3x2 matrix (min red, min green, min blue, max red, max green, max blue).
#' Default is to use c(0,2500) for bands 2, 3 and 4; c(0,7500) for other bands.
#' In case `list_rgb` is a vector of length > 1, `rgb_ranges` must be a list
#' of the same length (otherwise, the same range values will be used for all the RGB
#' products).
#' @param mask_type (optional) Character value which determines the categories
#' in the Surface Classification Map to be masked (see `s2_mask()`
#' for the accepted values). Default (NA) is not to mask.
#' @param max_mask (optional) Numeric value (range 0 to 100), which represents
#' the maximum percentage of allowed masked surface (by clouds or any other
#' type of mask chosen with argument `mask_type`) for producing outputs.
#' Images with a percentage of masked surface greater than `max_mask`%
#' are not processed (the list of expected output files which have not been
#' generated is returned as an attribute, named "skipped").
#' Default value is 100 (all products are produced).
#' This parameter is different from `max_cloud_safe`, because:
#' 1. it is computed over the selected extent;
#' 2. it is computed starting from the cloud mask defined as above.
#' Notice that the percentage is computed on non-NA values (if input images
#' had previously been clipped and masked using a polygon, the percentage is
#' computed on the surface included in the masking polygons).
#' @param mask_smooth (optional) Numeric positive value: the smoothing radius
#' (expressed in unit of measure of the output projection, typically metres)
#' to be applied to the cloud mask by function `s2_mask()`.
#' @param mask_buffer (optional) Numeric value: the buffering radius
#' (expressed in unit of measure of the output projection, typically metres)
#' to be applied to the cloud mask by function `s2_mask()`.
#' Default value (0) means that no buffer is applied; a positive value causes
#' an enlargement of the masked area; a negative value cause a reduction.
#' @param clip_on_extent (optional) Logical: if TRUE (default), output products
#' and indices are clipped to the selected extent (and resampled/reprojected);
#' if FALSE, the geometry and extension of the tiles is maintained.
#' @param extent_as_mask (optional) Logical: if TRUE, pixel values outside
#' the `extent` polygon are set to NA; if FALSE (default), all the values
#' within the bounding box are maintained.
#' @param reference_path (optional) Path of the raster file to be used as a
#' reference grid. If NA (default), no reference is used.
#' @param res (optional) Numeric vector of length 2 with the x-y resolution
#' for output products. Default (NA) means that the resolution
#' is kept as native.
#' @param res_s2 (optional) Character value corresponding to the native Sentinel-2
#' resolution to be used. Accepted values are "10m" (default), "20m"
#' and "60m".
#' @param unit (optional) Character value corresponding to the unit of measure
#' with which to interpret the resolution (for now, only "Meter" -
#' the default value - is supported).
#' @param proj (optional) Character string with the pro4string of the output
#' resolution. default value (NA) means not to reproject.
#' @param resampling (optional) Resampling method (one of the values supported
#' by `gdal_translate`: `"near"` (default), `"bilinear"`, `"cubic"`,
#' `"cubicspline"`, `"lanczos"`, `"average"` or `"mode"`).
#' @param resampling_scl (optional) Resampling method for categorical products
#' (for now, only SCL): one among `"near"` (default) and `"mode"`.
#' @param outformat (optional) Format of the output file (in a
#' format recognised by GDAL). Default is `"GTiff"`.
#' Value `"BigTIFF"` can be used to generate a GeoTIFF with the option BigTIFF
#' @param rgb_outformat (optional) Format of the output RGB products (in a
#' format recognised by GDAL). Default is `"GTiff"`.
#' @param index_datatype (optional) Numeric datatype of the output
#' spectral indices (see `s2_calcindices()`.
#' @param compression (optional) In the case GTiff is chosen as
#' output format, the compression indicated with this parameter is
#' used (default is "DEFLATE").
#' @param rgb_compression (optional) In the case `GTiff` is chosen as
#' output format for RGB products, the compression indicated
#' with this parameter is used (default is `"DEFLATE"`).
#' In the cases GTiff or JPEG are chosen as output format for RGB products,
#' this parameter can also be a 1-100 integer value, which is interpreted
#' as the compression level for a JPEG compression.
#' @param overwrite (optional) Logical value: should existing output
#' files be overwritten? (default: FALSE).
#' @param path_l1c (optional) Path of the directory in which Level-1C SAFE
#' products are searched and/or downloaded. If not provided (default), a
#' temporary directory is used.
#' @param path_l2a (optional) Path of the directory in which Level-2A SAFE
#' products are searched, downloaded and/or generated. If not provided
#' (default), a temporary directory is used.
#' @param path_tiles (optional) Path of the directory in which Sentinel-2
#' tiles (as generated by `s2_translate()`) are searched and/or generated.
#' If not provided (default), a temporary directory is used, and files
#' are generated as virtual rasters; otherwise, they are generated in
#' the format specified with `outformat` parameter.
#' @param path_merged (optional) Path of the directory in which Sentinel-2
#' tiles merged by orbit (as generated by `s2_merge()`) are searched and/or
#' generated.
#' If not provided (default), a temporary directory is used, and files
#' are generated as virtual rasters; otherwise, they are generated in
#' the format specified with `outformat` parameter.
#' @param path_out (optional) Path of the directory in which Sentinel-2
#' output products are searched and/or generated.
#' If not provided (default), a temporary directory is used.
#' @param path_rgb (optional) Path of the directory in RGB products
#' are searched and/or generated.
#' If not provided (default), `path_out` is used.
#' @param path_indices (optional) Path of the directory in which files of
#' spectral indices are searched and/or generated.
#' If not provided (default), `path_out` is used.
#' @param path_subdirs (optional) Logical: if TRUE (default), a directory
#' for each output product or spectral index is generated within
#' `path_tiles`, `path_merged`, `path_out` and `path_indices`; if FALSE,
#' products are put directly within them.
#' @param thumbnails (optional) Logical: if TRUE (default), a thumbnail is
#' added for each product created. Thumbnails are JPEG or PNG georeferenced
#' small images (width or height of 1024 pixels) with default colour palettes
#' (for more details, see the help window in the GUI). They are placed in
#' a subdirectory of the products names `"thumbnails"`.
#' If FALSE, they are not created.
#' @param parallel (optional) Logical or integer: setting to TRUE, the processing
#' is executed using multiple cores in order to speed up the execution.
#' Parallelisation is performed on groups of dates.
#' The number of cores is automatically determined; specifying it is also
#' possible (e.g. `parallel = 4`).
#' If FALSE (default), the processing chain is forced to run with a single core
#' (this can be useful if multiple `sen2r()` instances are run in parallel).
#' @param processing_order (optional) Character string:
#' order used to execute the processing chain (this affects the speed
#' of computation and the usage of system resources).
#' Values can be one of the followings:
#' - `"4"` or `"by_groups"` (default):
#' it provides a good compromise between processing speed and disk usage.
#' Processing is done as follows:
#' 1. the list of required SAFE and output product names is computed;
#' 2. the required dates are grouped in $g$ groups, where
#' $g$ is the number of dates divided by the number of CPU;
#' 3. groups are then processed sequentially; for each group:
#' - the required SAFE archives are downloaded;
#' - Sen2Cor is applied in parallel using one core per L1C SAFE archive;
#' - the remaining processing operations are executed using parallel
#' R sessions (one core for each date).
#' - `"2"` or `"by_date"`:
#' this allows minimising the requirements of disk usage
#' (in particular if SAFE archives are deleted after processing).
#' It is similar to the default execution, but each group is composed
#' by a single date: so the disk space occupied by SAFE archives
#' and temporary files is lower,
#' but it is generally slower than the default one because
#' parallel computation over dates for products' generation is not possible.
#' - `"3"` or `"mixed"`:
#' this allows maximising CPU usage and processing speed.
#' The cycle on groups is ignored, and all the required SAFE are
#' first of all downloaded and/or produced, and then dates are
#' processed in parallel.
#' This mode is faster than the default mode, but it requires
#' all SAFE archives to be downloaded and processed before performing
#' subsequent steps, thus increasing disk space requirements.
#' - `"1"` or `"by_step"`:
#' this is the legacy mode, in which the cycle on groups is ignored
#' as well as the parallel computation over dates.
#' All SAFE archives are first downloaded/processed,
#' then the processing steps are performed sequentially.
#' This mode is similar to the previous one in terms of disk usage
#' but it is slightly slower; its advantage are the lower RAM requirements.
#' @param use_python Deprecated argument
#' @param tmpdir (optional) Path where intermediate files will be created.
#' Default is a temporary directory (unless `outformat = "VRT"`: in this case,
#' default is a subdirectory named ".vrt" within `path_out`).
#' @param rmtmp (optional) Logical: should temporary files be removed?
#' (Default: TRUE). `rmtmp` is forced to `FALSE` if `outformat = "VRT"`.
#' @param log (optional) Character string with the path where the package
#' messages will be redirected.
#' Default (NA) is not to redirect (use standard output).
#' A two-length character with two paths (which can also coincide)
#' can be used to redirect also the output: in this case, the first path
#' is the path for messages, the second one for the output.
#' @return A vector with the paths of the files which were created (excluded
#' the temporary files); NULL otherwise.
#' The vector includes some attributes:
#' - `cloudcovered` with the list of images not created due to the higher
#' percentage of cloud covered pixels;
#' - `missing` with the list of images not created due to other reasons;
#' - `procpath` with the path of a json parameter file, created after each
#' `sen2r()` run, containing the parameters used in the execution of the
#' function;
#' - `ltapath` with the path of a json file containing the list of the
#' SAFE Sentinel-2 archives eventually ordered in Long Term Archive.
#' - `status` with a data.frame summarising the status of the processing (see
#' `sen2r_process_report()`).
#'
#' @import data.table
#' @importFrom utils packageVersion
#' @importFrom geojsonio geojson_json
#' @importFrom jsonlite fromJSON toJSON
#' @importFrom foreach foreach "%do%" "%dopar%"
#' @importFrom sf st_as_sfc st_cast st_centroid st_combine st_coordinates
#' st_intersects st_is_valid st_make_valid st_polygon st_sfc st_transform st_union
#' @importFrom methods formalArgs is as
#' @importFrom stats na.omit setNames
#' @export
#' @author Luigi Ranghetti, phD (2020)
#' @author Lorenzo Busetto, phD (2020)
#' @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{10.1016/j.cageo.2020.104473}, URL: \url{https://sen2r.ranghetti.info/}.
#' @note License: GPL 3.0
#' @examples
#' \donttest{
#' # Open an interactive section
#' if (interactive()) {
#' sen2r()
#' }
#'
#' # Launch a processing from a saved JSON file (here we use an internal function
#' # to create a testing json file - this is not intended to be used by final users)
#' json_path <- build_example_param_file()
#'
#' if (is_gcloud_configured()) {
#' out_paths_2 <- sen2r(json_path)
#' } else {
#' out_paths_2 <- character(0)
#' }
#' # Notice that passing the path of a JSON file results in launching
#' # a session without opening the gui, unless gui = TRUE is passed.
#'
#' # Launch a processing using function arguments
#' safe_dir <- file.path(dirname(attr(load_binpaths(), "path")), "safe")
#' out_dir_3 <- tempfile(pattern = "Barbellino_")
#' if (is_gcloud_configured()) {
#' out_paths_3 <- sen2r(
#' gui = FALSE,
#' server = "gcloud",
#' step_atmcorr = "l2a",
#' extent = system.file("extdata/vector/barbellino.geojson", package = "sen2r"),
#' extent_name = "Barbellino",
#' timewindow = as.Date("2020-08-01"),
#' list_prods = c("TOA","BOA","SCL","OAA"),
#' list_indices = c("NDVI","MSAVI2"),
#' list_rgb = c("RGB432T", "RGB432B", "RGB843B"),
#' mask_type = "cloud_medium_proba",
#' max_mask = 80,
#' path_l1c = safe_dir,
#' path_l2a = safe_dir,
#' path_out = out_dir_3
#' )
#' } else {
#' out_paths_3 <- character(0)
#' }
#'
#' if (is_gcloud_configured()) {
#'
#' # Show outputs (loading thumbnails)
#'
#' # Generate thumbnails names
#' thumb_3 <- file.path(dirname(out_paths_3), "thumbnails", gsub("tif$", "jpg", basename(out_paths_3)))
#' thumb_3[grep("SCL", thumb_3)] <-
#' gsub("jpg$", "png", thumb_3[grep("SCL", thumb_3)])
#'
#' oldpar <- par(mfrow = c(1,2), mar = rep(0,4))
#' image(stars::read_stars(thumb_3[grep("BOA", thumb_3)]), rgb = 1:3, useRaster = TRUE)
#' image(stars::read_stars(thumb_3[grep("SCL", thumb_3)]), rgb = 1:3, useRaster = TRUE)
#'
#' par(mfrow = c(1,2), mar = rep(0,4))
#' image(stars::read_stars(thumb_3[grep("MSAVI2", thumb_3)]), rgb = 1:3, useRaster = TRUE)
#' image(stars::read_stars(thumb_3[grep("NDVI", thumb_3)]), rgb = 1:3, useRaster = TRUE)
#'
#' par(mfrow = c(1,2), mar = rep(0,4))
#' image(stars::read_stars(thumb_3[grep("RGB432B", thumb_3)]), rgb = 1:3, useRaster = TRUE)
#' image(stars::read_stars(thumb_3[grep("RGB843B", thumb_3)]), rgb = 1:3, useRaster = TRUE)
#'
#' par(oldpar)
#'
#' }
#' }
#'
#' \dontrun{
#'
#' # Launch a processing based on a JSON file, but changing some parameters
#' # (e.g., the same processing on a different extent)
#' out_dir_4 <- tempfile(pattern = "Scalve_")
#' out_paths_4 <- sen2r(
#' param_list = json_path,
#' extent = system.file("extdata/vector/scalve.kml", package = "sen2r"),
#' extent_name = "Scalve",
#' path_out = out_dir_4
#' )
#'
#' }
sen2r <- function(param_list = NULL,
gui = NA,
preprocess = TRUE,
s2_levels = "l2a",
sel_sensor = c("s2a","s2b"),
online = TRUE,
server = "gcloud",
order_lta = TRUE,
apihub = NA,
downloader = "builtin",
overwrite_safe = FALSE,
rm_safe = "no",
step_atmcorr = "auto",
sen2cor_use_dem = NA,
sen2cor_gipp = NA,
max_cloud_safe = 100,
timewindow = NA,
timeperiod = "full",
extent = NA, # below re-defined as sample extent if online mode
extent_name = "sen2r",
s2tiles_selected = NA, # below re-defined for online mode
s2orbits_selected = NA, # temporary select all orbits (TODO implement)
list_prods = NA,
list_rgb = NA,
list_indices = NA,
index_source = "BOA",
rgb_ranges = NA,
mask_type = NA,
max_mask = 100,
mask_smooth = 0,
mask_buffer = 0,
clip_on_extent = TRUE,
extent_as_mask = FALSE,
reference_path = NA,
res = NA,
res_s2 = "10m",
unit = "Meter",
proj = NA,
resampling = "near",
resampling_scl = "near",
outformat = "GTiff",
rgb_outformat = "GTiff",
index_datatype = "Int16",
compression = "DEFLATE",
rgb_compression = "90",
overwrite = FALSE,
path_l1c = NA,
path_l2a = NA,
path_tiles = NA,
path_merged = NA,
path_out = NA,
path_rgb = NA,
path_indices = NA,
path_subdirs = TRUE,
thumbnails = TRUE,
parallel = FALSE,
processing_order = "by_groups",
use_python = NA,
tmpdir = NA,
rmtmp = TRUE,
log = NA) {
# sink to external files
if (!is.na(log[2])) {
dir.create(dirname(log[2]), showWarnings=FALSE)
sink(log[2], split = TRUE, type = "output", append = TRUE)
}
if (!is.na(log[1])) {
dir.create(dirname(log[1]), showWarnings=FALSE)
logfile_message = file(log[1], open = "a")
sink(logfile_message, type="message")
}
# filter names of passed arguments
sen2r_args <- formalArgs(.sen2r)
sen2r_args <- sen2r_args[!sen2r_args %in% c(".only_list_names", "globenv")]
pm_arg_passed <- logical(0)
for (i in seq_along(sen2r_args)) {
pm_arg_passed[i] <- !do.call(missing, list(sen2r_args[i]))
}
# environment to store internal_log variable
sen2r_env <- new.env()
# launch the function
names_out_created <- .sen2r(
param_list = param_list,
pm_arg_passed = pm_arg_passed,
gui = gui,
preprocess = preprocess,
s2_levels = s2_levels,
sel_sensor = sel_sensor,
online = online,
server = server,
order_lta = order_lta,
apihub = apihub,
downloader = downloader,
overwrite_safe = overwrite_safe,
rm_safe = rm_safe,
step_atmcorr = step_atmcorr,
sen2cor_use_dem = sen2cor_use_dem,
sen2cor_gipp = sen2cor_gipp,
max_cloud_safe = max_cloud_safe,
timewindow = timewindow,
timeperiod = timeperiod,
extent = extent,
extent_name = extent_name,
s2tiles_selected = s2tiles_selected,
s2orbits_selected = s2orbits_selected,
list_prods = list_prods,
list_rgb = list_rgb,
list_indices = list_indices,
index_source = index_source,
rgb_ranges = rgb_ranges,
mask_type = mask_type,
max_mask = max_mask,
mask_smooth = mask_smooth,
mask_buffer = mask_buffer,
clip_on_extent = clip_on_extent,
extent_as_mask = extent_as_mask,
reference_path = reference_path,
res = res,
res_s2 = res_s2,
unit = unit,
proj = proj,
resampling = resampling,
resampling_scl = resampling_scl,
outformat = outformat,
rgb_outformat = rgb_outformat,
index_datatype = index_datatype,
compression = compression,
rgb_compression = rgb_compression,
overwrite = overwrite,
path_l1c = path_l1c,
path_l2a = path_l2a,
path_tiles = path_tiles,
path_merged = path_merged,
path_out = path_out,
path_rgb = path_rgb,
path_indices = path_indices,
path_subdirs = path_subdirs,
thumbnails = thumbnails,
parallel = parallel,
processing_order = processing_order,
use_python = use_python,
tmpdir = tmpdir,
rmtmp = rmtmp,
log = log,
globenv = sen2r_env,
.only_list_names = FALSE
)
# stop sinking
# n_sink_output <- sink.number("output")
# while (n_sink_output > 0) {
# sink(type = "output")
# n_sink_output <- sink.number("output")
# }
# n_sink_message <- sink.number("message")
# while (n_sink > 2) {
# sink(type = "message"); close(logfile_message)
# n_sink_message <- sink.number("message")
# }
if (!is.na(log[2])) {
sink(type = "output")
}
if (!is.na(log[1])) {
sink(type = "message"); close(logfile_message)
}
if (!is.null(sen2r_env$internal_log)) {
sink(type = "message")
sen2r_env$internal_log <- NULL
}
return(invisible(names_out_created))
}
# Internal function, which is the "real" sen2r() function insider the use of sink
# (this workaround was used in order to manage final sink() in those cases
# in which return() is used inside the function.)
# TODO: manage also errors (.sen2r inside a trycatch; in case of errors, stop
# passing the error message)
.sen2r <- function(param_list,
pm_arg_passed, # TODO workaround ($473), fix
gui,
preprocess,
s2_levels,
sel_sensor,
online,
server,
order_lta,
apihub,
downloader,
overwrite_safe,
rm_safe,
step_atmcorr,
sen2cor_use_dem,
sen2cor_gipp,
max_cloud_safe,
timewindow,
timeperiod,
extent,
extent_name,
s2tiles_selected,
s2orbits_selected,
list_prods,
list_rgb,
list_indices,
index_source,
rgb_ranges,
mask_type,
max_mask,
mask_smooth,
mask_buffer,
clip_on_extent,
extent_as_mask,
reference_path,
res,
res_s2,
unit,
proj,
resampling,
resampling_scl,
outformat,
rgb_outformat,
index_datatype,
compression,
rgb_compression,
overwrite,
path_l1c,
path_l2a,
path_tiles,
path_merged,
path_out,
path_rgb,
path_indices,
path_subdirs,
thumbnails,
parallel,
processing_order,
use_python = NA,
tmpdir,
rmtmp,
log,
globenv,
.only_list_names = FALSE) {
# to avoid NOTE on check
. <- sensing_datetime <- creation_datetime <- mission <- level <- id_orbit <-
id_tile <- name <- id_baseline <- prod_type <- name <- sel_group_A <-
i_group_A <- sel_apihub_path <- i_group_B <- sensing_date <- lta <-
centroid_x <- centroid_y <- res_type <-path <- footprint <- sel_out <-
NULL
### Preliminary settings ###
# # If it is the first time that the package is used,
# # ask for opening the GUI to install dependencies
# if (interactive() & !file.exists(attr(load_binpaths(), "path"))) {
# open_check_gui <- NA
# while(is.na(open_check_gui)) {
# open_check_gui_prompt <- print_message(
# type="waiting",
# "It seems you are running this package for the first time. ",
# "Do you want to verify/install the required dependencies using a GUI ",
# "(otherwise, an automatic check will be performed)? \n(y/n) "
# )
# open_check_gui <- if (grepl("^[Yy]",open_check_gui_prompt)) {
# TRUE
# } else if (grepl("^[Nn]",open_check_gui_prompt)) {
# FALSE
# } else {
# NA
# }
# }
# if (open_check_gui) {
# check_sen2r_deps()
# print_message(
# type="message",
# "Dependencies checked; please restart sen2r() now."
# )
# return(invisible(NULL))
# }
# }
# Starting execution
print_message(
type = "message",
date = TRUE,
"#### Starting sen2r execution. ####\n"
)
# # import python modules
# # check that python and the required modules are installed
# if (use_python == TRUE) {
# py <- init_python()
# }
# Do not use the {s2} spherical geometry package (to avoid errors)
# (when the interface between {sf} and {s2} will be stable, this should be removed)
if (requireNamespace("sf", quietly = TRUE)) {
try({
invisible(capture.output(sf_use_s2_prev <- sf::sf_use_s2(FALSE)))
on.exit(invisible(capture.output(sf::sf_use_s2(sf_use_s2_prev))))
}, silent = TRUE)
}
## 1. Read / import parameters ##
# Read arguments with default values
pm_def <- formals(sen2r::sen2r) # use "sen2r" instead of ".sen2r" because this one has no defaults
# select arguments which are not parameters
pm_def <- sapply(pm_def[!names(pm_def) %in% c("param_list","gui","use_python","tmpdir","rmtmp")], eval)
# filter names of passed arguments
sen2r_args <- formalArgs(.sen2r)
# FIXME $473 pm_arg_passed computed in the main function (otherwise nothing was missing).
# This is not elegant, find a better way to do it.
# pm_arg_passed <- logical(0)
# for (i in seq_along(sen2r_args)) {
# pm_arg_passed[i] <- !do.call(missing, list(sen2r_args[i]))
# }
# Read arguments with passed values
pm_arg <- sapply(sen2r_args[pm_arg_passed], function(x){
do.call(get, list(x))
}, simplify=FALSE)
# select arguments which are not parameters
pm_arg <- pm_arg[!names(pm_arg) %in% c("param_list","gui","use_python","tmpdir","rmtmp")]
# Import param_list, if provided
pm_list <- if (is(param_list, "character")) {
# load json parameter file
jsonlite::fromJSON(param_list)
# TODO check package version and parameter names
} else if (is(param_list, "list")) {
param_list
# TODO check parameter names
} else {
list("pkg_version" = packageVersion("sen2r"))
}
# Create the ultimate parameter list (pm):
# based on pm_def, overwrite first with pm_list and then with pm_arg
pm <- pm_def
pm[names(pm_list)] <- pm_list
pm[names(pm_arg)] <- pm_arg
# if gui argument was not specified, use default value
if (is.na(gui)) {
gui <- if (is.null(param_list)) {TRUE} else {FALSE}
}
# Check parameters
suppressWarnings(suppressMessages({
pm <- check_param_list(
pm,
type = if (gui) {"message"} else {"error"},
check_paths = FALSE, correct = TRUE
)
}))
# Check param_list version
if (is.null(pm_list$pkg_version)) {
if (!is.null(pm_list$fidolasen_version)) {
pm_list$pkg_version <- pm_list$fidolasen_version
} else {
pm_list$pkg_version <- package_version("0.2.0")
}
}
if (packageVersion("sen2r") > package_version(pm_list$pkg_version)) {
if (interactive() & !gui) {
open_gui <- NA
while(is.na(open_gui)) {
open_gui_prompt <- print_message(
type="waiting",
"\nThe parameter file was created with an old version of the package: ",
"would you like to open a GUI and check that the input parameters are correct? (y/n)\n",
# "Note that continuing without checking them could lead to errors.\n",
"Alternatively, press ESC to interrupt and check the parameter file manually."
)
open_gui <- if (grepl("^[Yy]",open_gui_prompt)) {
gui <- TRUE
TRUE
} else if (grepl("^[Nn]",open_gui_prompt)) {
FALSE
} else {
NA
}
}
} else {
print_message(
type="warning",
"The parameter file was created with an old version of the package ",
"(this could lead to errors)."
)
}
}
## Open GUI (if required)
pm_prev <- pm # used to check if the log was added in the GUI
if (gui==TRUE) {
print_message(
type = "message",
date = TRUE,
"Launching GUI..."
)
pm <- .s2_gui(pm, par_fun = "sen2r")
if (is.null(pm)) {
print_message(
type = "message",
date = TRUE,
"Program interrupted by the user (GUI closed)."
)
sen2r_output <- character(0)
attr(sen2r_output, "status") <- data.frame(completed = FALSE)
return(invisible(sen2r_output))
}
print_message(
type = "message",
date = TRUE,
"Gui closed by the user. Starting processing."
)
}
## Check consistency of parameters
pm <- check_param_list(pm, type = "error", check_paths = TRUE, correct = TRUE)
# if ONLINE check internet connection and scihub/gcloud credentials
if (pm$online == TRUE & "gcloud" %in% pm$server) {
if (!check_gcloud_connection()) {
print_message(
type = "error",
"Impossible to reach the Sentinel-2 bucket on Google Cloud ",
"(internet connection may be down)."
)
}
}
if (pm$online == TRUE & "scihub" %in% pm$server) {
if (!check_scihub_connection()) {
print_message(
type = "error",
"Impossible to reach the SciHub server ",
"(internet connection or SciHub may be down)."
)
}
}
# Automatically save the JSON of the parameters used for the current chain
outpm_dir <- file.path(dirname(attr(load_binpaths(), "path")), "proc_par")
dir.create(outpm_dir, showWarnings = FALSE)
outpm_path <- file.path(
outpm_dir,
strftime(Sys.time(), format = "s2proc_%Y%m%d_%H%M%S.json")
)
pm_exported <- pm[!names(pm) %in% c(".only_list_names", "globenv")]
if (inherits(pm$extent, "sf") | inherits(pm$extent, "sfc")) {
pm_exported$extent <- geojson_json(
st_transform(pm$extent, 4326),
pretty = TRUE
)
}
if (inherits(pm$pkg_version, "numeric_version")) {
pm_exported$pkg_version <- as.character(pm$pkg_version)
}
writeLines(toJSON(pm_exported, pretty = TRUE), outpm_path)
attr(pm, "outpath") <- outpm_path
# Add output attribute related to parameter json
out_attributes <- list() # initialise sen2r_output attributes
out_attributes[["procpath"]] <- attr(pm, "outpath")
# Set log variables
# stop logging if it was already going on
# start logging in case it was defined / redefined in the GUI
if (all(is.na(pm_prev$log), length(nn(pm$log))>0, !is.na(pm$log))) {
if (!is.na(pm$log[1]) & is.na(pm_prev$log[1])) {
print_message(
type = "message",
"Output messages are redirected to log file \"",pm$log[1],"\"."
)
dir.create(dirname(pm$log[1]), showWarnings=FALSE)
logfile_message = file(pm$log[1], open = "a")
sink(logfile_message, type="message")
assign("internal_log", pm$log[1], envir = globenv) # workaround to stop sinking in the external function
}
}
rm(pm_prev)
# define log variables
.log_message <- pm$log[1]
.log_output <- pm$log[2]
# check extent_name
if (grepl("^[0-9A-Z]{5}$",extent_name)) {
print_message(
type = "error",
"\"extent_name\" cannot have the same structure of a tile ID ",
"(two numeric and by three uppercase character values)."
)
} else if (grepl("^[0-9A-Z]{5}[a-z]$",extent_name)) {
print_message(
type = "error",
"\"extent_name\" cannot have the same structure of a tile ID ",
"(two numeric and by three uppercase character values)",
"followed by a lowercase letter."
)
} else if (grepl("[\\.\\_]",extent_name)) {
print_message(
type = "error",
"\"extent_name\" cannot contain points nor underscores."
)
}
# check and manage parallel (workaroud)
# TODO add parallel to the GUI, and threat as a normal parameter
if (is.null(pm$parallel)) {pm$parallel <- parallel}
if (is.null(pm$processing_order)) {pm$processing_order <- processing_order}
# determine if parallelisation muts be applied to groups or to steps
if (pm$preprocess == FALSE & !pm$processing_order %in% c(1,"by_step")) {
print_message(
type = "warning",
"Only processing_order = \"by_step\" is accepted if preprocess = FALSE."
)
pm$processing_order <- "by_step"
}
if (!pm$processing_order %in% c(
1,"by_step",
2,"by_date",
3,"mixed",
4,"by_groups"
)) {
print_message(
type = "warning",
"processing_order = \"",pm$processing_order,"\"not recognised, ",
"using default \"by_step\"."
)
pm$processing_order <- "by_step"
}
# here defined:
# parallel_steps: related to internal parallelisation of functions
# parallel_groups_A: related to "level 1" (download, sen2cor, processing) parallelisation
# parallel_groups_B: related to "level 2" (processing) parallelisation of each group_A
if (pm$parallel == TRUE | is.numeric(pm$parallel)) {
if (pm$processing_order %in% c(1,"by_step", 2,"by_date")) {
parallel_groups_A <- FALSE
parallel_groups_B <- FALSE
parallel_steps <- pm$parallel
} else if (pm$processing_order %in% c(3,"mixed", 4,"by_groups")) {
parallel_groups_A <- FALSE
parallel_groups_B <- pm$parallel
parallel_steps <- FALSE
}
} else {
parallel_groups_A <- FALSE
parallel_groups_B <- FALSE
parallel_steps <- FALSE
}
# define and create tmpdir
if (is.na(tmpdir)) {
# if outformat is VRT, set as a subdirectory of path_out
tmpdir <- if (
pm$outformat == "VRT" &
!all(is.na(pm[c("path_out","path_rgb","path_indices","path_tiles","path_merged")]))
) {