Skip to content

Commit 757ee42

Browse files
cvitolocvitolo
committed
Updated website
1 parent 72afef9 commit 757ee42

27 files changed

+682
-258
lines changed

‎docs/LICENSE.html

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎docs/articles/GADM_2.8_ITA_adm0.rds

901 KB
Binary file not shown.

‎docs/articles/caliver_intro-vignette.R

Lines changed: 316 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,325 @@
11
## ----setup, include=FALSE------------------------------------------------
2-
knitr::opts_chunk$set(echo = TRUE,
3-
eval = FALSE)
2+
knitr::opts_chunk$set(echo = TRUE, eval = FALSE)
43

5-
## ---- echo = FALSE, eval = FALSE-----------------------------------------
6-
# # Is CDO installed?
7-
# Sys.which("cdo")[[1]]
4+
## ------------------------------------------------------------------------
5+
# # Install caliver from GitHub via devtools
6+
# install.packages("devtools")
7+
# devtools::install_github("ecmwf/caliver")
8+
9+
## ---- eval = TRUE--------------------------------------------------------
10+
library("caliver")
11+
12+
## ------------------------------------------------------------------------
13+
# # Get daily burned area maps from 2003 to 2015 (to be run in the console!)
14+
# BurnedAreas <- get_gfed4(start_date = "2003-01-01",
15+
# end_date = "2015-12-31",
16+
# temporal_resolution = "daily",
17+
# varname = "BurnedArea",
18+
# region = "GLOB")
819
#
9-
# # Is GDAL installed?
10-
# Sys.which("gdal")[[1]]
20+
# # The above can be saved as follows:
21+
# raster::writeRaster(BurnedAreas,
22+
# filename="BurnedArea.grd",
23+
# bandorder='BIL', overwrite=TRUE, progress = 'text')
24+
25+
## ---- echo = FALSE-------------------------------------------------------
26+
# # The above can be re-loaded as follows:
27+
# BurnedAreas <- raster::brick("BurnedArea.grd")
28+
29+
## ------------------------------------------------------------------------
30+
# # Get all the BasisRegions
31+
# BasisRegions <- get_gfed4(varname = "BasisRegions")
32+
33+
## ---- eval = TRUE--------------------------------------------------------
34+
# Europe
35+
Europe <- get_gfed4(varname = "BasisRegions", region = "EURO")
36+
37+
## ------------------------------------------------------------------------
38+
# # United Kingdom
39+
# UnitedK <- raster::getData(name = "GADM", country = "United Kingdom",
40+
# level = 0)
1141
#
12-
# # Is NetCDF installed?
13-
# Sys.which("netcdf4")[[1]]
42+
# # Spain
43+
# Spain <- raster::getData(name = "GADM", country = "Spain", level = 0)
44+
45+
## ---- eval = TRUE--------------------------------------------------------
46+
# Italy
47+
Italy <- raster::getData(name = "GADM", country = "Italy", level = 0)
48+
49+
## ------------------------------------------------------------------------
50+
# # Italian regions
51+
# Italy1 <- raster::getData(name = "GADM", country = "Italy", level = 1)
1452
#
15-
# # Is NCL installed?
16-
# Sys.which("ncl")[[1]]
53+
# # Get polygons for Liguria, Calabria and Sicily
54+
# Liguria <- Italy1[9,]
55+
# Calabria <- Italy1[4,]
56+
# Sicily <- Italy1[15,]
1757
#
18-
# setwd('/scratch/mo/moc0/fire/')
58+
# # Get polygon for the Province of Genoa
59+
# Italy2 <- raster::getData(name = "GADM", country = "Italy", level = 2)
60+
# Genoa <- Italy2[42,]
61+
62+
## ---- eval = TRUE--------------------------------------------------------
63+
geff5tar <- system.file(file.path("testdata", "geff5.tar"),
64+
package = "caliver")
65+
b <- import_geff_data_from_tar(archive = geff5tar)
66+
67+
## ------------------------------------------------------------------------
68+
# decompress_gz(input_dir = "./tmp")
69+
70+
## ------------------------------------------------------------------------
71+
# processingTime <- system.time({
72+
# stack_netcdf_files(input_dir = "./tmp", output_file = "FWI.nc")
73+
# })
74+
75+
## ------------------------------------------------------------------------
76+
# map <- get_percentile_raster(input_file = "FWI.nc", probs = 50)
77+
78+
## ---- eval = TRUE--------------------------------------------------------
79+
maps <- get_percentile_raster(r = b, probs = c(50, 75, 90))
80+
81+
## ---- eval = TRUE--------------------------------------------------------
82+
mapItaly <- mask_crop_subset(r = maps, p = Italy, idx = c(1, 3))
83+
84+
## ---- eval = TRUE, fig.width = 7-----------------------------------------
85+
# Use the raster plot method
86+
raster::plot(mapItaly, main = c("FWI 50th perc.", "FWI 90th perc."))
87+
88+
# Use the caliver plotPercentiles function
89+
plot_percentile_raster(maps = mapItaly, main = c("FWI 50th perc.", "FWI 90th perc."))
1990

