Skip to content

Commit 3e249cf

Browse files
bbestbbest
committed
+ app for density of ctd_casts #29 
1 parent d81190d commit 3e249cf

File tree

8 files changed

+199
-1
lines changed

8 files changed

+199
-1
lines changed

‎hex_density/global.R

+31
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
# remotes::install_github("qfes/rdeck")
2+
if (!require("librarian")){
3+
install.packages("librarian")
4+
library(librarian)
5+
}
6+
7+
# issues with using older version of R 3.6.2 on rstudio.whalesafe.com,
8+
# so needing to install packages from sources:
9+
# usethis::browse_github_pat(); usethis::edit_r_environ() GITHUB_PAT="..."
10+
# remotes::install_github("r-lib/rlang", ref="main")
11+
# remotes::install_github("qfes/tidyassert", ref="main")
12+
# remotes::install_github("qfes/rdeck")
13+
# remotes::install_github("r-lib/cachem", ref="main")
14+
# remotes::install_github("r-lib/fastmap", ref="main")
15+
# remotes::install_github("rstudio/htmltools", ref="main")
16+
# remotes::install_github("rstudio/sass", ref="main")
17+
# remotes::install_github("rstudio/jquerylib", ref="main")
18+
# remotes::install_github("rstudio/bslib", ref="main")
19+
# remotes::install_github("r-lib/httr2", ref="main")
20+
# remotes::install_github("r-lib/tidyselect", ref="main")
21+
# remotes::install_github("r-lib/cli", ref="main")
22+
# remotes::install_github("r-lib/ellipsis", ref="main")
23+
24+
librarian::shelf(
25+
bslib, dplyr, httr2, qfes/rdeck, sf, shinyWidgets, tidyselect, viridis)
26+
27+
mb_token_txt <- "/Users/bbest/My Drive/private/mapbox_token_bdbest.txt"
28+
stopifnot(file.exists(mb_token_txt))
29+
mb_token <- readLines(mb_token_txt)
30+
options(rdeck.mapbox_access_token = mb_token)
31+
# rdeck::mapbox_access_token()

‎hex_density/mockup.jpg

377 KB
Loading

‎hex_density/prep.R

+99
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,99 @@
1+
remotes::install_github("qfes/rdeck")
2+
3+
remotes::install_github("eddelbuettel/rcppsimdjson")
4+
5+
library(rdeck)
6+
library(dplyr)
7+
library(sf)
8+
library(viridis)
9+
# loading deck.gl example data
10+
library(RcppSimdJson)
11+
12+
13+
url <- file.path(
14+
"https://raw.githubusercontent.com/visgl/deck.gl-data/master",
15+
"examples/scatterplot/manhattan.json",
16+
fsep = "/"
17+
)
18+
manhattan_data <- fload(url) %>%
19+
as_tibble(.name_repair = ~ c("lon", "lat", "species")) %>%
20+
mutate(
21+
position = sfc_point(lon, lat),
22+
species = as.factor(species),
23+
species_name = if_else(species == 1, "dog", "cat")
24+
)
25+
26+
mb_token <- readLines("~/My Drive/private/mapbox_token_bdbest.txt")
27+
options(rdeck.mapbox_access_token = mb_token)
28+
rdeck::mapbox_access_token()
29+
30+
rdeck(
31+
map_style = mapbox_dark(),
32+
initial_bounds = st_bbox(
33+
c(xmin=-180, ymin=-90, xmax=180, ymax=90),
34+
crs = st_crs(4326))
35+
# add a 2 pixel buffer to each point, making it easier to hover
36+
#picking_radius = 2
37+
) %>%
38+
add_mvt_layer(
39+
name = "hex",
40+
data = "https://tile.bbnj.app/public.hexagons/{z}/{x}/{y}.pbf?step=5",
41+
# get_fill_color = "#0000FF") # blue
42+
get_fill_color = scale_color_linear(
43+
col = "i",
44+
palette = viridis(21, alpha=0.5),
45+
limits = c(-10, 10)),
46+
auto_highlight = TRUE,
47+
pickable = TRUE,
48+
tooltip = c("i","j"))
49+
50+
51+
52+
rdeck() |>
53+
add_mvt_layer(
54+
data = mvt_url("mapbox.country-boundaries-v1"),
55+
get_fill_color = scale_color_linear(
56+
col = color_group,
57+
palette = viridis::viridis(6),
58+
limits = c(1, 6)
59+
),
60+
auto_highlight = TRUE,
61+
pickable = TRUE,
62+
tooltip = TRUE)
63+
64+
rdeck(
65+
initial_view_state = view_state(center = c(-73.58, 45.53), zoom = 9)) |>
66+
add_mvt_layer(
67+
data = mvt_url("dwachsmuth.borough_5"),
68+
get_fill_color = scale_color_linear(
69+
col = "canale_ind_q5_2016",
70+
palette = c("#FF00FF", "#00FF00"),
71+
limits = c(0, 5)))
72+
73+
74+
add_scatterplot_layer(
75+
name = "manhattan_animals",
76+
data = manhattan_data,
77+
# the coloumn in manhattan_data which contains the location of each point
78+
get_position = position,
79+
# a categorical colour scale, using the species column and a cividis colour palette
80+
get_fill_color = scale_color_category(
81+
col = species,
82+
palette = cividis(2)
83+
),
84+
# the radius of each point (default 1 metre) is scaled by 30
85+
radius_scale = 30,
86+
radius_min_pixels = 0.5,
87+
# highlight dot density
88+
blending_mode = "additive",
89+
# interactivity
90+
pickable = TRUE,
91+
auto_highlight = TRUE,
92+
# per-species highlight colour
93+
highlight_color = scale_color_category(
94+
col = species,
95+
palette = c("#0060e6", "#fff399"),
96+
legend = FALSE
97+
),
98+
tooltip = c(species, species_name)
99+
)

