#' Plots of fishing and spawning biomass status
#'
#' The function Phase.plots provides plots of fishing status versus spawning biomass status.
#'
#' @param x an R list with output from the assessment models.
#' @param DataName string used in plot titles. Defaults to argument \code{x}.
#' @param draft modifies plots for use in a report. When \code{FALSE} main titles
#' are omitted.
#' @param graphics.type a vector of graphics file types to which graphics are saved.
#' When \code{NULL}, no plots are saved.
#' @param use.color plots are made in grayscale when \code{FALSE}.
#' @param start.drop Number of years at the start of the data to be omitted from
#' plots, as when a model includes an initialization period.
#' @param end.drop Number of years at the end of data to be omitted from
#' plots, as when a model includes a projection period.
#' @param year.pos An integer (= 1, 2, 3, or 4) defining the position of text relative to points.
#' The text indicates first and last years in the time series. A value of year.pos=0
#' turns off the text feature.
#' @param from.zero When \code{TRUE}, the Y-axis of each plot
#' starts at zero.
#' @param legend.pos A text string compatible with the \code{legend} function of \code{R}.
#' Defines the position of the legend (ex. "bottomright", "bottom", etc.). The default
#' NULL places text on the plot itself.
#' @param Xaxis.F When \code{TRUE}, F is plotted as the X axis, otherwise, B.
#' @param F.series Character string specifying the name of the F metric to be plotted
#' @param B.series Character string specifying the name of the B (or SSB) metric to be plotted
#' @param F.B.references a list of two character-sting names, the first specifying the
#' fishing reference point and the second the biomass reference point. Insert
#' a value of NULL if reference points are not desired for plotting.
#'
#' @return Graphics
#'
#' @author M Prager
#' @author E Williams
#' @author K Shertzer
#' @author R Cheshire
#' @author K Purcell
#'
#' @examples \donttest{
#' Phase.plots(gag)
#' }
#' @export
Phase.plots <-
function(x, DataName = deparse(substitute(x)), draft = TRUE,
graphics.type = NULL, use.color = TRUE, start.drop = 0, end.drop = 0,
year.pos=1, from.zero = TRUE, legend.pos = NULL, Xaxis.F = TRUE,
F.series = "F.full", B.series = "SSB", F.B.references = list("Fmsy","msst"))
{
if (! ("t.series" %in% names(x)))
{ Errmsg = (paste("Component ", deparse(substitute(x)), "$t.series not found.",
sep = ""))
warning(Errmsg, immediate. = TRUE)
return(invisible(-1))
}
if (! ("parms" %in% names(x)))
{ Errstring = (paste("Component ", deparse(substitute(x)), "$parms not found.",
sep = ""))
warning(Errstring, immediate. = TRUE)
return(invisible(-1))
}
# Find column labeled 'year':
yrcol <- grep("year",names(x$t.series))
if (length(yrcol) != 1)
{ warning("No year column found in x$t.series", immediate. = TRUE)
return(invisible(-1))
}
# Find column labeled F.series:
if (!(F.series %in% names(x$t.series)))
{ Errmsg=paste("No ",F.series, " column found in x$t.series", sep="")
warning(Errmsg, immediate. = TRUE)
return(invisible(-1))
}
if (!(B.series %in% names(x$t.series)))
{ Errmsg=paste("No ",B.series, " column found in x$t.series", sep="")
warning(Errmsg, immediate. = TRUE)
return(invisible(-1))
}
if (!is.null(F.B.references))
{ if (!is.null(F.B.references[[1]]) && !(F.B.references[[1]] %in% names(x$parms)))
{
Errmsg=paste(F.B.references[[1]], " not found in x$parms", sep="")
warning(Errmsg, immediate. = TRUE)
return(invisible(-1))
} else {
hrefstring <- F.B.references[[1]]
hrefindex <- which(names(x$parms) == F.B.references[[1]])
Fref <- unlist(x$parms[hrefindex])
}
if (!is.null(F.B.references[[2]]) && !(F.B.references[[2]] %in% names(x$parms)))
{
Errmsg=paste(F.B.references[[2]], " not found in x$parms", sep="")
warning(Errmsg, immediate. = TRUE)
return(invisible(-1))
} else {
hrefstring <- F.B.references[[2]]
hrefindex <- which(names(x$parms) == F.B.references[[2]])
Bref <- unlist(x$parms[hrefindex])
}
} else {
Fref<-NULL
Bref<-NULL
}
if ((nrow(x$t.series)-end.drop)<=(start.drop + 1))
{ Errmsg=paste("Time series requires at least one datum. Check arguments start.drop and end.drop.", sep="")
warning(Errmsg, immediate. = TRUE)
return(invisible(-1))
}
### Make local copies of data:
yrndx <- (start.drop + 1):(nrow(x$t.series)-end.drop)
Fcol=which(names(x$t.series)==F.series)
Bcol=which(names(x$t.series)==B.series)
F.B.dat <- x$t.series[yrndx, c(Fcol,Bcol), drop = FALSE]
remove.na = !(is.na(F.B.dat[,1])|is.na(F.B.dat[,2]))
yrndx=yrndx[remove.na]
year <- x$t.series$year[yrndx]
F.B.dat <- x$t.series[yrndx, c(Fcol,Bcol), drop = FALSE]
# Get colors for graphical objects:
plot.options = FGGetOptions()
if (use.color) parlist <- plot.options$color
else parlist <- plot.options$bw
clr.points <- parlist$clr.line
### Setup graphics directory:
if (! is.null(graphics.type))
{ write.graphs <- TRUE
GraphicsDirName <- paste(DataName, "-figs/phase", sep="")
} else {
write.graphs <- FALSE
}
### Set graphics parameters, constants, data structures:
savepar <- FGSetPar(draft)
#===========================================================================
if (Xaxis.F) {
# Plot F v B
PlotTitle <- ifelse(draft, paste("F v B Data:", DataName), "")
if (!is.null(Bref)) {ylim <- range(F.B.dat[,2], Bref)
} else {ylim <- range(F.B.dat[,2])}
if (from.zero) ylim <- range(ylim, 0)
lab.y <- B.series
if (!is.null(Fref)) {xlim <- range(F.B.dat[,1], Fref, 0)
} else {xlim <- range(F.B.dat[,1],0)}
par(las=FGSetLas(F.B.dat[,2]))
FGTimePlot(F.B.dat[,1], F.B.dat[,2], lab.x = "F", lab.y = lab.y,
use.color = use.color, xlim=xlim,
ylim = ylim, main = PlotTitle, FGtype = "circles",
href = NULL, hrefnames = NULL )
if (!is.null(Fref)) {abline(v=Fref, lwd=2, lty=2, col="gray55")}
if (!is.null(Bref)) {abline(h=Bref, lwd=2, lty=2, col="gray55")}
points(F.B.dat[,1], F.B.dat[,2], col = clr.points)
lines(F.B.dat[,1], F.B.dat[,2], col = clr.points, lty=1)
points(F.B.dat[length(year),1], F.B.dat[length(year),2], col = clr.points, pch=16)
if (!is.null(Bref))
{ifelse(F.B.references[2]=="msst", Blabel<-"MSST", Blabel<-F.B.references[2])}
if (is.null(legend.pos)) {
if (!is.null(Fref))
{
ifelse(xlim[2]==Fref, tpos<-2, tpos<-4)
text(Fref, ylim[1],labels=F.B.references[1], pos=tpos, cex=0.85, offset=0.35, col="gray55")
}
if (!is.null(Bref))
{
ifelse(ylim[2]==Bref, tpos<-1, tpos<-3)
ifelse(nchar(Blabel)<6, x.shift<-0.01, x.shift<-0.08)
text(xlim[1]+x.shift,Bref,labels=Blabel, pos=tpos, cex=0.85, offset=0.35, col="gray55")
}
} else {
if (!is.null(F.B.references)) {
ifelse (is.null(Fref), Fstring<-"", Fstring<-paste("F reference: ",F.B.references[1],sep=""))
ifelse (is.null(Bref), Bstring<-"", Bstring<-paste("B reference: ", Blabel, sep=""))
if (Fstring=="") {legend.text<-Bstring
} else if (Bstring=="") {legend.text<-Fstring
} else {legend.text=c(Fstring,Bstring)}
legend(legend.pos, legend=legend.text,bg="white", text.col="gray55")
}
}
if (year.pos>0){
text (x=F.B.dat[1,1], y=F.B.dat[1,2],
labels=year[1], pos=year.pos, cex=0.85, offset=0.35)
text (x=F.B.dat[length(year),1], y=F.B.dat[length(year),2],
labels=year[length(year)], pos=year.pos, cex=0.85, offset=0.35)
}
if (write.graphs) FGSavePlot(GraphicsDirName, DataName,
GraphName = "phase.FvB", graphics.type)
#===========================================================================
# Plot Relative F v B
if (!is.null(Fref) && !is.null(Bref))
{
PlotTitle <- ifelse(draft, paste("Relative F v B Data:", DataName), "")
ylim <- range(F.B.dat[,2]/Bref, 1)
if (from.zero) ylim <- range(ylim, 0)
lab.y <- paste(B.series, " / ", Blabel, sep="")
xlim <- range(F.B.dat[,1]/Fref, 1, 0)
lab.x <- paste("F / ", F.B.references[1], sep="")
par(las=FGSetLas(F.B.dat[,2]/Bref))
FGTimePlot(F.B.dat[,1]/Fref, F.B.dat[,2]/Bref, lab.x = lab.x, lab.y = lab.y,
use.color = use.color, xlim=xlim,
ylim = ylim, main = PlotTitle, FGtype = "circles",
href = NULL, hrefnames = NULL )
abline(v=1, lwd=2, lty=2, col="gray55")
abline(h=1, lwd=2, lty=2, col="gray55")
points(F.B.dat[,1]/Fref, F.B.dat[,2]/Bref, col = clr.points)
lines(F.B.dat[,1]/Fref, F.B.dat[,2]/Bref, col = clr.points, lty=1)
points(F.B.dat[length(year),1]/Fref, F.B.dat[length(year),2]/Bref, col = clr.points, pch=16)
if (year.pos>0){
text (x=F.B.dat[1,1]/Fref, y=F.B.dat[1,2]/Bref,
labels=year[1], pos=year.pos, cex=0.85, offset=0.35)
text (x=F.B.dat[length(year),1]/Fref, y=F.B.dat[length(year),2]/Bref,
labels=year[length(year)], pos=year.pos, cex=0.85, offset=0.35)
}
if (write.graphs) FGSavePlot(GraphicsDirName, DataName,
GraphName = "phase.FvB.rel", graphics.type)
}
} # End Xaxis.F
#===========================================================================
if (!Xaxis.F) {
# Plot B v F
PlotTitle <- ifelse(draft, paste("B v F Data:", DataName), "")
if (!is.null(Fref)) {ylim <- range(F.B.dat[,1], Fref)
} else {ylim <- range(F.B.dat[,1])}
if (from.zero) ylim <- range(ylim, 0)
lab.x <- B.series
if (!is.null(Bref)) {xlim <- range(F.B.dat[,2], Bref, 0)
} else {xlim <- range(F.B.dat[,2],0)}
par(las=FGSetLas(F.B.dat[,1]))
FGTimePlot(F.B.dat[,2], F.B.dat[,1], lab.x = lab.x, lab.y = "F",
use.color = use.color, xlim=xlim,
ylim = ylim, main = PlotTitle, FGtype = "circles",
href = NULL, hrefnames = NULL )
if (!is.null(Fref)) {abline(h=Fref, lwd=2, lty=2, col="gray55")}
if (!is.null(Bref)) {abline(v=Bref, lwd=2, lty=2, col="gray55")}
points(F.B.dat[,2], F.B.dat[,1], col = clr.points)
lines(F.B.dat[,2], F.B.dat[,1], col = clr.points, lty=1)
points(F.B.dat[length(year),2], F.B.dat[length(year),1], col = clr.points, pch=16)
if (!is.null(Bref))
{ifelse(F.B.references[2]=="msst", Blabel<-"MSST", Blabel<-F.B.references[2])}
if (is.null(legend.pos)) {
if (!is.null(Bref))
{
ifelse(xlim[2]==Bref, tpos<-2, tpos<-4)
text(Bref, ylim[1],labels=Blabel, pos=tpos, cex=0.85, offset=0.35, col="gray55")
}
if (!is.null(Fref))
{
ifelse(ylim[2]==Fref, tpos<-1, tpos<-3)
ifelse(nchar(F.B.references[1])<6, x.shift<-0.01, x.shift<-0.08)
text(xlim[1]+x.shift,Fref,labels=F.B.references[1], pos=tpos, cex=0.85, offset=0.35, col="gray55")
}
} else {
if (!is.null(F.B.references)) {
ifelse (is.null(Fref), Fstring<-"", Fstring<-paste("F reference: ",F.B.references[1],sep=""))
ifelse (is.null(Bref), Bstring<-"", Bstring<-paste("B reference: ", Blabel, sep=""))
if (Fstring=="") {legend.text<-Bstring
} else if (Bstring=="") {legend.text<-Fstring
} else {legend.text=c(Fstring,Bstring)}
legend(legend.pos, legend=legend.text,bg="white", text.col="gray55")
}
}
if (year.pos>0){
text (x=F.B.dat[1,2], y=F.B.dat[1,1],
labels=year[1], pos=year.pos, cex=0.85, offset=0.35)
text (x=F.B.dat[length(year),2], y=F.B.dat[length(year),1],
labels=year[length(year)], pos=year.pos, cex=0.85, offset=0.35)
}
if (write.graphs) FGSavePlot(GraphicsDirName, DataName,
GraphName = "phase.BvF", graphics.type)
#===========================================================================
# Plot Relative F v B
if (!is.null(Fref) && !is.null(Bref))
{
PlotTitle <- ifelse(draft, paste("Relative B v F Data:", DataName), "")
ylim <- range(F.B.dat[,1]/Fref, 1)
if (from.zero) ylim <- range(ylim, 0)
lab.y <- paste("F / ", F.B.references[1], sep="")
xlim <- range(F.B.dat[,2]/Bref, 1, 0)
lab.x <- paste(B.series," / ", Blabel, sep="")
par(las=FGSetLas(F.B.dat[,1]/Fref))
FGTimePlot(F.B.dat[,2]/Bref, F.B.dat[,1]/Fref, lab.x = lab.x, lab.y = lab.y,
use.color = use.color, xlim=xlim,
ylim = ylim, main = PlotTitle, FGtype = "circles",
href = NULL, hrefnames = NULL )
abline(v=1, lwd=2, lty=2, col="gray55")
abline(h=1, lwd=2, lty=2, col="gray55")
points(F.B.dat[,2]/Bref, F.B.dat[,1]/Fref, col = clr.points)
lines(F.B.dat[,2]/Bref, F.B.dat[,1]/Fref, col = clr.points, lty=1)
points(F.B.dat[length(year),2]/Bref, F.B.dat[length(year),1]/Fref, col = clr.points, pch=16)
if (year.pos>0){
text (x=F.B.dat[1,2]/Bref, y=F.B.dat[1,1]/Fref,
labels=year[1], pos=year.pos, cex=0.85, offset=0.35)
text (x=F.B.dat[length(year),2]/Bref, y=F.B.dat[length(year),1]/Fref,
labels=year[length(year)], pos=year.pos, cex=0.85, offset=0.35)
}
if (write.graphs) FGSavePlot(GraphicsDirName, DataName,
GraphName = "phase.BvF.rel", graphics.type)
}
} # End Xaxis.F
#===========================================================================
par(savepar) # reset graphics device
return(invisible(0))
} # End of function definition
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.