diff --git a/R/figure_functions.R b/R/figure_functions.R index 8f31e75..b9945a5 100644 --- a/R/figure_functions.R +++ b/R/figure_functions.R @@ -470,7 +470,7 @@ catchCompMap <- function(data) { catchMap <- function(data, species) { ## Definitions - + #species='All' if (species == "All") { sps <- unique(data$commonname) } else { @@ -490,27 +490,52 @@ catchMap <- function(data, species) { if (nrow(tmp2) > 0) tmp2$catchsum <- 0 + ## Legend breaks + library(purrr) + library(data.table) + library(rlang) + + breaks=c(-Inf, 1, 10, 10^2, 0.5*10^3, 10^3, 0.5*10^4, +Inf) + sizes = c(2, 3, 6, 9, 12, 16, 20, 25) + conditions = mapply(c, breaks, shift(breaks,1,type = 'lead'), shift(sizes,1,type='lead'), SIMPLIFY = FALSE) + names(conditions) = map2_chr(breaks, shift(breaks,1,type = 'lead'), ~ paste0(.x, "-", .y)) + conditions <- purrr::map(.x = conditions[-length(conditions)], ~quo(between(catchsum, !!.x[1], !!.x[2]) ~ !!.x[3])) + conditions[length(conditions)] <- NULL + labels = c("Not caught", + paste0("<", as.character(breaks[2])), + map2_chr(shift(breaks,1,type = 'lead'), shift(breaks,2,type = 'lead'), ~ paste0(.x, "-", .y))[1:5], + paste0(">", as.character(breaks[length(breaks)-1]))) + + tmp <- tmp %>% mutate(WeightClass = case_when(!!!conditions) %>% + factor(levels=sizes)) + ## Plot p <- leaflet::leaflet(tmp, options = leafletOptions(zoomControl = FALSE)) %>% addTiles(urlTemplate = "https://server.arcgisonline.com/ArcGIS/rest/services/Ocean_Basemap/MapServer/tile/{z}/{y}/{x}", attribution = "Tiles © Esri — Sources: GEBCO, NOAA, CHS, OSU, UNH, CSUMB, National Geographic, DeLorme, NAVTEQ, and Esri") %>% - addCircles(lat = ~ latitudestart, lng = ~ longitudestart, - weight = 4, radius = 5e4*(tmp$catchsum/max(tmp$catchsum)), - label = paste0(tmp$serialnumber, "; ", tmp$catchsum, " kg"), - popup = paste("Serial number:", tmp$serialnumber, "
", - "Date:", tmp$stationstartdate, "
", - "Gear code:", tmp$gear, "
", - "Bottom depth:", round(tmp$bottomdepthstart, 0), "m", - "
", species, "catch:", tmp$catchsum, - "kg"), - color = "red", fill = NA - ) + addCircleMarkers(lat = ~ latitudestart, lng = ~ longitudestart, + weight = 2, stroke = T, + radius = 0.5*as.numeric(as.character(tmp$WeightClass)), #radius is in px, 0.5 needed as the border width is set to 50% in the addLegendCustom function + label = paste0(tmp$serialnumber, "; ", tmp$catchsum, " kg"), + popup = paste("Serial number:", tmp$serialnumber, "
", + "Date:", tmp$stationstartdate, "
", + "Gear code:", tmp$gear, "
", + "Bottom depth:", round(tmp$bottomdepthstart, 0), "m", + "
", species, "catch:", tmp$catchsum, + "kg"), + color = "red", fill = NA) %>% + addLegendCustom(title = paste0(species, "
", "Weight (Kg)"), + colors = c("black", rep("red",length(sizes)-1)), + labels = labels, + sizes = sizes + ) + if (nrow(tmp2) > 0) { p %>% addCircles(lat = tmp2$latitudestart, lng = tmp2$longitudestart, - weight = 4, radius = 1, + weight = 2, radius = 1, label = paste0(tmp2$serialnumber, "; ", tmp2$catchsum, " kg"), popup = paste("Serial number:", tmp2$serialnumber, "
", "Date:", tmp2$stationstartdate, "
", diff --git a/R/other_functions.R b/R/other_functions.R index a3b88ce..ad84618 100644 --- a/R/other_functions.R +++ b/R/other_functions.R @@ -110,3 +110,20 @@ prettyDec <- function(dt) { for (j in cols) suppressWarnings(set(dt, j = j, value = as.numeric(format(dt[[j]])))) return(dt) } + + +#' @title Custom leaflet legend + +addLegendCustom <- function(map, colors, position, sizes, labels, opacity = 1, title='fill in your title'){ + colorAdditions <- paste0(colors, "; border-radius: 50%; width:", sizes, "px; height:", + sizes, "px;margin-top: 3px; inline-block; vertical-align: middle; middle: ", + sizes) + labelAdditions <- paste0("
", + labels, "
") + position <- 'topleft' + + return(addLegend(map, position=position, colors = colorAdditions, labels = labelAdditions, + opacity = opacity, title = title)) +} + diff --git a/R/processBiotic_functions.R b/R/processBiotic_functions.R index 646447f..8628e3f 100644 --- a/R/processBiotic_functions.R +++ b/R/processBiotic_functions.R @@ -23,6 +23,21 @@ processBioticFile <- function(file, removeEmpty = TRUE, convertColumns = TRUE, r dt <- RstoxData::readXmlFile(file) + ## Modification for Dr.F.Nansen xmls + + if(dt$mission$callsignal== "LDLG" & dt$mission$platformname=="Dr.Fridtjof Nansen"){ + if("fishingdepthstart" %in% colnames(dt$fishstation)){ + if(!anyNA(dt$fishstation$fishingdepthstart)){ + dt$fishstation$fishingdepthmin <- dt$fishstation$fishingdepthstart + } + } + + dt$individual$maturationstage <- ifelse(as.numeric(dt$individual$maturationstage)>=100, + as.character(as.numeric(dt$individual$maturationstage)-100), + dt$individual$maturationstage) + } + + ## Mission data --- msn <- dt$mission