Skip to content

Commit c458605

Browse files
fpirottifpirotti
committed
new open meteo api
1 parent dcf57a8 commit c458605

7 files changed

Lines changed: 386 additions & 215 deletions

File tree

‎R/run_cell2fire.R‎

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -294,10 +294,8 @@ run_cell2fire <- function(
294294
}
295295

296296
if (dry) {
297-
message("Dry run complete. Returning arguments..... " )
298-
299-
message(paste(c(basename(c2f_bin_path), cli_args), collapse = " ") )
300-
return(paste(c(getwd(), " -- ", basename(c2f_bin_path), cli_args), collapse = " "))
297+
message("Dry run complete. Returning arguments..... " )
298+
return(paste(c(basename(c2f_bin_path), cli_args), collapse = " "))
301299
}
302300

303301
cat(paste("Executing:", c2f_bin_path, paste(cli_args, collapse = "\n")), file="mylog4.log")
@@ -321,8 +319,7 @@ run_cell2fire <- function(
321319

322320
}, error = function(e) {
323321

324-
if (dry) {
325-
322+
if (dry) {
326323
message("ERR Dry run complete. Returning arguments.")
327324
stop(errorCondition("Error preparing simulation:", e$message))
328325
} else {

‎inst/app/functions_server.R‎

Lines changed: 84 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -188,6 +188,8 @@ readGrids <- function(filepath, force=F ){
188188
} else {
189189
filepathn <- filepath
190190
}
191+
filepathn <- str_sort(filepathn, numeric = TRUE)
192+
191193
timesSteps <- as.integer(gsub("[^0-9]", "", basename(filepathn)) ) +1
192194
if(!file.exists(filepathn[[1]])){
193195
return((paste0(
@@ -218,12 +220,12 @@ readGrids <- function(filepath, force=F ){
218220

219221
if(file.exists(rdapath)){
220222
load(rdapath)
221-
weatherTimestamps[[as.character(simNumber)]] <- terra::time(fire_stack)
223+
# weatherTimestamps[[as.character(simNumber)]] <- terra::time(fire_stack)
222224
} else {
223225
weatherTimestamps <- list()
224226
weatherTimestamps[[as.character(simNumber)]] <- terra::time(fire_stack)
227+
save(weatherTimestamps, file=rdapath)
225228
}
226-
save(weatherTimestamps, file=rdapath)
227229
return( paste0("Grids ",basename(output_tif)," already processed!"))
228230
}
229231

@@ -234,7 +236,7 @@ readGrids <- function(filepath, force=F ){
234236
burnArea <- rep(0, length(filepathn))
235237

236238
vectsList <- list()
237-
239+
showNotification("Starting conversion to vector areas...", duration = 10)
238240
raster_list <- lapply(filepathn, function(file) {
239241
# fread is fast enough to handle the wide columns
240242
mat <- as.matrix(fread(file, header = FALSE,
@@ -247,7 +249,15 @@ readGrids <- function(filepath, force=F ){
247249

248250
# 3. Apply it to the raster
249251
r <- rast(mat, extent=ext, crs=crs )
250-
252+
# 1. Convert your terra SpatRaster to a stars object
253+
# r_stars <- stars::st_as_stars(r)
254+
# # 2. Convert to polygons using 8-connectivity (diagonal connections allowed)
255+
# ff <- st_as_sf(r_stars, as_points = FALSE, merge = TRUE, connect8 = T)
256+
# plot(ff)
257+
# browser()
258+
# 3. If you need it back as a terra SpatVector:
259+
# p_smooth_terra <- vect(p_smooth)
260+
251261
p <-as.polygons(r, dissolve = TRUE)
252262

253263
ff <- st_as_sf(p)
@@ -271,50 +281,10 @@ readGrids <- function(filepath, force=F ){
271281
fire_vect <- do.call(rbind, vectsList)
272282

273283
names(fire_stack) <- tools::file_path_sans_ext(basename(filepathn))
284+
times <- getDateTimeFromCSV(file.path(input$outputInstanceFolder, "Weather.csv"))
274285

275-
276-
wf <- read.csv(
277-
file.path(input$outputInstanceFolder, "Weather.csv")
278-
)
279-
datecol <- grep("date", names(wf))
280-
281-
if(length(datecol)==1){
282-
283-
raw_ts <- gsub("[^0-9]", "", wf[,datecol])
284-
clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d%H%M%S")
285-
if(anyNA(clean_ts)) clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d%H%M")
286-
if(anyNA(clean_ts)) clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d%H")
287-
if(anyNA(clean_ts)) clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d")
288-
if(anyNA(clean_ts)) {
289-
showNotification(
290-
"Sorry, we did find a column named '",
291-
names(wf)[[datecol]] ,"' but we could not convert
292-
its contents to a time stamp using our heuristics.
293-
<br> The following timestamps formats are recognized:
294-
<br>2023-07-07 16:00:00
295-
<br>2023-07-07 16:00
296-
<br>2023-07-07 16
297-
<br>2023-07-07", type="info", duration=10, id="datecolumnMixMatch" )
298-
299-
terra::time(fire_stack) <- 1:length(filepathn)
300-
fire_vect$Date <- terra::time(fire_stack)
301-
302-
} else {
303-
td <-diff(clean_ts[1:2])
304-
times <- c(clean_ts[[1]]-td,
305-
clean_ts,
306-
clean_ts[[length(clean_ts)]]+td )
307-
308-
terra::time(fire_stack) <- times[timesSteps]
309-
310-
fire_vect$Date <- terra::time(fire_stack)
311-
}
312-
313-
} else {
314-
terra::time(fire_stack) <- 1:length(filepathn)
315-
fire_vect$Date <- terra::time(fire_stack)
316-
}
317-
286+
terra::time(fire_stack) <- times[timesSteps]
287+
fire_vect$Date <- terra::time(fire_stack)
318288
fire_vect$simNumber <- simNumber
319289
fire_vect$simInstance <- basename(input$outputInstanceFolder)
320290

@@ -392,4 +362,71 @@ checkIgnitionFile <- function(ignfile){
392362
)
393363
}
394364
return(TRUE)
365+
}
366+
367+
368+
369+
370+
371+
parse_fire_log <- function(log_text) {
372+
373+
# 1. Read all lines into a character vector
374+
lines <- log_text
375+
376+
# 2. Find the row indices (line numbers) for the data we want
377+
sim_indices <- grep("Simulation \\d+ Start:", lines)
378+
weatherFiles <- trimws(sub(".*weather file:\\s*", "", lines[sim_indices+1]))
379+
ignitionsN <- as.integer(gsub("\\D+", "", lines[sim_indices]))
380+
381+
Map(getDateTimeFromCSV, weatherFiles)
382+
383+
if(anyNA(ignitionsN)){
384+
stop(errorCondition("We have NAs in simulation start ignition iterations!"))
385+
}
386+
387+
ign_cells <- trimws(gsub("ignition cell: ", "", lines[sim_indices+2]))
388+
389+
burnt_indices <- grep("^Simulation\\s+\\d+\\s+Results:", lines)
390+
burnt_ignitionsN <- as.numeric(str_extract(lines[burnt_indices ], "\\d+"))
391+
burnt_indicesClean <- burnt_indices[which(!duplicated(burnt_ignitionsN))]
392+
burnt_ignitionsNClean <- burnt_ignitionsN[which(!duplicated(burnt_ignitionsN))]
393+
394+
burnt_tables <- Map(function(x){
395+
x <- which(burnt_ignitionsNClean==x)
396+
indices <- (burnt_indicesClean[[x]]+3) : (burnt_indices[[x]]+7)
397+
data_lines <- lines[ indices ]
398+
data_lines <- gsub("^\t", "", data_lines)
399+
data_lines_csv <- gsub(" {2,}", ",", data_lines)
400+
df <- read.csv(text = data_lines_csv, header = FALSE)
401+
colnames(df) <- c("Cell Status", "Count", "Percent")
402+
403+
kable(df, format = "html", table.attr = "class='table table-striped table-condensed table-sm'")
404+
405+
},
406+
ignitionsN
407+
)
408+
# df <- data.frame(simulation = sim_indices,
409+
# ignitionsN = ignitionsN,
410+
# ign_cells=ign_cells)
411+
# 4. Bind them into a data frame
412+
413+
dd <- list(
414+
simulation = as.integer(ignitionsN),
415+
ignition_cell = as.integer(ign_cells),
416+
burnt_cells = as.character(burnt_tables)
417+
)
418+
419+
if(length(unique(sapply(dd, length)))!=1 || length(dd$simulation)==0){
420+
showNotification(
421+
paste0(
422+
"
423+
<br>Number of simulations: ", length(dd$simulation) ,". ",
424+
"
425+
<br>Number of ignition cells: ", length(dd$ignition_cell), ". ",
426+
"
427+
<br>Number of burnt cells values: ", length(dd$burnt_cells), ". <br>"
428+
), type="warning", duration=19 )
429+
}
430+
431+
dd
395432
}

‎inst/app/global.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -264,7 +264,7 @@ createLeaflet <- function(){
264264
var div = L.DomUtil.create('div','windCanvas');
265265
div.style.background = 'white';
266266
div.style.padding = '5px';
267-
div.innerHTML = '<span id=\"openmeteocloudButton\" onclick=$(\"#meteodata\").toggle() >Show/Hide Meteo Data </span><br><div id=\"meteodata\"><span id=\"openmeteocloudButton\" title=\"Click here to get current values from open-meteo (NB this is experimental and not to be used for production envs).\" onclick=\"getFromOpenMeteo();\">💨️Get from APIs </span> <br>🌡T = <span id=wtmp></span> - <b ><br>Wind at 10 m height <br>Speed: <span id=\"wspeed\">0</span> (m/s)</b><input type=\"range\" id=\"speed\" name=\"speed\" min=\"0\" value=0 max=\"30\"><b>Direction: <span id=\"wdir\">90</span>°</b><br><canvas id=\"windCanvas\" width=\"150\" height=\"150\"></canvas></div>';
267+
div.innerHTML = '<span id=\"openmeteocloudButton\" onclick=$(\"#meteodata\").toggle() >Show/Hide Meteo Data </span><br><div id=\"meteodata\"><span id=\"openmeteocloudButton\" title=\"Click here to get current values from open-meteo (NB this is experimental and not to be used for production envs).\" onclick=\"getFromOpenMeteo();\">💨️Get from APIs </span> <br>🌡T = <span id=wtmp></span> - <b ><br>Wind at 10 m height <br>Speed: <span id=\"wspeed\">0</span> (km/h)</b><input type=\"range\" id=\"speed\" name=\"speed\" min=\"0\" value=0 max=\"30\"><b>Direction: <span id=\"wdir\">90</span>°</b><br><canvas id=\"windCanvas\" width=\"150\" height=\"150\"></canvas></div>';
268268
div.style.border = '1px solid gray';
269269
div.style.borderRadius = '4px';
270270
L.DomEvent.disableClickPropagation(div);

‎inst/app/helperFunctions.R‎

Lines changed: 66 additions & 101 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,69 @@
1-
1+
getDateTimeFromCSV<-function(x){
2+
3+
if(!is.data.frame(x)){
4+
x <- read.csv(x )
5+
}
6+
7+
header <- names(x)
8+
9+
datecol <- grep("date", header, ignore.case = TRUE) # Case-insensitive match
10+
11+
if(length(datecol)==1){
12+
datecol <- datecol[1]
13+
# Read just that column to save memory/time
14+
wf_col <- x[, datecol]
15+
clean_ts <- anytime::anytime(wf_col, asUTC = FALSE)
16+
17+
# 3. FALLBACK: If anytime fails (e.g., 23/04/2026), hunt by explicit order
18+
if (anyNA(clean_ts)) {
19+
# Try Day-Month-Year variants (Common international format)
20+
clean_ts <- lubridate::dmy_hms(wf_col, quiet = TRUE)
21+
if (anyNA(clean_ts)) clean_ts <- lubridate::dmy_hm(wf_col, quiet = TRUE)
22+
if (anyNA(clean_ts)) clean_ts <- lubridate::dmy(wf_col, quiet = TRUE)
23+
24+
# Try Year-Month-Day variants (ISO format)
25+
if (anyNA(clean_ts)) clean_ts <- lubridate::ymd_hms(wf_col, quiet = TRUE)
26+
if (anyNA(clean_ts)) clean_ts <- lubridate::ymd_hm(wf_col, quiet = TRUE)
27+
if (anyNA(clean_ts)) clean_ts <- lubridate::ymd(wf_col, quiet = TRUE)
28+
29+
# Try Month-Day-Year variants (US format)
30+
if (anyNA(clean_ts)) clean_ts <- lubridate::mdy_hms(wf_col, quiet = TRUE)
31+
if (anyNA(clean_ts)) clean_ts <- lubridate::mdy_hm(wf_col, quiet = TRUE)
32+
if (anyNA(clean_ts)) clean_ts <- lubridate::mdy(wf_col, quiet = TRUE)
33+
}
34+
35+
if(anyNA(clean_ts)) {
36+
showNotification(paste0(
37+
"Sorry, we did find a column named '",
38+
names(wf)[[datecol]] ,"' BUT we could not convert
39+
its contents to a time stamp using various heuristics.
40+
<br> The following timestamp format is advised and recognized:
41+
<br>2023-07-07 16:00:00
42+
<br>2023-07-07 16:00
43+
<br>2023-07-07 16
44+
<br>We gave a generic 1 hour time lapse for each line."), duration=15 , id="datecolumnMixMatch"
45+
)
46+
47+
times <- 1:(nrow(wf)+2)
48+
49+
} else {
50+
td <-diff(clean_ts[1:2])
51+
times <- c(clean_ts[[1]]-td,
52+
clean_ts,
53+
clean_ts[[length(clean_ts)]]+td )
54+
55+
}
56+
57+
} else {
58+
showNotification(paste0(
59+
"Sorry, we did NOT find a column with name 'date'.
60+
<br>We gave a generic 1 hour time lapse for each line."), duration=15 , id="datecolumnMixMatch"
61+
)
62+
times <- 1:(nrow(wf)+2)
63+
}
64+
times
65+
66+
}
267

368
#' center
469
#' @description
@@ -36,103 +101,3 @@ checkAPI <- function(url){
36101
httr::status_code(res)
37102
}
38103

39-
40-
parse_fire_log <- function(log_text) {
41-
42-
# 1. Read all lines into a character vector
43-
lines <- log_text
44-
45-
# 2. Find the row indices (line numbers) for the data we want
46-
sim_indices <- grep("Simulation \\d+ Start:", lines)
47-
weatherFiles <- trimws(sub(".*weather file:\\s*", "", lines[sim_indices+1]))
48-
ignitionsN <- as.integer(gsub("\\D+", "", lines[sim_indices]))
49-
50-
Map(function(x){
51-
wf <- read.csv(x,header = T)
52-
datecol <- grep("date", names(wf))
53-
54-
if(length(datecol)==1){
55-
raw_ts <- gsub("[^0-9]", "", wf[,datecol])
56-
clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d%H%M%S")
57-
if(anyNA(clean_ts)) clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d%H%M")
58-
if(anyNA(clean_ts)) clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d%H")
59-
if(anyNA(clean_ts)) clean_ts <- as.POSIXct(raw_ts, format = "%Y%m%d")
60-
if(anyNA(clean_ts)) {
61-
showNotification(paste0(
62-
"Sorry, we did find a column named '",
63-
names(wf)[[datecol]] ,"' BUT we could not convert
64-
its contents to a time stamp using our heuristics.
65-
<br> The following timestamps formats are recognized:
66-
<br>2023-07-07 16:00:00
67-
<br>2023-07-07 16:00
68-
<br>2023-07-07 16
69-
<br>2023-07-07
70-
<br>We gave a generic 1 hour time lapse."), duration=15 , id="datecolumnMixMatch"
71-
)
72-
73-
times <- 1:nrow(wf)
74-
75-
} else {
76-
td <-diff(clean_ts[1:2])
77-
times <- c(clean_ts[[1]]-td,
78-
clean_ts,
79-
clean_ts[[length(clean_ts)]]+td )
80-
81-
}
82-
83-
} else {
84-
times <- 1:nrow(wf)
85-
}
86-
times
87-
88-
}, weatherFiles)
89-
if(anyNA(ignitionsN)){
90-
stop(errorCondition("We have NAs in simulation start ignition iterations!"))
91-
}
92-
93-
ign_cells <- trimws(gsub("ignition cell: ", "", lines[sim_indices+2]))
94-
95-
burnt_indices <- grep("^Simulation\\s+\\d+\\s+Results:", lines)
96-
burnt_ignitionsN <- as.numeric(str_extract(lines[burnt_indices ], "\\d+"))
97-
burnt_indicesClean <- burnt_indices[which(!duplicated(burnt_ignitionsN))]
98-
burnt_ignitionsNClean <- burnt_ignitionsN[which(!duplicated(burnt_ignitionsN))]
99-
100-
burnt_tables <- Map(function(x){
101-
x <- which(burnt_ignitionsNClean==x)
102-
indices <- (burnt_indicesClean[[x]]+3) : (burnt_indices[[x]]+7)
103-
data_lines <- lines[ indices ]
104-
data_lines <- gsub("^\t", "", data_lines)
105-
data_lines_csv <- gsub(" {2,}", ",", data_lines)
106-
df <- read.csv(text = data_lines_csv, header = FALSE)
107-
colnames(df) <- c("Cell Status", "Count", "Percent")
108-
109-
kable(df, format = "html", table.attr = "class='table table-striped table-condensed table-sm'")
110-
111-
},
112-
ignitionsN
113-
)
114-
# df <- data.frame(simulation = sim_indices,
115-
# ignitionsN = ignitionsN,
116-
# ign_cells=ign_cells)
117-
# 4. Bind them into a data frame
118-
119-
dd <- list(
120-
simulation = as.integer(ignitionsN),
121-
ignition_cell = as.integer(ign_cells),
122-
burnt_cells = as.character(burnt_tables)
123-
)
124-
125-
if(length(unique(sapply(dd, length)))!=1 || length(dd$simulation)==0){
126-
showNotification(
127-
paste0(
128-
"
129-
<br>Number of simulations: ", length(dd$simulation) ,". ",
130-
"
131-
<br>Number of ignition cells: ", length(dd$ignition_cell), ". ",
132-
"
133-
<br>Number of burnt cells values: ", length(dd$burnt_cells), ". <br>"
134-
), type="warning", duration=19 )
135-
}
136-
137-
dd
138-
}

0 commit comments

Comments
 (0)