#' Build the model meta.data
#'
#' From a model definition build the \code{dsmodel} part of the model.
#'
#' @param df a data filter object
#' @param transect type of transect
#' @param data the data used in the model
#' @return a character string starting with \code{meta.data=}
#'
#' @author David L Miller
#' @importFrom stringr str_c
make_meta.data <- function(df, transect, data){
# get left truncation
if(!is.null(df$Distance$Left)){
left <- as.numeric(df$Distance$Left)
}else{
left <- 0
}
# get right truncation (distance)
if(!is.null(df$Distance$Width)){
width <- as.numeric(df$Distance$Width)
}else{
width <- NA
}
# truncation may also be specified as a percentage
if(!is.null(df$Distance$Rtruncate)){
width <- quantile(data$distance,
probs=1-as.numeric(df$Distance$Rtruncate),
na.rm=TRUE)
}
# binned data can be specified as "Intervals"
if(!is.null(df$Distance$Intervals)){
intervals <- df$Distance$Intervals
# extract the bin cutpoints -- make a vector
cuts <- eval(parse(text=paste0("c(",
paste(intervals, collapse=","),
")")))
# remove those outside the truncation
cuts <- cuts[cuts >= left & cuts <= width]
# make the breaks and binned arguments
breaks <- paste0("breaks=c(", paste(cuts, collapse=","), ")")
binned <- "binned=TRUE"
}else if(!is.null(df$Distance$Nclass)){
# or the number of bins -- "Nclass"
# make the breaks and binned arguments
breaks <- paste0("breaks=c(",
paste(seq(left, width,
length.out=as.numeric(df$Distance$Nclass)+1),
collapse=","), ")")
binned <- "binned=TRUE"
}else{
breaks <- NULL
binned <- NULL
}
if(transect == "point"){
transect <- "point=TRUE"
}else{
transect <- NULL
}
meta <- paste0("meta.data=list(width=", width, ",",
str_c(paste0("left=", left),
breaks,
binned,
transect, sep=","),")")
return(meta)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.