section_polygon <- function(section) {
suppressMessages(polygon <- broom::tidy(section))
polygon %<>% dplyr::rename_(.dots = list(Section = "id", EastingSection = "long",
NorthingSection = "lat"))
polygon$Section %<>% factor(levels = levels(section@data$Section))
polygon %<>% dplyr::inner_join(dplyr::select_(section@data, ~-EastingSection, ~-NorthingSection), by = "Section")
polygon
}
waterbody <- function() {
waterbody <- dplyr::data_frame(Easting = 480000, Northing = 5605000, Waterbody = "Trout Lake")
waterbody %<>% dplyr::bind_rows(dplyr::data_frame(Easting = 517500, Northing = 5582500, Waterbody = "Duncan Reservoir"))
waterbody %<>% dplyr::bind_rows(dplyr::data_frame(Easting = 480000, Northing = 5582500, Waterbody = "Lardeau River"))
waterbody %<>% dplyr::bind_rows(dplyr::data_frame(Easting = 492500, Northing = 5562500, Waterbody = "Duncan River"))
waterbody %<>% dplyr::bind_rows(dplyr::data_frame(Easting = 492500, Northing = 5525000, Waterbody = "North Arm\n(Kootenay Lake)"))
waterbody %<>% dplyr::bind_rows(dplyr::data_frame(Easting = 470000, Northing = 5494000, Waterbody = "West Arm\n(Kootenay Lake)"))
waterbody %<>% dplyr::bind_rows(dplyr::data_frame(Easting = 500000, Northing = 5475000, Waterbody = "South Arm\n(Kootenay Lake)"))
waterbody %<>% dplyr::bind_rows(dplyr::data_frame(Easting = 510000, Northing = 5450000, Waterbody = "Kootenay River"))
waterbody
}
#' Plot Section
#'
#' Maps and labels the sections for the klexdatr \code{lex_data} object.
#'
#' @param data The \code{lex_data} object to plot.
#' @return A ggplot2 object.
#' @export
plot_section <- function(data) {
section <- data$section
station <- data$station
polygon <- section_polygon(section)
ggplot2::ggplot(data = section@data, ggplot2::aes_(x = ~EastingSection / 1000,
y = ~NorthingSection / 1000)) +
ggplot2::geom_polygon(data = dplyr::filter_(polygon, ~!hole),
fill = "blue", ggplot2::aes_(group = ~Section)) +
ggplot2::geom_polygon(data = dplyr::filter_(polygon, ~hole),
ggplot2::aes_(group = ~Section), fill = "transparent") +
ggplot2::geom_point(data = station, ggplot2::aes_(x = ~EastingStation / 1000,
y = ~NorthingStation / 1000),
color = "red", alpha = 1/2, size = 1) +
ggplot2::geom_label(data = waterbody(), size = 2,
ggplot2::aes_(label = ~Waterbody, x = ~Easting / 1000,
y = ~Northing / 1000)) +
ggplot2::coord_equal() +
ggplot2::scale_x_continuous(name = "Easting (km)", labels = scales::comma) +
ggplot2::scale_y_continuous(name = "Northing (km)", labels = scales::comma)
}
plot_logical_matrix <- function(x) {
title <- deparse(substitute(x))
x %<>% reshape2::melt()
x$value <- x$value == 1
colnames(x) <- c("Var1", "Var2", "value")
ggplot2::ggplot(data = x, ggplot2::aes_(x = ~Var2, y = ~Var1)) +
ggplot2::geom_point(ggplot2::aes_string(shape = "value", color = "value")) +
ggplot2::scale_color_manual(values = c("red", "black")) +
ggplot2::scale_shape_manual(values = c(17, 16))
}
#' Plot Analysis Data
#'
#' Plots analysis data.
#'
#' @param data The data to plot.
#' @param years A numeric vector of the number of years.
#' @return A ggplot2 object.
#' @export
plot_analysis_data <- function(data, years = 2008:2013) {
stopifnot(is.data.frame(data))
data$Year %<>% factor(, levels = years)
monitored <- dplyr::filter_(data, ~Monitored)
capture <- dplyr::filter_(data, ~Period == PeriodCapture)
spawned <- dplyr::filter_(data, ~Spawned)
moved <- dplyr::filter_(data, ~Moved)
recaptured <- dplyr::filter_(data, ~Recaptured)
ggplot2::ggplot(data = data, ggplot2::aes_(x = ~Season, y = ~Capture)) +
ggplot2::facet_grid(.~Year, drop = FALSE) +
ggplot2::geom_raster(data = monitored, fill = "grey80") +
ggplot2::geom_point(data = capture, color = "red", position = ggplot2::position_nudge(x = -0.38)) +
ggplot2::geom_point(data = moved, color = "grey50", position = ggplot2::position_nudge(x = -0.1333), shape = 18) +
ggplot2::geom_point(data = spawned, color = "blue", position = ggplot2::position_nudge(x = 0.1333), shape = 17) +
ggplot2::geom_point(data = recaptured, position = ggplot2::position_nudge(x = 0.38), shape = 15) +
ggplot2::scale_x_discrete(name = "Season", expand = c(0, 0.5)) +
ggplot2::scale_y_discrete(name = "Capture", expand = c(0, 0.5)) +
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5)) +
ggplot2::theme(axis.text.y = ggplot2::element_text(size = ggplot2::rel(0.6))) +
ggplot2::theme(panel.margin = ggplot2::unit(0, "in"))
}
drop_post_recaps <- function (x) {
x %<>% dplyr::arrange_(~Period)
recap <- which(x$Recaptured)
stopifnot(length(recap) < 2)
if (length(recap))
x %<>% dplyr::slice(1:recap)
x
}
#' Plot Analysis Length
#'
#' Plots analysis length.
#'
#' @param data The data to plot.
#' @param years A numeric vector of the number of years.
#' @return A ggplot2 object.
#' @export
plot_analysis_length <- function(data, years = 2008:2013) {
stopifnot(is.data.frame(data))
data$Year %<>% factor(, levels = years)
data %<>% dplyr::filter_(~as.integer(Period) >= as.integer(PeriodCapture))
capture <- dplyr::filter_(data, ~Period == PeriodCapture)
recapture <- dplyr::filter_(data, ~Recaptured)
data %<>% plyr::ddply(c("Capture"), drop_post_recaps)
ggplot2::ggplot(data = data, ggplot2::aes_(x = ~Date, y = ~Length)) +
ggplot2::geom_line(ggplot2::aes_(group = ~Capture)) +
ggplot2::geom_point(data = capture, color = "red") +
ggplot2::geom_point(data = recapture, shape = 15) +
ggplot2::scale_x_date(name = "Year") +
ggplot2::scale_y_continuous(name = "Fork Length (mm)") +
ggplot2::expand_limits(x = as.Date("2008-01-01", "2013-12-31"))
}
plot_type <- function(data, x, xlab) {
if (is.logical(data[[x]]) | is.factor(data[[x]])) {
return(list(
ggplot2::geom_pointrange(ggplot2::aes_string(ymin = "lower", ymax = "upper"),
position = ggplot2::position_dodge(width = 0.25)),
ggplot2::scale_x_discrete(name = xlab)))
}
list(ggplot2::geom_line(),
ggplot2::geom_line(ggplot2::aes_string(y = "lower"), linetype = "dotted"),
ggplot2::geom_line(ggplot2::aes_string(y = "upper"), linetype = "dotted"),
ggplot2::scale_x_continuous(name = xlab))
}
#' Plot Probability
#'
#' Plots the probability of x
#'
#' @param data1 The first data to plot.
#' @param data2 The second data to plot.
#' @param x A string of the column to plot on the x-axis.
#' @param xlab A string of the x-axis name.
#' @param ylab A string of the y-axis name.
#' @return A ggplot2 object.
#' @export
plot_probability <- function(data1, data2, x, xlab = x, ylab = "Probability (%)") {
data1 %<>% check_data1(values = list(
Species = factor(1),
estimate = c(0, 1),
lower = c(0, 1),
upper = c(0, 1)), min_row = 2)
data2 %<>% check_data1(values = list(
Species = factor(1),
estimate = c(0, 1),
lower = c(0, 1),
upper = c(0, 1)), min_row = 2)
data1 %<>% dplyr::mutate_(.dots = list(Species = ~as.character(Species), Capture = ~NULL))
data2 %<>% dplyr::mutate_(.dots = list(Species = ~as.character(Species), Capture = ~NULL))
data <- dplyr::bind_rows(data1, data2)
data$Species %<>% factor(levels = c(data1$Species[1], data2$Species[1]))
ggplot2::ggplot(data = data, ggplot2::aes_string(x = x, y = "estimate",
group = "Species", color = "Species")) +
plot_type(data, x, xlab) +
ggplot2::scale_y_continuous(name = ylab, labels = scales::percent) +
ggplot2::scale_color_manual(values = c("black", "red")) +
ggplot2::expand_limits(y = c(0, 1))
}
#' Plot Mortality
#'
#' Plots the mortality of x
#'
#' @param data1 The first data to plot.
#' @param data2 The second data to plot.
#' @param x A string of the column to plot on the x-axis.
#' @param xlab A string of the x-axis name.
#' @param ylab A string of the y-axis name.
#' @return A ggplot2 object.
#' @export
plot_mortality <- function(data1, data2, x, xlab = x, ylab = "Mortality") {
data1 %<>% check_data1(values = list(
Species = factor(1),
estimate = c(0, 1),
lower = c(0, 1),
upper = c(0, 2)), min_row = 2)
data2 %<>% check_data1(values = list(
Species = factor(1),
estimate = c(0, 1),
lower = c(0, 1),
upper = c(0, 2)), min_row = 2)
data1 %<>% dplyr::mutate_(.dots = list(Species = ~as.character(Species), Capture = ~NULL))
data2 %<>% dplyr::mutate_(.dots = list(Species = ~as.character(Species), Capture = ~NULL))
data <- dplyr::bind_rows(data1, data2)
data$Species %<>% factor(levels = c(data1$Species[1], data2$Species[1]))
ggplot2::ggplot(data = data, ggplot2::aes_string(x = x, y = "estimate",
group = "Species", color = "Species")) +
plot_type(data, x, xlab) +
ggplot2::scale_y_continuous(name = ylab) +
ggplot2::scale_color_manual(values = c("black", "red")) +
ggplot2::expand_limits(y = 0)
}
#' Plot Time Series
#'
#' Plots a time series
#'
#' @param data The first data to plot.
#' @param y A string of the column to plot on the y-axis.
#' @param x A string of the column to plot on the x-axis.
#' @param xlab A string of the x-axis name.
#' @param ylab A string of the y-axis name.
#' @param from A count of the start year.
#' @param to A count of the end year.
#' @param color A string of the color.
#' @return A ggplot2 object.
#' @export
plot_timeseries <- function(data, y, x = "Year", ylab = y, xlab = x, from = 2008, to = 2013, color = "black") {
check_string(y)
check_string(x)
check_string(ylab)
check_string(xlab)
ribbon <- dplyr::data_frame(xmin = from, xmax = to, ymin = 0, ymax = max(data[[y]], na.rm = TRUE) * 1.05)
ggplot2::ggplot(data = data) +
ggplot2::geom_rect(data = ribbon, fill = "grey66",
ggplot2::aes_string(xmin = "xmin", xmax = "xmax", ymin = "ymin", ymax = "ymax")) +
ggplot2::geom_line(ggplot2::aes_string(x = x, y = y), color = color) +
ggplot2::geom_point(ggplot2::aes_string(x = x, y = y), color = color) +
ggplot2::scale_x_continuous(name = xlab, breaks = seq(1990,2015,by = 5)) +
ggplot2::scale_y_continuous(name = ylab, labels = scales::comma) +
ggplot2::expand_limits(y = 0, x = c(1990, 2016))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.