Skip to content

Commit 82de123

Browse files
cboettigcboettig
committed
2 parents 90688aa + ec91dd2 commit 82de123

11 files changed

Lines changed: 525 additions & 82 deletions

File tree

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,3 +56,4 @@ rsconnect/
5656
Rplots.pdf
5757
.tmp/
5858
kubernetes/set-secrets.sh
59+
node_modules/*

‎app/app.R‎

Lines changed: 39 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,8 @@ Smaller areas will be faster to compute! Zoom in further to show richness with
8383
# chat_ui("chat", placeholder = "hummingbirds"),
8484
actionLink("get_richness", "🐦 GBIF species richness"),
8585
actionLink("get_carbon", "🌱 vulnerable carbon"),
86+
actionLink("get_inat", "🐞 iNat species richness"),
87+
actionLink("clear_data", "🧹 clear"),
8688
),
8789
card(
8890
card_header("Resolution"),
@@ -267,6 +269,14 @@ server <- function(input, output, session) {
267269
active_feature(lazy_gdf) # can a lazy feature be global var?
268270
}
269271
})
272+
observeEvent(input$clear_data, {
273+
# use a better NULL of actually empty data? random site doesn't clear
274+
null <- "https://minio.carlboettiger.info/public-data/cache/gbif-app/carbon/396f8483cde5c907a0c8ef1ae334e77a.geojson"
275+
print(paste("clearing data layers", null))
276+
maplibre_proxy("map") |>
277+
set_source("richness", null) |>
278+
set_source("carbon", null)
279+
})
270280

271281
observeEvent(input$get_richness, {
272282
poly <- get_active_feature(active_feature(), input)
@@ -287,11 +297,11 @@ server <- function(input, output, session) {
287297
)
288298
}
289299

290-
print(gdf)
291300
maplibre_proxy("map") |>
292301
set_source("richness", gdf)
293302
})
294303

304+
# Generalize this
295305
observeEvent(input$get_carbon, {
296306
poly <- get_active_feature(active_feature(), input)
297307

@@ -303,14 +313,41 @@ server <- function(input, output, session) {
303313
} else {
304314
layer <- layer_config[[input$layer_selection]]$parent_layer
305315
child_poly <- child_polygons(poly, layer, layer_config)
306-
gdf <- get_mean_carbon(child_poly, zoom = as.integer(input$resolution))
316+
gdf <- get_mean_carbon(
317+
child_poly,
318+
zoom = as.integer(input$resolution),
319+
taxa_selections = taxa_filter()
320+
)
307321
}
308322

309323
print(gdf)
310324
maplibre_proxy("map") |>
311325
set_source("carbon", gdf)
312326
})
313327

328+
observeEvent(input$get_inat, {
329+
poly <- get_active_feature(active_feature(), input)
330+
331+
if (input$show_hexes) {
332+
gdf <- get_inat_hexes(
333+
poly = poly,
334+
zoom = as.integer(input$resolution)
335+
)
336+
} else {
337+
layer <- layer_config[[input$layer_selection]]$parent_layer
338+
child_poly <- child_polygons(poly, layer, layer_config)
339+
gdf <- get_inat_zonal(
340+
child_poly,
341+
zoom = as.integer(input$resolution),
342+
taxa_selections = taxa_filter()
343+
)
344+
}
345+
346+
print(gdf)
347+
maplibre_proxy("map") |>
348+
set_source("richness", gdf)
349+
})
350+
314351
# Layer selection tools
315352
observeEvent(input$clear_filters, {
316353
maplibre_proxy("map") |> set_filter(input$layer_selection, NULL)

‎app/hex-tools.R‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -138,8 +138,16 @@ get_h3_aoi_ <- function(
138138
h3_aoi <- h3_aoi |>
139139
dplyr::select(dplyr::any_of(c("h0", "h3id", keep_cols))) |>
140140
dplyr::rename(!!h3_column := h3id)
141-
142-
# h3_aoi |> as_view("h3_aoi")
141+
#dplyr::mutate(!!h3_column := h3id)
143142

144143
h3_aoi
145144
}
145+
146+
hex_cols <- function(x) {
147+
cols <- colnames(x)
148+
cols[grepl("^h\\d{1,2}$", cols)]
149+
}
150+
smallest_hex_col <- function(x) {
151+
h <- hex_cols(x)
152+
sort(h, TRUE)[1]
153+
}

‎app/tools-inat-broken.R‎

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
# should this also support richness or single species?
2+
inat_rangemap <- function(
3+
poly,
4+
zoom,
5+
id_column = "id",
6+
taxa_selections = list(),
7+
server = Sys.getenv("AWS_S3_ENDPOINT", "minio.carlboettiger.info"),
8+
bucket = "public-data/cache/gbif-app"
9+
) {
10+
poly_hexed <- get_h3_aoi(poly, precision = zoom, keep_cols = id_column)
11+
}
12+
13+
open_inat_area <- function(
14+
poly,
15+
zoom = 4L,
16+
id_column = "id",
17+
taxa_selections = list()
18+
) {
19+
duckdbfs::load_h3()
20+
21+
# get_h3_aoi is self-caching, shared across metrics
22+
poly_hexed_url <- get_h3_aoi(
23+
poly,
24+
precision = zoom,
25+
keep_cols = id_column,
26+
h3_column = "h3id",
27+
)
28+
29+
h_col <- paste0("h", zoom)
30+
poly_hexed <-
31+
duckdbfs::open_dataset(poly_hexed_url, recursive = FALSE) |>
32+
# dplyr::rename(h3id = !!h_col) |>
33+
dplyr::mutate(h3id = tolower(h3id))
34+
35+
print("poly_hexed:")
36+
print(poly_hexed)
37+
38+
inat <-
39+
open_dataset("s3://public-inat/hex") |>
40+
filter_inat_taxa(taxa_selections)
41+
42+
# handle alternate resolutions on the fly? Or precompute these?
43+
if (zoom < 4) {
44+
inat <- inat |> mutate(h3id = unnest(h3_cell_to_children(h4, zoom)))
45+
} else if (zoom > 4) {
46+
inat <- inat |>
47+
mutate(h3id = h3_cell_to_parent(h4, zoom)) |>
48+
select(-h4) |>
49+
distinct() # is it worth dropping duplicates?
50+
} else {
51+
inat <- inat |> rename(h3id = h4)
52+
}
53+
54+
inat <- inat |>
55+
dplyr::inner_join(poly_hexed)
56+
57+
inat
58+
}
59+
60+
61+
get_inat_hexes <- function(
62+
poly,
63+
zoom = 4L,
64+
id_column = "id",
65+
taxa_selections = list(),
66+
server = Sys.getenv("AWS_S3_ENDPOINT", "minio.carlboettiger.info"),
67+
bucket = "public-data/cache/gbif-app"
68+
) {
69+
inat <- open_inat_area(
70+
poly = poly,
71+
zoom = zoom,
72+
id_column = id_column,
73+
taxa_selections = taxa_selections
74+
)
75+
76+
print("inat:")
77+
print(head(inat))
78+
79+
inat |>
80+
dplyr::count(h3id) |>
81+
dplyr::mutate(logn = log(n), value = logn / max(logn)) |>
82+
dplyr::mutate(
83+
geom = ST_GeomFromText(
84+
h3_cell_to_boundary_wkt(h3id)
85+
)
86+
)
87+
88+
## this part should be separate? Or be included in cache logic.
89+
label <- "inat"
90+
hash <- digest::digest(list(inat, zoom, id_column, label))
91+
s3 <- glue::glue("s3://{bucket}/{label}/{hash}.geojson")
92+
duckdbfs::to_geojson(inat, s3, as_http = TRUE)
93+
}
94+
95+
get_inat_zonal <- function(
96+
poly,
97+
zoom = 4L,
98+
id_column = "id",
99+
taxa_selections = list(),
100+
server = Sys.getenv("AWS_S3_ENDPOINT", "minio.carlboettiger.info"),
101+
bucket = "public-data/cache/gbif-app"
102+
) {
103+
inat <- open_inat_area(
104+
poly = poly,
105+
zoom = zoom,
106+
id_column = id_column,
107+
taxa_selections = taxa_selections
108+
)
109+
110+
inat |>
111+
dplyr::count(.data[[id_column]]) |>
112+
dplyr::mutate(logn = log(n), value = logn / max(logn))
113+
114+
# join back to poly with geoms
115+
poly <- poly |>
116+
dplyr::select(dplyr::all_of(id_column), geometry) |>
117+
dplyr::inner_join(inat, by = id_column) |>
118+
rename(geom = "geometry")
119+
120+
## this part should be separate? Or be included in cache logic.
121+
label <- "inat"
122+
hash <- digest::digest(list(poly, zoom, id_column, label))
123+
s3 <- glue::glue("s3://{bucket}/{label}/{hash}.geojson")
124+
duckdbfs::to_geojson(poly, s3, as_http = TRUE)
125+
}
126+
127+
# FIXME do the filter!
128+
filter_inat_taxa <- function(df, taxa_list) {
129+
df
130+
}

‎app/tools-inat-h4-works.R‎

Lines changed: 126 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,126 @@
1+
# should this also support richness or single species?
2+
inat_rangemap <- function(
3+
poly,
4+
zoom,
5+
id_column = "id",
6+
taxa_selections = list(),
7+
server = Sys.getenv("AWS_S3_ENDPOINT", "minio.carlboettiger.info"),
8+
bucket = "public-data/cache/gbif-app"
9+
) {
10+
poly_hexed <- get_h3_aoi(poly, precision = zoom, keep_cols = id_column)
11+
}
12+
13+
14+
get_inat_hexes <- function(
15+
poly,
16+
zoom = 4L,
17+
id_column = "id",
18+
taxa_selections = list(),
19+
server = Sys.getenv("AWS_S3_ENDPOINT", "minio.carlboettiger.info"),
20+
bucket = "public-data/cache/gbif-app"
21+
) {
22+
duckdbfs::load_h3()
23+
24+
# get_h3_aoi is self-caching, shared across metrics
25+
poly_hexed_url <- get_h3_aoi(poly, precision = zoom, keep_cols = id_column)
26+
poly_hexed <- duckdbfs::open_dataset(poly_hexed_url, recursive = FALSE)
27+
28+
inat <-
29+
open_dataset("s3://public-inat/hex") |>
30+
filter_gbif_taxa(taxa_selections)
31+
32+
# handle alternate resolutions on the fly? Or precompute these?
33+
if (zoom < 4) {
34+
inat <- inat |> mutate(h3id = unnest(h3_cell_to_children(h4, zoom)))
35+
} else if (zoom > 4) {
36+
inat <- inat |>
37+
mutate(h3id = h3_cell_to_parent(h4, zoom)) |>
38+
select(-h4) |>
39+
distinct() # is it worthwhile dropping duplicate rows?
40+
} else {
41+
inat <- inat |> rename(h3id = h4)
42+
}
43+
44+
inat <- inat |>
45+
dplyr::inner_join(poly_hexed) |>
46+
dplyr::count(h3id) |>
47+
dplyr::mutate(logn = log(n), value = logn / max(logn)) |>
48+
dplyr::mutate(
49+
geom = ST_GeomFromText(
50+
h3_cell_to_boundary_wkt(h3id)
51+
)
52+
)
53+
54+
## this part should be separate? Or be included in cache logic.
55+
label <- "inat"
56+
hash <- digest::digest(list(inat, zoom, id_column, label))
57+
s3 <- glue::glue("s3://{bucket}/{label}/{hash}.geojson")
58+
duckdbfs::to_geojson(inat, s3, as_http = TRUE)
59+
}
60+
61+
get_inat_zonal <- function(
62+
poly,
63+
zoom = 4L,
64+
id_column = "id",
65+
taxa_selections = list(),
66+
server = Sys.getenv("AWS_S3_ENDPOINT", "minio.carlboettiger.info"),
67+
bucket = "public-data/cache/gbif-app"
68+
) {
69+
duckdbfs::load_h3()
70+
71+
# get_h3_aoi is self-caching, shared across metrics
72+
poly_hexed_url <- get_h3_aoi(
73+
poly,
74+
precision = zoom,
75+
keep_cols = id_column,
76+
h3_column = "h3id"
77+
)
78+
poly_hexed <-
79+
duckdbfs::open_dataset(poly_hexed_url, recursive = FALSE) |>
80+
dplyr::mutate(h3id = tolower(h3id))
81+
82+
inat <-
83+
open_dataset("s3://public-inat/hex") |>
84+
filter_inat_taxa(taxa_selections)
85+
86+
print("POSITION 1")
87+
zoom <- as.integer(zoom)
88+
# handle alternate resolutions on the fly? Or precompute these?
89+
if (zoom > 4) {
90+
inat <- inat |> mutate(h3id = unnest(h3_cell_to_children(h4, zoom)))
91+
} else if (zoom < 4) {
92+
inat <- inat |>
93+
mutate(h3id = h3_cell_to_parent(h4, zoom)) |>
94+
select(-h4) |>
95+
distinct() # is it worth dropping duplicates?
96+
} else {
97+
inat <- inat |> rename(h3id = h4)
98+
}
99+
100+
print("POSITION 2")
101+
102+
print(inat)
103+
print(poly_hexed)
104+
105+
inat <- inat |>
106+
dplyr::inner_join(poly_hexed) |>
107+
dplyr::count(.data[[id_column]]) |>
108+
dplyr::mutate(logn = log(n), value = logn / max(logn))
109+
110+
# join back to poly with geoms
111+
poly <- poly |>
112+
dplyr::select(dplyr::all_of(id_column), geometry) |>
113+
dplyr::inner_join(inat, by = id_column) |>
114+
rename(geom = "geometry")
115+
116+
## this part should be separate? Or be included in cache logic.
117+
label <- "inat"
118+
hash <- digest::digest(list(poly, zoom, id_column, label))
119+
s3 <- glue::glue("s3://{bucket}/{label}/{hash}.geojson")
120+
duckdbfs::to_geojson(poly, s3, as_http = TRUE)
121+
}
122+
123+
# FIXME do the filter!
124+
filter_inat_taxa <- function(df, taxa_list) {
125+
df
126+
}

0 commit comments

Comments
 (0)