styler autofix

inbo · Oct 10, 2024 · bf7bae9 · bf7bae9
1 parent 54838d5
commit bf7bae9
Show file tree

Hide file tree

Showing 7 changed files with 593 additions and 395 deletions.
diff --git a/source/scripts/cmon_sqlite_to_geotiff.R b/source/scripts/cmon_sqlite_to_geotiff.R
@@ -6,7 +6,8 @@ library(terra)
 git_root <- rprojroot::find_root(rprojroot::is_git_root)
 
 flea_data <- gsub(
-  pattern = "flea-extent", replacement = "flea-data", x = git_root)
+  pattern = "flea-extent", replacement = "flea-data", x = git_root
+)
 
 # lg2013 <- rast(file.path(flea_data, "data", "2013", "LG2013_finaal_update.tif"))
 # ext(lg2013)
@@ -18,41 +19,48 @@ flea_ext <- ext(as.numeric(flea_bbox), xy = TRUE)
 con <- connect_db(file.path(flea_data, "data/c-mon/grts.sqlite"))
 # use internal code from grtsdb::extract_sample
 # to get SQL syntax
-samplesize = 100
-bbox = flea_bbox
-cellsize = 10
-offset = NULL
+samplesize <- 100
+bbox <- flea_bbox
+cellsize <- 10
+offset <- NULL
 level <- n_level(bbox = bbox, cellsize = cellsize)
 fields <- dbListFields(con, sprintf("level%02i", level))
 fields <- fields[grep("^x[[:digit:]]*$", fields)]
 center <- rowMeans(bbox)
-midpoint <- 2 ^ (level - 1) - 0.5
-where <- sprintf("%s %s %f", rep(fields, 2),
-                 rep(c(">=", "<="), each = length(center)),
-                 (as.vector(bbox) - center) / cellsize + midpoint)
+midpoint <- 2^(level - 1) - 0.5
+where <- sprintf(
+  "%s %s %f", rep(fields, 2),
+  rep(c(">=", "<="), each = length(center)),
+  (as.vector(bbox) - center) / cellsize + midpoint
+)
 where <- paste(where, collapse = " AND ")
-fields <- sprintf("(%1$s - %2$f) * %3$f + %4$f AS %1$sc",
-                  fields, midpoint, cellsize, center)
+fields <- sprintf(
+  "(%1$s - %2$f) * %3$f + %4$f AS %1$sc",
+  fields, midpoint, cellsize, center
+)
 
 # amend the query to extract all cells
 # order from topleft to bottomright
 sql <- sprintf(
   "SELECT %s, ranking FROM level%02i WHERE %s ORDER BY -x2c, x1c",
-  paste(fields, collapse = ", "), level, where)
+  paste(fields, collapse = ", "), level, where
+)
 
-allcells <- RSQLite::dbGetQuery(con, sql) #9Gb
+allcells <- RSQLite::dbGetQuery(con, sql) # 9Gb
 
 dbDisconnect(con)
 
 class(allcells)
 head(allcells)
 # S4 method for class 'data.frame'
 # If the value is "xyz", the matrix or data.frame x must have at least two columns, the first with x (or longitude) and the second with y (or latitude) coordinates that represent the centers of raster cells. The additional columns are the values associated with the raster cells
-rast(x = allcells,
-     type = "xyz",
-     crs = "EPSG:31370",
-     digits = 6,
-     extent = flea_ext) |>
+rast(
+  x = allcells,
+  type = "xyz",
+  crs = "EPSG:31370",
+  digits = 6,
+  extent = flea_ext
+) |>
   terra::writeRaster(
     filename = file.path(flea_data, "data/c-mon/flea_cmon_level15.tiff"),
     datatype = "INT4U"
@@ -63,4 +71,3 @@ fleagrts
 plot(fleagrts)
 origin(fleagrts)
 ext(fleagrts)
-
diff --git a/source/scripts/explore_categories_of_change.R b/source/scripts/explore_categories_of_change.R
@@ -5,7 +5,8 @@ library(ggsankey)
 library(terra)
 git_root <- rprojroot::find_root(rprojroot::is_git_root)
 flea_data <- gsub(
-  pattern = "flea-extent", replacement = "flea-data", x = git_root)
+  pattern = "flea-extent", replacement = "flea-data", x = git_root
+)
 
 
 temporal_stratification <- rast(file.path(flea_data, "data/2013_2016_2019", "temporal_stratification.tif"))
@@ -27,7 +28,8 @@ sum(changes_df$count < 10000) # 100ha
 changes_df %>%
   group_by(stable) %>%
   summarize(
-    pixelcount = sum(count)) %>%
+    pixelcount = sum(count)
+  ) %>%
   mutate(
     proportion = pixelcount / sum(pixelcount)
   )