‎hex_density/restart.txt

Whitespace-only changes.

‎hex_density/server.R

+40
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
shinyServer(function(input, output, session) {
2+
3+
# calcofi4r::cc_places |>
4+
# filter(category == "CalCOFI Zones") |>
5+
# st_union() |>
6+
# st_bbox()
7+
# xmin ymin xmax ymax
8+
# -135.23008 18.42757 -105.77692 49.23891
9+
10+
output$map <- renderRdeck({
11+
rdeck(
12+
map_style = mapbox_dark(),
13+
initial_bounds = st_bbox(
14+
c(xmin=-136, ymin=18, xmax=-106, ymax=50),
15+
crs = st_crs(4326)))
16+
})
17+
18+
observe({
19+
20+
req(input$num_max)
21+
22+
mvt_url <- "https://tile.calcofi.io/public.hexagons/{z}/{x}/{y}.pbf"
23+
24+
rdeck_proxy(id = "map") %>%
25+
add_mvt_layer(
26+
id = "hexagons",
27+
name = "n_ctd_casts",
28+
data = mvt_url,
29+
get_fill_color = scale_color_linear(
30+
col = n_ctd_casts,
31+
na_color = "#000000",
32+
palette = viridis(6, alpha=0.5),
33+
limits = c(1, input$num_max)),
34+
auto_highlight = TRUE,
35+
pickable = TRUE,
36+
tooltip = c(i, j, n_ctd_casts),
37+
max_zoom = 10)
38+
})
39+
40+
})

‎hex_density/styles.css

+4
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
#params {
2+
background-color: #375A7F
3+
/* darkly bootswatch: #375A7F; LGND mockup: #0370C5; */
4+
}

‎hex_density/ui.R

+23
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
shinyUI(fluidPage(
2+
windowTitle = "CalCOFI density",
3+
theme = bs_theme(
4+
version = 5,
5+
bootswatch = "darkly",
6+
"font-size-base" = "0.8rem",
7+
"navbar-padding-y" = "0",
8+
"navbar-padding-x" = "0",
9+
"container-padding-x" = "0"),
10+
11+
tags$head(
12+
includeCSS("styles.css")),
13+
14+
# area, spp, scapes, benthic, fishing, vgpm
15+
fluidRow(
16+
id = "params",
17+
column(
18+
12,
19+
numericInput("num_max", label = h3("Max for color scale"), value = 1000) ) ),
20+
21+
rdeckOutput("map", width = "100vw", height = "100vh")
22+
))
23+

‎libs/db.R

+2-1
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,8 @@ if (!require("librarian")){
44
library(librarian)
55
}
66
librarian::shelf(
7-
DBI, dbplyr, dplyr, here, RPostgres)
7+
DBI, dbplyr, dplyr, here, RPostgres,
8+
quiet = T)
89

910
is_server <- Sys.info()[["sysname"]] == "Linux"
1011
host <- ifelse(

0 commit comments

Comments
 (0)