bison_base <- function() "https://bison.usgs.gov"
bs_compact <- function(l) Filter(Negate(is.null), l)
mssg <- function(x, y) if (x) message(y)
#' Check if object is of class bison
#' @param x input
#' @export
is.bison <- function(x) inherits(x, "bison")
#' Check if object is of class bison_solr
#' @param x input
#' @export
is.bison_solr <- function(x) inherits(x, "bison_solr")
bison_blanktheme <- function(){
theme(axis.line=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank(),
plot.margin = rep(unit(0,"null"),4))
}
# Function to make map form lat/long data
# param x The input
# param geom Geom to use, one of geom_point or geom_jitter.
# param jitter Jitter points.
# param customize Customize ggplot2 plot.
# param ... Further parameters passed on to bisonmap function
bison_map_maker <- function(x, geom, jitter, customize) {
long = lat = group = decimalLongitude = decimalLatitude = region = id = NULL
if (inherits(x, "bison")) {
tt <- x$points
} else {
tt <- x$points
}
# if no lat/lon fields, stop
if (!all(c("decimalLatitude", "decimalLongitude") %in% names(tt))) {
stop("points data has no decimalLatitude and decimalLongitude fields",
call. = FALSE)
}
# Make lat/long data numeric
tt$decimalLatitude <- as.numeric(as.character(tt$decimalLatitude))
tt$decimalLongitude <- as.numeric(as.character(tt$decimalLongitude))
# Remove points that are not physically possible
tt <- tt[stats::complete.cases(tt$decimalLatitude, tt$decimalLongitude), ]
imp <- which(abs(tt$decimalLatitude) >= 90 | abs(tt$decimalLongitude) >= 180)
if (length(imp) > 0) tt <- tt[-imp, ]
# Check if points are inside the contintental US, or US+Alaska, or
# US+Alaska+Hawaii, or even farther
if (
all(all(tt$decimalLatitude < 49) &
all(tt$decimalLatitude > 24.7433195) &
all(tt$decimalLongitude > -130) &
all(tt$decimalLongitude < -66.9513812))) {
# plot only contiguous USA
contig_layer <- subset(all_states, id != "Alaska" & id != "Hawaii")
tt_contig <- tt[point.in.polygon(
tt$decimalLongitude,
tt$decimalLatitude,
contig_layer$long,contig_layer$lat) == 1, ]
p <- ggplot() +
geom_polygon(aes(x = long, y = lat, group = group), colour = "black",
fill = NA, size = 0.25) +
coord_map(projection = "azequalarea") +
bison_blanktheme()
p %+% droplevels(subset(all_states, id != "Alaska" & id != "Hawaii")) +
geom_point(data = droplevels(tt_contig),
aes(decimalLongitude, decimalLatitude), size = 3,
colour = "red", position = jitter) +
scale_x_continuous(expand = c(0,0)) + scale_y_continuous(expand = c(0,0))
} else
if (all(all(tt$decimalLatitude < 75) &
all(tt$decimalLatitude > 15) &
all(tt$decimalLongitude > -170) &
all(tt$decimalLongitude < -66.9513812))) {
# plot contiguous USA + Alaska + Hawaii
contig_layer <- subset(all_states, id != "Alaska" & id != "Hawaii")
AK_layer <- subset(all_states, id == "Alaska")
HI_layer <- subset(all_states, id == "Hawaii")
tt_contig <- tt[point.in.polygon(
tt$decimalLongitude,
tt$decimalLatitude,contig_layer$long,contig_layer$lat) == 1,]
tt_AK <- tt[point.in.polygon(
tt$decimalLongitude,
tt$decimalLatitude,AK_layer$long,AK_layer$lat) == 1,]
tt_HI <- tt[point.in.polygon(
tt$decimalLongitude,
tt$decimalLatitude,HI_layer$long,HI_layer$lat) == 1,]
p <- ggplot() +
geom_polygon(aes(x = long, y = lat, group = group),
colour = "black", fill = NA, size = 0.25) +
coord_map(projection = "azequalarea") +
scale_x_continuous(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0)) +
bison_blanktheme()
AK <- p %+% subset(all_states, id == "Alaska") +
theme(legend.position = "none") +
geom_point(data = tt_AK,
aes(decimalLongitude, decimalLatitude),
size = 3, colour = "red", position = jitter)
HI <- p %+% subset(all_states, id == "Hawaii") +
theme(legend.position = "none") +
geom_point(data = tt_HI,
aes(decimalLongitude, decimalLatitude),
size = 3, colour = "red", position = jitter)
contiguous <- p %+% subset(all_states, id != "Alaska" & id != "Hawaii") +
geom_point(data = tt_contig, aes(decimalLongitude, decimalLatitude),
size = 3, colour = "red", position = jitter)
thing <- function(aa, bb, cc) {
grid.newpage()
vp <- viewport(width = 1.3, height = 1.3, y = 0.6)
print(aa, vp = vp)
subvp1 <- viewport(width = 0.4, height = 0.4, x = 0.18, y = 0.25)
print(bb, vp = subvp1)
subvp2 <- viewport(width = 0.25, height = 0.25, x = 0.64, y = 0.22)
print(cc, vp = subvp2)
}
thing(contiguous, AK, HI)
} else {
# plot world (minus Antarticta)
world <- map_data(map = "world") # get world map data
world <- subset(world, region != "Antarctica") # remove Antarctica
message(
"Some of your points are outside the US. Make sure the data is correct")
ggplot(world, aes(long, lat)) +
geom_polygon(aes(group = group), fill = "white", color = "gray40",
size = 0.2) +
geom_point(data = tt, aes(decimalLongitude, decimalLatitude),
size = 3, colour = "red", position = jitter) +
labs(x = "", y = "") +
bison_blanktheme() +
customize
}
}
not_num <- function(x) {
z <- tryCatch(as.numeric(as.character(x)),
warning = function(w) w, error = function(e) e)
any(c("error", "warning") %in% class(z))
}
not_date <- function(x) {
z <- tryCatch(as.Date(as.character(x)),
warning = function(w) w, error = function(e) e)
any(c("error", "warning") %in% class(z))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.