20-
## ---- eval=FALSE---------------------------------------------------------
21-
# packs <- c("rgdal", "ncdf4", "ggplot2", "raster", "sp", "grDevices",
22-
# "RCurl", "rworldmap", "graphics", "httr", "stringr",
23-
# "lubridate", "rhdf5", "RColorBrewer", "dplyr", "ggmap",
24-
# "purrr", "viridis")
25-
# new.packages <- packs[!(packs %in% installed.packages()[,"Package"])]
26-
# if(length(new.packages)) install.packages(new.packages)
91+
## ---- eval = TRUE--------------------------------------------------------
92+
dataDates <- seq.Date(from = as.Date("1980-01-01"),
93+
to = as.Date("2016-12-31"),
94+
by = "day")
95+
96+
# Define a function to extract fire seasons in Europe
97+
seasons <- get_fire_season(dates = dataDates, zone = "north")
98+
99+
# Create an index of fire season dates
100+
fireSeasonIndex <- which(seasons == TRUE)
101+
102+
## ------------------------------------------------------------------------
103+
# # Load FWI dataset obtained previously
104+
# FWI <- raster::brick("FWI.nc")
105+
#
106+
# # Mask/Crop/Subset FWI over Europe
107+
# FWIEURO <- mask_crop_subset(r = FWI, p = Europe, idx = fireSeasonIndex)
108+
#
109+
# # Calculate levels
110+
# EuropeThr <- get_fire_danger_levels(fire_index = FWIEURO)
111+
#
112+
# # Country level: use a loop to calculate levels for all the countries in the EU:
113+
# # This does not take into account Greenland, Cyprus, Andorra and Luxembrourg.
114+
# EUcountries <- c("Austria", "Belgium", "Bulgaria", "Croatia",
115+
# "Czech Republic", "Denmark", "Estonia", "Finland", "France",
116+
# "Germany", "Greece", "Hungary", "Ireland", "Italy", "Latvia",
117+
# "Lithuania", "Luxembourg", "Malta", "Netherlands", "Poland",
118+
# "Portugal", "Romania", "Slovakia", "Slovenia", "Spain",
119+
# "Sweden", "United Kingdom")
120+
#
121+
# for (singleCountry in EUcountries){
122+
#
123+
# print(singleCountry)
124+
#
125+
# # Mask/Crop/Subset FWI and generate thresholds for singleCountry
126+
# singleCountryFWI <- mask_crop_subset(r = FWI,
127+
# p = raster::getData(name = "GADM",
128+
# country = singleCountry,
129+
# level = 0),
130+
# idx = fireSeasonIndex)
131+
# singleCountryThr <- get_fire_danger_levels(fire_index = singleCountryFWI)
132+
#
133+
# # Append values to data.frame
134+
# if (singleCountry == "Austria") {
135+
# df <- data.frame(matrix(singleCountryThr, nrow = 1))
136+
# }else{
137+
# df <- rbind(df, singleCountryThr)
138+
# }
139+
#
140+
# print(df)
141+
#
142+
# }
143+
#
144+
# EuroThr <- data.frame(cbind(EUcountries, df, stringsAsFactors=FALSE))
145+
# names(EuroThr) <- c("Country", "Low", "Moderate", "High", "VeryHigh", "Extreme")
146+
#
147+
# # Regional level
148+
# # Mask/Crop/Subset FWI and generate thresholds for Liguria
149+
# LIG <- mask_crop_subset(r = FWI, p = Liguria, idx = fireSeasonIndex)
150+
# EuroThr <- rbind(EuroThr, c("Liguria", get_fire_danger_levels(fire_index = LIG)))
151+
#
152+
# # Mask/Crop/Subset FWI and generate thresholds for Calabria
153+
# CAL <- mask_crop_subset(r = FWI, p = Calabria, idx = fireSeasonIndex)
154+
# EuroThr <- rbind(EuroThr, c("Calabria", get_fire_danger_levels(fire_index = CAL)))
155+
#
156+
# # Mask/Crop/Subset FWI and generate thresholds for Sicily
157+
# SIC <- mask_crop_subset(r = FWI, p = Sicily, idx = fireSeasonIndex)
158+
# EuroThr <- rbind(EuroThr, c("Sicily", get_fire_danger_levels(fire_index = SIC)))
159+
#
160+
# # Province level
161+
# # Mask/Crop/Subset FWI and generate thresholds for Genoa
162+
# GEN <- mask_crop_subset(r = FWI, p = Genoa, idx = fireSeasonIndex)
163+
# EuroThr <- rbind(EuroThr, c("Genoa", get_fire_danger_levels(fire_index = GEN)))
164+
#
165+
# # Remove NAs, e.g. Luxembourg and Malta are too small compared to the ratser resolution
166+
# EuroThr <- EuroThr[complete.cases(EuroThr),]
167+
#
168+
# EuroThr <- rbind(EuroThr, c("Europe", EuropeThr))
169+
#
170+
# # Save table with thresholds for future use
171+
# saveRDS(EuroThr, "EuroThr.rds")
172+
173+
## ------------------------------------------------------------------------
174+
# countryPDF <- plot_fire_pdf(fire_index = IT,
175+
# thresholds = EuroThr["Italy", ],
176+
# upper_limit = 75,
177+
# v_lines = c(0.50, 0.75, 0.90))
178+
179+
## ------------------------------------------------------------------------
180+
# library("pROC")
181+
#
182+
# BurnedAreas <- raster::brick("GFED4_BurnedAreas/BurnedArea.grd")
183+
#
184+
# # Mask and crop burned areas over Europe
185+
# BA <- mask_crop_subset(r = BurnedAreas, p = Europe)
186+
#
187+
# # If observations layers have no date, assign it!
188+
# dataDates <- seq.Date(from = as.Date("2003-01-01"),
189+
# to = as.Date("2015-12-31"), by = "day")
190+
# names(BA) <- dataDates
191+
#
192+
# EuroThrHigh <- as.numeric(EuroThr[EuroThr$Country == "Europe", 4])
193+
#
194+
# # The above can be saved and re-loaded as follows:
195+
# raster::writeRaster(BA, filename="BurnedAreaEurope.grd",
196+
# bandorder='BIL', overwrite=TRUE, progress = 'text')
197+
# BurnedAreaEurope <- raster::brick("BurnedAreaEurope.grd")
198+
#
199+
# # For the validation we do not want to subset over the fire season, subset to match days in BurnedAreaEurope
200+
# FWIEURO <- mask_crop_subset(r = FWI, p = Europe, idx = which(names(FWI) %in% names(BurnedAreaEurope)))
201+
# # The above can be saved and re-loaded as follows:
202+
# raster::writeRaster(FWIEURO, filename="FWIEURO.grd", bandorder='BIL', overwrite=TRUE, progress = 'text')
203+
# FWIEURO <- raster::brick("FWIEURO.grd")
204+
#
205+
# # Contingency table for JRC - Europe as a whole
206+
# x1 <- validate_fire_danger_levels(fire_index = FWIEURO, observation = BurnedAreaEurope,
207+
# fire_threshold = 21.3, obs_threshold = 50)
208+
# tab_x <- table(pred = x1$pred, obs = x1$obs)
209+
# hits <- tab_x[2,2]
210+
# misses <- tab_x[1,2]
211+
# correct_negatives <- tab_x[1,1]
212+
# false_alarms <- tab_x[2,1]
213+
# # POD 47%
214+
# round(hits/(hits+misses),2)*100
215+
# roc1 <- pROC::roc(response = x1$obs, predictor = x1$pred)
216+
# pROC::plot.roc(roc1, print.auc = pROC::auc(roc1), print.auc.x = 0, print.auc.y = 0.9)
217+
#
218+
# # Contingency table for caliver - Europe as a whole
219+
# x2 <- validate_fire_danger_levels(fire_index = FWIEURO, observation = BurnedAreaEurope,
220+
# fire_threshold = EuroThrHigh, obs_threshold = 50)
221+
# tab_x <- table(pred = x2$pred, obs = x2$obs)
222+
# hits <- tab_x[2,2]
223+
# misses <- tab_x[1,2]
224+
# # POD 65%
225+
# round(hits/(hits+misses),2)*100
226+
# roc2 <- pROC::roc(response = x2$obs, predictor = x2$pred)
227+
# pROC::plot.roc(roc2, col = "red", add = TRUE,
228+
# print.auc = pROC::auc(roc2), print.auc.x = 0, print.auc.y = 0.95,
229+
# print.auc.col = "red")
230+
#
231+
#
232+
# # Loop throught the countries
233+
# for (singleCountry in EuroThr[1:26,"Country"]){
234+
#
235+
# print(singleCountry)
236+
#
237+
# if (!(singleCountry %in% c("Cyprus"))){
238+
#
239+
# countryPoly <- raster::getData(name = "GADM", country = singleCountry, level = 0)
240+
# countryThr <- as.numeric(EuroThr[EuroThr$Country == singleCountry, 4])
241+
#
242+
# # Crop RasterBricks over country of interest
243+
# BA_country <- mask_crop_subset(r = BurnedAreaEurope, p = countryPoly)
244+
# FWI_country <- mask_crop_subset(r = FWIEURO, p = countryPoly)
245+
#
246+
# JRC <- validate_fire_danger_levels(fire_index = FWI_country,
247+
# observation = BA_country,
248+
# fire_threshold = 21.3,
249+
# obs_threshold = 50)
250+
# tab_JRC <- data.frame(table(JRC$pred, JRC$obs))
251+
# caliver1 <- validate_fire_danger_levels(fire_index = FWI_country,
252+
# observation = BA_country,
253+
# fire_threshold = EuroThrHigh,
254+
# obs_threshold = 50)
255+
# tab_caliver1 <- data.frame(table(caliver1$pred, caliver1$obs))
256+
# caliver2 <- validate_fire_danger_levels(fire_index = FWI_country,
257+
# observation = BA_country,
258+
# fire_threshold = countryThr,
259+
# obs_threshold = 50)
260+
# tab_caliver2 <- data.frame(table(caliver2$pred, caliver2$obs))
261+
#
262+
# if (singleCountry == "Austria") {
263+
# df_caliver1 <- df_caliver2 <- df_effis <- data.frame("pred" = tab_caliver1$pred, "obs" = tab_caliver1$obs)
264+
# i <- 3
265+
# }
266+
#
267+
# df_caliver1 <- cbind(df_caliver1, tab_caliver1$Freq)
268+
# names(df_caliver1)[i] <- singleCountry
269+
# df_caliver2 <- cbind(df_caliver2, tab_caliver2$Freq)
270+
# names(df_caliver2)[i] <- singleCountry
271+
# df_effis <- cbind(df_effis, tab_JRC$Freq)
272+
# names(df_effis)[i] <- singleCountry
273+
# i <- i + 1
274+
#
275+
# rm(countryPoly, countryThr, BA_country, FWI_country)
276+
#
277+
# }
278+
#
279+
# }
280+
#
281+
# # Save contingency tables
282+
# saveRDS(df_caliver1, "df_caliver1.rds")
283+
# saveRDS(df_caliver2, "df_caliver2.rds")
284+
# saveRDS(df_effis, "df_effis.rds")
285+
#
286+
# # Europe (EFFIS danger levels)
287+
# sum(df_effis[4,3:27]) # hits
288+
# sum(df_effis[3,3:27]) # misses
289+
# # Europe (averaged danger levels)
290+
# sum(df_caliver1[4,3:27]) # hits
291+
# sum(df_caliver1[3,3:27]) # misses
292+
# # Europe (country-specific danger levels)
293+
# sum(df_caliver2[4,3:27]) # hits
294+
# sum(df_caliver2[3,3:27]) # misses
295+
#
296+
# # UK (EFFIS danger levels)
297+
# df_effis[4, which(names(df_caliver2) == "United Kingdom")] # hits
298+
# df_effis[3, which(names(df_caliver2) == "United Kingdom")] # misses
299+
# # UK (EU averaged danger levels)
300+
# df_caliver1[4, which(names(df_caliver2) == "United Kingdom")] # hits
301+
# df_caliver1[3, which(names(df_caliver2) == "United Kingdom")] # misses
302+
# # UK (country-specific danger levels)
303+
# df_caliver2[4, which(names(df_caliver2) == "United Kingdom")] # hits
304+
# df_caliver2[3, which(names(df_caliver2) == "United Kingdom")] # misses
305+
#
306+
# # Spain (EFFIS danger levels)
307+
# df_effis[4, which(names(df_caliver2) == "Spain")] # hits
308+
# df_effis[3, which(names(df_caliver2) == "Spain")] # misses
309+
# # Spain (EU averaged danger levels)
310+
# df_caliver1[4, which(names(df_caliver2) == "Spain")] # hits
311+
# df_caliver1[3, which(names(df_caliver2) == "Spain")] # misses
312+
# # Spain (country-specific danger levels)
313+
# df_caliver2[4, which(names(df_caliver2) == "Spain")] # hits
314+
# df_caliver2[3, which(names(df_caliver2) == "Spain")] # misses
27315
#
28-
# # Install Bioconductor packages
29-
# devtools::install_github("Bioconductor-mirror/rhdf5")
316+
# # Italy (EFFIS danger levels)
317+
# df_effis[4, which(names(df_caliver2) == "Italy")] # hits
318+
# df_effis[3, which(names(df_caliver2) == "Italy")] # misses
319+
# # Italy (EU averaged danger levels)
320+
# df_caliver1[4, which(names(df_caliver2) == "Italy")] # hits
321+
# df_caliver1[3, which(names(df_caliver2) == "Italy")] # misses
322+
# # Italy (country-specific danger levels)
323+
# df_caliver2[4, which(names(df_caliver2) == "Italy")] # hits
324+
# df_caliver2[3, which(names(df_caliver2) == "Italy")] # misses
30325

0 commit comments

Comments
 (0)