R/VMS_from_MARFIS.R

In Maritimes/Mar.utils: A suite of functions used by a variety of Maritimes packages

#' @title VMS_from_MARFIS
#' @description This function takes a dataframe (with coordinate fields in decimal
#' degrees), and extracts asssociated VMS data
#' @param df a dataframe to be analyzed. 
#' @param fn.oracle.username default is \code{'_none_'} This is your username for
#' accessing oracle objects. For this function, it needs SELECT privileges on MFD_OBFMI.VMS_ALL. 
#' @param fn.oracle.password default is \code{'_none_'} This is your password for
#' accessing oracle objects. 
#' @param fn.oracle.dsn default is \code{'_none_'} This is your dsn/ODBC
#' identifier for accessing oracle objects. 
#' @param usepkg default is \code{'rodbc'}. This indicates whether the 
#' connection to Oracle should use \code{'rodbc'} or \code{'roracle'} to 
#' connect.  rodbc is slightly easier to setup, but roracle will extract data ~ 
#' 5x faster.
#' @param data.dir  the default is \code{NULL}. If you are hoping to load existing data,
#' this folder should contain a data folder containing your rdata files. For this function, only
#' MARFLEETS_LIC will be used, and only to add gear and licenced species onto each record.
#' @param VR_field the default is \code{"VR_NUMBER"}
#' @param LIC_field the default is \code{"LICENCE_ID"}
#' @param GC_field the default is \code{"GEAR_CODE"}
#' @param LANDED_field the default is \code{"LANDED_DATE"}
#' @param look_ahead_days the default is \code{7}
#' @param lat.field the default is \code{NULL}. This is the name of the field holding latitude values 
#' (in decimal degrees)
#' @param lon.field the default is \code{NULL}. This is the name of the field holding longitude 
#' values (in decimal degrees)
#' @param make_segments the default is \code{TRUE}. This indicates whether or not the results should
#' include an sp object of all of the VMS data as lines (in addition to a data frame)
#' @param make_segments_spatial the default is \code{FALSE}. This indicates whether or not a shapefile
#' should be created of all of the VMS data as lines (in addition to a data frame). 
#' \code{make_segments} must be TRUE for shapefiles to be generated. 
#' @import data.table
#' @return a list containing a data.frame called "marf_VMS" of the joined marfis/VMS data, and, 
#' if \code{make_segments} is TRUE, an sp object called "marf_VMS_segments". Additionally, if 
#' make_segments and make_segments_shp are bothe TRUE, a shapefile will be created in the working 
#' directory.
#' @author  Mike McMahon, \email{Mike.McMahon@@dfo-mpo.gc.ca}
#' @export
VMS_from_MARFIS <- function(df=NULL,
                            fn.oracle.username = "_none_", 
                             fn.oracle.password = "_none_", 
                             fn.oracle.dsn = "_none_",
                             usepkg = 'rodbc',
                             data.dir=NULL,
                             VR_field = "VR_NUMBER",
                             LIC_field = "LICENCE_ID",
                             GC_field = "GEAR_CODE",
                             LANDED_field = "LANDED_DATE",
                             look_ahead_days = 7,
                             lat.field = NULL,
                             lon.field = NULL,
                             make_segments=TRUE,
                             make_segments_spatial = FALSE){
  #data.table doesn't like column name references - ensure the col names are known
  VR_NUMBER <- LANDED_DATE <- pseudo_start<- MARFLEETS_LIC <- LICENCE_ID <- GEAR_CODE <- POSITION_UTC_DATE <- NULL
  colnames(df)[colnames(df)==VR_field] <- "VR_NUMBER"
  colnames(df)[colnames(df)==LIC_field] <- "LICENCE_ID"
  colnames(df)[colnames(df)==GC_field] <- "GEAR_CODE"
  colnames(df)[colnames(df)==LANDED_field] <- "LANDED_DATE"
  
  df<-df[!is.na(df$VR_NUMBER) & !is.na(df$LICENCE_ID) & !is.na(df$GEAR_CODE), ]
  
  bbox <- NA
  if (!is.null(lat.field) && !is.null(lon.field)){
    df<- unique(df[,c("VR_NUMBER", "LICENCE_ID", "GEAR_CODE", "LANDED_DATE", lat.field, lon.field)])
    bbox <- c(range(df[!is.na(df[lat.field]),lat.field]), 
              range(df[!is.na(df[lon.field]),lon.field]))
  }else{
    df<- unique(df[,c("VR_NUMBER", "LICENCE_ID", "GEAR_CODE", "LANDED_DATE")])
  }
 
  df <- data.table::setDT(df) 
  df <- data.table::setorder(df, VR_NUMBER, LANDED_DATE) 
  df <-df[, pseudo_start := shift(LANDED_DATE, type= "lag"), by= VR_NUMBER ]
  df <- data.table::setDF(df) 
  df[is.na(df$pseudo_start),"pseudo_start"] <- df[is.na(df$pseudo_start),"LANDED_DATE"] - as.difftime(look_ahead_days, units="days")
  dateRange <- as.Date(c(min(df$pseudo_start), max(df$LANDED_DATE)))
  vrns<- sort(unique(df$VR_NUMBER))
  message("Starting VMS extraction - this can take a long time - grab a coffee")
  if (all(is.na(bbox))){
    theVMS <- VMS_get_recs(fn.oracle.username = fn.oracle.username, 
                           fn.oracle.password = fn.oracle.password, 
                           fn.oracle.dsn = fn.oracle.dsn,
                           usepkg = usepkg,
                           vrnList = vrns,
                           dateStart = as.character(min(dateRange)),
                           dateEnd = as.character(max(dateRange)),  
                           rowNum = 1000000, 
                           quietly = T)
  }else{
    theVMS <- VMS_get_recs(fn.oracle.username = fn.oracle.username, 
                           fn.oracle.password = fn.oracle.password, 
                           fn.oracle.dsn = fn.oracle.dsn,
                           usepkg = usepkg,
                           vrnList = vrns,
                           dateStart = as.character(min(dateRange)),
                           dateEnd = as.character(max(dateRange)),  
                           minLat = bbox[1], maxLat=bbox[2], 
                           minLon = bbox[3], maxLon=bbox[4],
                           rowNum = 1000000, 
                           quietly = T)
  }
  if (nrow(theVMS)==1000000)warning("Hit extraction row limit")
  theVMS <- Mar.utils::VMS_clean_recs(df=theVMS)
  theVMS$VR_NUMBER <- as.numeric(theVMS$VR_NUMBER)
  theVMS$elapsedDist_m <- theVMS$elapsedTime_min  <- NULL
  
  # theVMS <- readRDS("theVMS.RDS")
  df<-unique(df[df$VR_NUMBER %in% theVMS$VR_NUMBER,])
  
  #change dates to posixct so they can be compared to vms
  df$LANDED_DATE <- as.POSIXct(df$LANDED_DATE)
  df$pseudo_start <- as.POSIXct(df$pseudo_start)
  #maybe output the vessels for which no VMS was found (and were dropped)
  
  #filtered landings, now filter VMS to ensure we have VMS data to join
  theVMS <- theVMS[theVMS$VR_NUMBER %in% df$VR_NUMBER,]
  
  #associate all of the vms date with fishing activity where the positions are between the 'pseudo-start'
  #and the LANDED_DATE
  combined=sqldf::sqldf("select * 
                 from theVMS v left join df m on 
                 v.VR_NUMBER = m.VR_NUMBER and 
                 v.POSITION_UTC_DATE between m.pseudo_start and m.LANDED_DATE")
  #remove duplicate (VR) column
  combined <- combined[!is.na(combined$LICENCE_ID), !duplicated(colnames(combined))]
  
  if (!is.null(data.dir)){
    e = new.env()
    get_data_tables(usepkg = usepkg, fn.oracle.username = fn.oracle.username, fn.oracle.password = fn.oracle.password, fn.oracle.dsn = fn.oracle.dsn, 
                    schema = "MARFISSCI", data.dir = data.dir, tables = "MARFLEETS_LIC", env = e)
    theseLics <- unique(e$MARFLEETS_LIC[e$MARFLEETS_LIC$LICENCE_ID %in% combined$LICENCE_ID, c("LICENCE_ID", "GEAR_CODE","GEAR", "SPECIES")])
    combined <- merge(combined, theseLics, by=c("LICENCE_ID", "GEAR_CODE"), all.x=T)
  }else{
    message("If a data.dir provided, GEAR and Licenced species informaton will be added to the output.")
  }
  combined <- data.table::setorder(combined, VR_NUMBER, LICENCE_ID, GEAR_CODE, POSITION_UTC_DATE)  #LICENCE_ID, GEAR_CODE, 
  res<-list()
  res$marf_VMS <- combined
  combined$m.pseudo_start <- NULL
  res$marf_VMS_Segments <- NA
  if(make_segments) {
    these_segs <- Mar.utils::make_segments(combined, objField = "trek",seqField = "POSITION_UTC_DATE", create.spatiall = make_segments_spatial, filename = "marf_VMS_segs")
    res$marf_VMS_Segments <- these_segs$segments
  }
  return(res)
}