0#' plot a timeline of all deployed tags
#'
#' This generates an html file with preformatted text which shows
#' a tag timeline when viewed in a fixed-width font.
#'
#' @param sort character vector of field names by which to sort. Default:
#' NULL, which means sort by \code{projCode, sort, nomFreq, mfgID} (i.e.
#' by manufacturer's tag ID within nominal frequency within taxonomic
#' species order, within project code.
#'
#' @param filename filename to save plot; Default: "/sgm/pub/motus_tag_timeline.html"
#'
#' @return a data_frame with these columns:
#' \itemize{
#' \item motusID
#' \item projectID
#' \item projCode
#' \item fullID
#' \item mfgID
#' \item nomFreq
#' \item period
#' \item speciesID
#' \item speciesName
#' ...
#' }
#'
#' @export
#'
#' @author John Brzustowski \email{jbrzusto@@REMOVE_THIS_PART_fastmail.fm}
plotTagTimeline = function(sort = c("projCode", "dateBin", "sort", "nomFreq", "iMfgID"), filename="/sgm/pub/motus_tag_timeline.html") {
f = file(filename, "w")
s = safeSrcSQLite(MOTUS_METADB_CACHE)
mot = tbl(s, "tags")
proj = tbl(s, "projs") %>% mutate(projCode=label)
sp = tbl(s, "species")
hist = mot %>% collect
hist = hist %>%
left_join (sp, by=c(speciesID="id"), copy=TRUE) %>%
left_join (proj, by=c(projectID="id"), copy=TRUE) %>%
mutate_ (fullID = ~sprintf("%s:%.1f#%s@%g", mfgID, period, projCode, nomFreq),
iMfgID = ~as.integer(mfgID)) %>%
collect %>% as.data.frame
hist$english[is.na(hist$english)] = " ? "
hist = hist[do.call(order, hist[,sort]), ]
hist = subset(hist, ! projCode %in% c("Lorng", "Loring"))
class(hist$tsStart) = class(hist$tsEnd) = c("POSIXt", "POSIXct")
idw = max(nchar(hist$fullID))
nmw = max(nchar(hist$english))
hdr = stri_dup(" ", idw + nmw + 1 + 6 + 6)
years = year(min(hist$tsStart)) : year(max(hist$tsEnd))
numYears = length(years)
moStart = ymd(outer(1:12, years, function(x,y) paste(y, x, 1, sep="-")))
moEnd = c(moStart[-1] - 24*3600, tail(moStart, 1) + 31 * 24 * 3600)
ystr = paste0(sprintf(paste0("%", nmw, "s| Motus ID |%", idw, "s|%s"), "Species Name", "Full Tag ID", "Span"), "|", paste(sprintf(" %4d ", years), collapse="|"))
mstr = paste0(sprintf(paste0("%", nmw, "s|Proj.| Tag |%", idw, "s|Code"), "", ""), "|", paste(rep("JFMAMJJASOND", numYears), collapse="|"))
sep = paste0(stri_dup("-", nchar(hdr)), "|", paste(rep("------------", numYears), collapse="+"))
empty = stri_dup(" .", 6 * numYears)
hist$col1 = 12 * (year(hist$tsStart) - years[1]) + month(hist$tsStart)
hist$col2 = 12 * (year(hist$tsEnd) - years[1]) + month(hist$tsEnd)
hist$line = empty
stri_sub(hist$line, from=hist$col1, to=hist$col2) = stri_dup("X", hist$col2-hist$col1 + 1)
hist$line=stri_replace_all(hist$line, "$1|", regex="([. X]{12})(?=[. X])")
hist$line = sprintf(paste0("%", nmw, "s|%5d|%5d|%", idw, "s|%1d-%1d |%s"), hist$english, hist$projectID, hist$tagID, hist$fullID, hist$tsStartCode, hist$tsEndCode, hist$line)
writeLines('
<html>
<head>
<meta http-equiv="cache-control" content="max-age=0" />
<meta http-equiv="cache-control" content="no-cache" />
<meta http-equiv="expires" content="0" />
<meta http-equiv="expires" content="Tue, 01 Jan 1980 1:00:00 GMT" />
<meta http-equiv="pragma" content="no-cache" />
</head>
<body>
<h3>Motus Tag Deployment Windows - Generated', f)
writeLines(format(Sys.time()), f)
writeLines(' </h3>
Estimated tag deployment windows are shown, rounded outward to the nearest month boundary<br>
(i.e. an <em>X</em> is shown if the tag was active during any portion of the month).<br>
<br>
SpanCode indicates how lifespan was computed. A span code of X-Y indicates<br>
the start date was computed using method X, and the end date was computed using method Y,<br>
where X and Y are indicated in the list below.<br><br>
Start dates are selected using these items from the <a href="http://motus.org">motus</a> database,<br>
in order of preference (i.e. the first available item is used):<br>
<ul>
<li> tsStart - the starting date for a tag deployment record; spanCode X=1
<li> dateBin - the start of the quarter year in which the tag was expected to be deployed; spanCode X=2
<li> ts - the date the tag was registered; spanCode X=3
</ul>
<br>
Tag deactivation events are generated using these items, again in order of preference:<br>
<ul>
<li> <em>tsEnd</em> - the ending date for a tag deployment; e.g. if a tag was found, or manually deactivated; spanCode Y=1
<li> <em>tsStart</em> for a different deployment of the same tag; spanCode Y=2
<li> <em>tsStart + predictTagLifespan(model, BI) * marginOfError</em> , if the tag model is known; spanCode Y=3
<li> <em>tsStart + >predictTagLifespan(guessTagModel(speciesID), BI) * marginOfError</em>
, if the species is known; spanCode Y=4
<li> 90 days if no other information is available; spanCode Y=5
</ul>
<em>BI</em> is the tag burst interval, in seconds, and <em>marginOfError</em> has been chosen to be 50%.<br>
<em>predictTagLifespan</em> is an R function that models tag life as a function of tag model and burst interval;<br>
it is based on a simple model of power consumption, and agrees well with the specs
published by Lotek. Details of the model are <a href="https://github.com/jbrzusto/motusServer/blob/master/inst/doc/modelLotekTagLifeSpan.pdf">here.</a></br>
<em>guessTagModel</em> associates a default tag model with each species,<br>
where we have reason to believe that model is the one most commonly used for it.<br>
<br>
<pre>', f)
linesPerChunk = 40
i = 1
numChunk = ceiling(nrow(hist) / linesPerChunk)
for (i in seq_len(numChunk)) {
writeLines(c(ystr, mstr), f)
li = seq(from = 1 + (i - 1) * linesPerChunk, to = min(nrow(hist), i * linesPerChunk ))
writeLines(hist$line[li], f)
i = i + linesPerChunk
}
writeLines("</pre></body</html>", f)
close(f)
return(invisible(hist))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.