Concatenated Data Sets
These data sets, made from combining the Japan-focused data, can be found under Example Data at the Reference page.
Japan Octopodoidea Data Set, museum
museum <- rbind(
InvBase_Japan %>% mutate(`Data Frame` = "InvBase"),
GBIF_Japan %>% mutate(`Data Frame` = "GBIF"),
NSMT_Japan %>% mutate(`Data Frame` = "NSMT"),
OBIS_Japan %>% mutate(`Data Frame` = "OBIS"),
BISMAL_Japan %>% mutate(`Data Frame` = "BISMAL")
) #2738 Observations
museum <- deduplicate(museum, "catalogNumber",
drop_na = TRUE) #143 duplicate rows removed; 608 rows removed due to missing ID. 1987 Observations
museum_dupes <- attr(museum, "duplicates") #1268 Observations, 143 FALSE
museum <- duplicate(museum, "individualCount") #Duplication increased count from 1894 Observations to 2671 ObservationsThe concatenated Japanese Octopodoidea data, with repeat or absent
catalog numbers removed and specimen lots duplicated, can be found at:
museum
Japan Octopodoidea Data Set, museum_taxon
#Taxonomized Japan Octopus Data
museum_clean <- taxon_cleaner(museum, SciName, in_place = TRUE, drop_na = TRUE) #2260 Observations
museum_clean <- museum_clean %>% mutate(SciName = case_when(
SciName == "Octopus vulgaris" ~ "Octopus sinensis",
TRUE ~ SciName))
museum_valid <- taxon_validate(museum_clean, SciName, update_related = TRUE)
valid_report <- attr(museum_valid, "validation_report")
museum_check <- taxon_spellcheck(museum_valid, c(SciName), update = TRUE,
validation_report = valid_report)
check_report <- attr(museum_check, "spellcheck_report")
museum_check <- museum_check %>%
mutate(SciName = case_when(
SciName == "Pinnoctopus macropus" ~ "Callistoctopus macropus",
TRUE ~ SciName
))
museum_taxon <- taxon_add(museum_check, SciName, rank = c("order", "phylum", "family", "genus"),
author_year = FALSE, sort = FALSE)
add_report <- attr(museum_taxon, "add_report")
museum_taxon <- museum_taxon[ -c(3,4)]
museum_taxon <- museum_taxon %>%
dplyr::rename(
"Order" = "order", "Phylum" = "phylum",
"Family" = "family", "Genus" = "genus")
museum_taxon <- taxon_sort(museum_taxon)
museum_taxon <- taxon_cite(museum_taxon, c(Family, Genus, SciName))
cite_report <- attr(museum_taxon, "cite_report")
museum_taxon <- museum_taxon %>%
filter(SciName != "Muusoctopus small in mature") %>%
mutate(Family_cite = case_when(
Family_cite == "Bathypolypodidae" ~ "Bathypolypodidae (G. C. Robson, 1929)",
Family_cite == "Enteroctopodidae" ~ "Enteroctopodidae (Strugnell, M. Norman, Vecchione, Guzik & Allcock, 2014)",
Family_cite == "Megaleledonidae" ~ "Megaleledonidae (Iw. Taki, 1961)",
TRUE ~ Family_cite
))
museum_taxon <- italicize(museum_taxon, c(Genus_cite, SciName_cite))The Japanese Octopodoidea data, with updates to its included
taxonomic data based on functions like taxon_validate(),
can be found at: museum_taxon
A map generated from museum_taxon
is shown below:
world_map <- map_data("world")
japan <- map_data("world", region="japan")
family_labels <- c(
"Octopodidae (D'Orbigny, 1839-1842 in Férussac and D'Orbigny, 1834-1848)" = "Octopodidae\n(D'Orbigny, 1839-1842\nin Férussac and\nD'Orbigny, 1834-1848)",
"Amphitretidae (Hoyle, 1886)" = "Amphitretidae\n(Hoyle, 1886)",
"Enteroctopodidae (Strugnell, M. Norman, Vecchione, Guzik & Allcock, 2014)" = "Enteroctopodidae\n(Strugnell, M. Norman,\nVecchione, Guzik\n& Allcock, 2014)",
"Bathypolypodidae (G. C. Robson, 1929)" = "Bathypolypodidae\n(G. C. Robson, 1929)",
"Megaleledonidae (Iw. Taki, 1961)" = "Megaleledonidae\n(Iw. Taki, 1961)"
)
lon_min <- 125
lon_max <- 150
lat_min <- 25
lat_max <- 50
museum_taxon$Longitude <- as.numeric(museum_taxon$Longitude)
museum_taxon$Latitude <- as.numeric(museum_taxon$Latitude)
genera_per_family <- museum_taxon %>%
select(Genus_cite_italic, Family) %>%
distinct() %>%
count(Family)
family_palettes <- list(
"Amphitretidae" = sequential_hcl(n = 2, palette = "BrwnYl", l = c(30, 55)),
"Bathypolypodidae" = sequential_hcl(n = 1, palette = "Reds", l = c(45, 45)),
"Enteroctopodidae" = sequential_hcl(n = 3, palette = "Peach"),
"Megaleledonidae" = sequential_hcl(n = 1, palette = "YlOrRd", l = c(55, 55)),
"Octopodidae" = sequential_hcl(n = 7, palette = "Purples", l = c(25, 65))
)
genus_family_map <- museum_taxon %>%
select(Genus_cite_italic, Family) %>%
distinct() %>%
arrange(Family, Genus_cite_italic) # arrange so shades are assigned alphabetically
genus_colors <- unlist(lapply(names(family_palettes), function(fam) {
genera <- genus_family_map$Genus_cite_italic[genus_family_map$Family == fam]
colors <- family_palettes[[fam]]
setNames(colors, genera)
}))
# Create ordered breaks grouped by family
genus_order <- museum_taxon %>%
select(Genus_cite_italic, Family, Family_cite) %>%
distinct() %>%
arrange(factor(Family, levels = c("Amphitretidae", "Bathypolypodidae",
"Enteroctopodidae", "Megaleledonidae",
"Octopodidae")),
Genus_cite_italic)
# Step 1 - build genus_order_with_headers
genus_order_with_headers <- genus_order %>%
group_by(Family) %>%
group_modify(~ {
family_cite_label <- paste0("bold(", .y$Family, ")")
bind_rows(
data.frame(
Genus_cite_italic = family_cite_label,
Family_cite = .x$Family_cite[1]
),
.x %>% select(Genus_cite_italic, Family_cite)
)
}) %>%
ungroup() %>%
pull(Genus_cite_italic)
# Step 2 - add spacer before Megaleledonidae
meg_pos <- which(genus_order_with_headers == "bold(Megaleledonidae)")
genus_order_with_headers <- c(
genus_order_with_headers[1:(meg_pos - 1)],
"' '",
genus_order_with_headers[meg_pos:length(genus_order_with_headers)]
)
# Step 3 - build colors
header_colors <- setNames(
rep("#FFFFFF00", 5),
grep("^bold", genus_order_with_headers, value = TRUE)
)
spacer_color <- setNames("#FFFFFF00", "' '")
genus_colors_final <- c(genus_colors, header_colors, spacer_color)
# Step 4 - legend overrides
legend_breaks <- intersect(genus_order_with_headers, names(genus_colors_final))
n <- length(legend_breaks)
spacer_pos <- which(legend_breaks == "' '")
header_pos <- which(grepl("^bold", legend_breaks))
hide_pos <- c(spacer_pos, header_pos)
legend_size <- ifelse(seq_along(legend_breaks) %in% hide_pos, 0, 8)
legend_alpha <- ifelse(seq_along(legend_breaks) %in% hide_pos, 0, 1)
legend_fill <- rep(NA_character_, n)
legend_color <- rep(NA_character_, n)
legend_stroke <- rep(0.5, n)
legend_fill[hide_pos] <- "transparent"
legend_color[hide_pos] <- "transparent"
legend_stroke[hide_pos] <- 0
ggplot(data = world_map, aes(long, lat)) +
geom_polygon(aes(group = group)) +
coord_sf(xlim = c(lon_min - 1, lon_max + 1), ylim = c(lat_min - 1, lat_max + 1),
expand = FALSE) +
geom_point(data = museum_taxon,
aes(x = Longitude, y = Latitude, color = Genus_cite_italic),
size = 3,
position = position_jitter(width = .1, height = .1)) +
labs(x = "Longitude", y = "Latitude", color = "Genus") +
scale_colour_manual(
values = genus_colors_final,
breaks = genus_order_with_headers,
limits = names(genus_colors_final),
labels = function(x) lapply(x, function(i) parse(text = i))
) +
guides(
color = guide_legend(
override.aes = list(
size = legend_size,
alpha = legend_alpha), ncol = 4
)) +
theme(
plot.margin = margin(t = .05, r = 1, b = .05, l = 1, unit = "mm"),
legend.key = element_rect(fill = "transparent", color = "transparent"),
legend.position = "bottom",
legend.title.position = "top",
legend.spacing.y = unit(0.25, "mm"),
legend.spacing.x = unit(1, "mm"),
legend.title = element_text(size = 16),
legend.text = element_text(size = 14),
strip.text = element_text(size = 16),
axis.title = element_text(size = 20),
axis.text.x = element_text(size = 16, angle = 60, hjust = 1),
axis.text.y = element_text(size = 16)
) +
facet_wrap(~Family_cite, nrow = 1, labeller = as_labeller(family_labels))
ggsave("octopodoidea_japan.png", width = 16, height = 7.5, units = "in", dpi = 450)
Octopodoidea occurrences in Japan by family and genus.