@@ -39,10 +41,12 @@ changes_df %>%
   pivot_longer(cols = contains("changecat")) %>%
   group_by(name, value) %>%
   summarize(
-    pixelcount = sum(count)) %>%
+    pixelcount = sum(count)
+  ) %>%
   mutate(
     proportion = pixelcount / sum(pixelcount),
-    name = reorder(name, pixelcount)) %>%
+    name = reorder(name, pixelcount)
+  ) %>%
   ggplot() +
   geom_bar(aes(x = name, weight = pixelcount, fill = value)) +
   coord_flip()
@@ -53,13 +57,16 @@ changes_df %>%
   group_by(name, value) %>%
   filter(!grepl("^Stable", value)) %>%
   summarize(
-    pixelcount = sum(count)) %>%
+    pixelcount = sum(count)
+  ) %>%
   mutate(
     proportion = pixelcount / sum(pixelcount),
     name = reorder(name, pixelcount),
     pixelcount2 = if_else(
       grepl("gain", value, ignore.case = TRUE),
-      pixelcount, -pixelcount)) %>%
+      pixelcount, -pixelcount
+    )
+  ) %>%
   ggplot() +
   geom_bar(aes(x = name, weight = pixelcount2, fill = value)) +
   coord_flip()
@@ -72,21 +79,23 @@ df <- changes_df %>%
     value = count
   )
 
-df2 <-  df %>%
+df2 <- df %>%
   group_by(x, node) %>%
   summarise(n = sum(value))
 
 df3 <- df %>%
   left_join(df2)
 
 p <- df3 %>%
-  ggplot(aes(x = x,
-             next_x = next_x,
-             node = node,
-             next_node = next_node,
-             fill = factor(node),
-             label = paste0(node,": n = ", n),
-             value = value)) +
+  ggplot(aes(
+    x = x,
+    next_x = next_x,
+    node = node,
+    next_node = next_node,
+    fill = factor(node),
+    label = paste0(node, ": n = ", n),
+    value = value
+  )) +
   geom_sankey(alpha = 0.5) +
   geom_sankey_label(alpha = 0.5, colour = "black") +
   theme_sankey() +
@@ -102,28 +111,26 @@ df <- changes_df %>%
     value = count
   )
 
-df2 <-  df %>%
+df2 <- df %>%
   group_by(x, node) %>%
   summarise(n = sum(value))
 
 df3 <- df %>%
   left_join(df2)
 
 p <- df3 %>%
-  ggplot(aes(x = x,
-             next_x = next_x,
-             node = node,
-             next_node = next_node,
-             fill = factor(node),
-             label = paste0(node,": n = ", n),
-             value = value)) +
+  ggplot(aes(
+    x = x,
+    next_x = next_x,
+    node = node,
+    next_node = next_node,
+    fill = factor(node),
+    label = paste0(node, ": n = ", n),
+    value = value
+  )) +
   geom_sankey(alpha = 0.5) +
   geom_sankey_label(alpha = 0.5, colour = "black") +
   theme_sankey() +
   theme(legend.position = "none")
 
 p
-
-
-
-
diff --git a/source/scripts/flea_functions.R b/source/scripts/flea_functions.R
@@ -25,13 +25,15 @@ point_to_gridcell <- function(
 
   # buffer with 1 point per quandrant
   halflength <- cell_width_m / 2
-  xy_buffer <- sf::st_buffer(x = xy,
-                             dist = sqrt(2 * halflength^2),
-                             nQuadSegs = 1)
+  xy_buffer <- sf::st_buffer(
+    x = xy,
+    dist = sqrt(2 * halflength^2),
+    nQuadSegs = 1
+  )
 
   # rotate 45 degrees around centroid
   rot <- function(a) matrix(c(cos(a), sin(a), -sin(a), cos(a)), 2, 2)
-  pl <- (xy_buffer - xy) * rot(pi/4) + xy
+  pl <- (xy_buffer - xy) * rot(pi / 4) + xy
   pl <- sf::st_sf(data.frame(xy_df, pl), crs = crs)
   return(pl)
 }
@@ -68,7 +70,8 @@ extract_sample_helper <- function(
     y = as.points(rast, na.rm = TRUE),
     cells = TRUE,
     xy = TRUE,
-    ID = FALSE)
+    ID = FALSE
+  )
 
   # Sort and select the lowest n
   sorted_indices <- order(extracted[[1]])[1:n]
@@ -195,5 +198,3 @@ extract_sample <- function(
 
   return(sample_ts2)
 }
-
-