Merge branch 'master' into SeanOverhaul

.Rbuildignore

@@ -4,3 +4,6 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^\.github$
+^other$
+^output$

.github/.gitignore

@@ -0,0 +1 @@
+*.html

.github/workflows/pkgdown.yml

@@ -1,4 +1,4 @@
-name: deploy to github pages
+name: gh-pages
 
 on:
   push:
@@ -18,6 +18,11 @@ jobs:
 
       - uses: r-lib/actions/setup-pandoc@v1
 
+      - name: Install GDAL
+        run: |
+            brew install gdal
+            brew install proj
+
       - name: Query dependencies
         run: |
           install.packages('remotes')

DESCRIPTION

@@ -1,27 +1,38 @@
 Package: comlandr
 Title: Pulls and processes commercial fishing data
-Version: 0.0.0.9000
+Version: 0.3.0
 Authors@R: c(person("Sean", "Lucey", email = "[email protected]", role = c("aut","cre")),
     person("Andy", "Beet", email = "[email protected]", role = c("aut")))
 Description: Pulls and processes commercial fishing data (US and NAFO)
+URL: https://github.com/NOAA-EDAB/comlandr
+BugReports: https://github.com/NOAA-EDAB/comlandr/issues
 License: file LICENSE
 Encoding: UTF-8
 LazyData: true
+Depends: 
+    R (>= 3.5.0)
 Suggests: 
     knitr,
     rmarkdown,
-    testthat
+    testthat (>= 3.0.0),
+    markdown,
+    patchwork,
+    readr,
+    kableExtra,
+    tidyr,
+    ggforce
 VignetteBuilder: knitr
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Imports: 
     data.table,
     sf,
     DBI,
     odbc,
     magrittr,
-    ggplot2
+    ggplot2,
+    dbutils,
+    survdat
 Remotes:
     andybeet/dbutils,
     NOAA-EDAB/survdat
-Depends: 
-    R (>= 2.10)
+Config/testthat/edition: 3

NAMESPACE

@@ -10,7 +10,18 @@ export(get_comdisc_raw_data)
 export(get_comland_data)
 export(get_comland_raw_data)
 export(get_herring_data)
+export(get_areas)
+export(get_comland_data)
+export(get_foreign_data)
+export(get_gears)
+export(get_locations)
+export(get_ports)
+export(get_species)
+export(get_species_itis)
+export(get_vessels)
 export(plot_comland)
+export(process_foreign_data)
+export(process_foreign_data_skate_hake)
 importFrom(data.table,":=")
 importFrom(data.table,"as.data.table")
 importFrom(data.table,"key")

R/Comland.r

@@ -5,7 +5,7 @@
 #'SML
 #'
 #'@param channel an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect
-#' to communicate with the database engine. (see \code{\link{connect_to_database}})
+#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})
 #'@param EPUS List. Designates the stat areas that comprise an EPU. Default = EPUs (lazily loaded data)
 #'@param GEARS List. Designates the NEGEAR codes that comprise a fishing fleet. Default = GEARs (lazily loaded data)
 #'@param use.existing String. Pull from database "n" or use existing pull "y" (saves time) . Default = "y"
@@ -115,13 +115,6 @@ if(use.existing == 'n'){
   comland$AREA <- as.integer(comland$AREA)
   #comland$AREA <- as.factor(comland$AREA)
 
-  # # fixes needed when data is pulled using RODBC
-  # comland <- comland %>% dplyr::mutate_if(is.factor, as.character) %>%
-  #   dplyr::mutate(AREA = dplyr::case_when(AREA=="0" ~ "000",AREA=="2" ~ "002",TRUE ~ AREA)) %>%
-  #   dplyr::filter(!grepl("^[A-Z]",AREA)) %>%
-  #   dplyr::mutate(AREA=as.integer(AREA)) %>%
-  #   as.data.table()
-
   # Convert from lbs to metric tons ----------------------------------------
 
   comland[, SPPLIVMT := SPPLIVLB * 0.00045359237]

R/comland_herring.R

@@ -16,7 +16,6 @@ comland_herring <- function(channel,comland) {
   herr.qry <- "select year, month, stock_area, negear, gearname, keptmt, discmt
              from maine_herring_catch"
 
-  #herr.catch <- as.data.table(RODBC::sqlQuery(channel, herr.qry))
   herr.catch <- data.table::as.data.table(DBI::dbGetQuery(channel, herr.qry))
 
   herr.catch$YEAR <- as.integer(herr.catch$YEAR)

R/comland_nafo.R

@@ -114,7 +114,7 @@ comland_nafo <- function(channel,skate.hake.nafo,GEARS){
   spp <- as.data.table(DBI::dbGetQuery(channel, "select NAFOSPP, NESPP3 from CFSPP"))
   spp$NAFOSPP <- as.integer(spp$NAFOSPP)
   spp$NESPP3 <- as.integer(spp$NESPP3)
-  #spp <- as.data.table(RODBC::sqlQuery(channel, "select NAFOSPP, NESPP3 from CFSPP"))
+
   #Fix missing NAFO codes
   missing.spp <- data.table::data.table(NAFOSPP = c(110, 141, 189, 480, 484, 487, 488, 489),
                                         NESPP3  = c(240, 509, 512, 366, 368, 367, 370, 369))
@@ -151,7 +151,6 @@ comland_nafo <- function(channel,skate.hake.nafo,GEARS){
   nafoland <- nafoland[NESPP3 != 168, ]
 
   #Gearcodes
-  #gear <- as.data.table(RODBC::sqlQuery(channel, "select NEGEAR, NAFOGEAR from Gear"))
 
   gear <- as.data.table(DBI::dbGetQuery(channel, "select NEGEAR, NAFOGEAR from Gear"))
   gear$NEGEAR <- as.integer(gear$NEGEAR)

R/get_areas.R

@@ -0,0 +1,68 @@
+#' Extract AREA information from CFDBS
+#'
+#'Extract a list of statistical areas, region, NAFO codes, etc from the NEFSC "Area" supporting table
+#'
+#'
+#' @param channel an Object inherited from \link[DBI]{DBIConnection-class}. This object is used to connect
+#' to communicate with the database engine. (see \code{\link[dbutils]{connect_to_database}})
+#' @param areas a specific area code or set of codes. Either numeric or character vector. Defaults to "all" areas
+#' Numeric codes are converted to VARCHAR2(3 BYTE) when creating the sql statement. Character codes are short character strings to reference the AREANM field.
+#'
+#' @return A list is returned:
+#'
+#'    \item{data}{containing the result of the executed \code{sqlStatement}}
+#'
+#'    \item{sql}{containing the sql call}
+#'
+#'    \item{colNames}{ a vector of the table's column names}
+#'
+#'The default sql statement "\code{select * from cfdbs.area}" is used
+#'
+#'@section Reference:
+#'Use the data dictionary for field name explanations
+#'
+#'@family get functions
+#'
+#' @seealso \code{\link[dbutils]{connect_to_database}}
+#'
+#' @examples
+#' \dontrun{
+#' # extracts complete area table based on default sql statement
+#' channel <- connect_to_database(server="name_of_server",uid="individuals_username")
+#' get_areas(channel)
+#'
+#' # extracts a subset of area data based on selected areas 100,500 (numeric)
+#' channel <- connect_to_database(server="name_of_server",uid="individuals_username")
+#' get_areas(channel,areas=c(100,500))
+#'
+#' # extracts a subset of area data based on selected areas 100,500 (character)
+#' channel <- connect_to_database(server="name_of_server",uid="individuals_username")
+#' get_areas(channel,areas=c("100","500"))
+#'
+#' # extracts a subset of area data based on areanm's containing "GG" (Androscoggin River etc)
+#' channel <- connect_to_database(server="name_of_server",uid="individuals_username")
+#' get_areas(channel,"GG")
+
+#'
+#'}
+#'
+#' @export
+#'
+#
+get_areas <- function(channel,areas="all"){
+
+
+  sqlStatement <- dbutils::create_sql(areas,fieldName="area",fieldName2="areanm",dataType="%03d",defaultSqlStatement="select * from cfdbs.area")
+
+  query <- DBI::dbGetQuery(channel,sqlStatement)
+
+  # get column names
+  sqlcolName <- "select COLUMN_NAME from ALL_TAB_COLUMNS where TABLE_NAME = 'AREA' and owner='CFDBS';"
+  colNames <- t(DBI::dbGetQuery(channel,sqlcolName))
+
+  return (list(data=dplyr::as_tibble(query),sql=sqlStatement, colNames=colNames))
+
+}
+
+
+

R/get_foreign_data.R

@@ -0,0 +1,140 @@
+#' Downloads all NAFO data
+#'
+#'Downloads, imports, aggregates NAFO data
+#'
+#'@param removeUSA Boolean. Should USA landings be removed from data set (Default = T, remove)
+#'@param aggregateCountry Boolean. Should all catch be aggregated over country codes? (Default = T)
+#'
+#'@return Data frame: NAFO data
+#'
+#'\item{Year}{Year of catch}
+#'\item{MONTH}{Month of catch}
+#'\item{QY}{Quatere year of catch. Jan-Mar = 1, ..., Oct-Dec = 4}
+#'\item{GearCode}{NAFO gear code}
+#'\item{Tonnage}{Size class of vessel}
+#'\item{DivCode}{Division code in which vessel reported catch}
+#'\item{NAFOCode}{NAFO species code of landed fish}
+#'\item{SPPLIVMT}{catch in Metric tons}
+#'\item{Country}{Reporting country - only if \code{aggregateCounty = F}}
+#'\item{NESPP3}{NEFSC species code}
+#'
+#'@importFrom data.table ":=" "key" "setcolorder" "as.data.table"
+#'
+#' @export
+
+get_foreign_data <- function(removeUSA = T, aggregateCountry = T){
+  #Note - NAFO landings by division only so not available in sum.by = "stat.area"
+  #Add NAFO foreign landings - Data from http://www.nafo.int/data/frames/data.html
+
+  files <- data.frame(url = c("https://www.nafo.int/Portals/0/Stats/nafo-21b-60-69.zip",
+                              "https://www.nafo.int/Portals/0/Stats/nafo-21b-70-79.zip",
+                              "https://www.nafo.int/Portals/0/Stats/nafo-21b-80-89.zip",
+                              "https://www.nafo.int/Portals/0/Stats/nafo-21b-90-99.zip",
+                              "https://www.nafo.int/Portals/0/Stats/nafo-21b-2000-09.zip",
+                              "https://www.nafo.int/Portals/0/Stats/nafo-21b-2010-16.zip"),
+                      filename = c("NAFO21B-60-69.txt",
+                                   "NAFO21B-70-79.txt",
+                                   "NAFO21B-80-89.txt",
+                                   "NAFO21B-90-99.txt",
+                                   "NAFO21B-2000-09.txt",
+                                   "nafo-21b-2010-16/NAFO-21B-2010-16.txt"),
+                      stringsAsFactors = FALSE)
+
+
+  # get file, catch error for missing file
+  nafo <- NULL
+  for (ifile in 1:nrow(files)) {
+    result <- tryCatch(
+      {
+        stringParts <- stringr::str_split(files$url[ifile],"/")
+        message("Reading file: ",tail(unlist(stringParts),1))
+        temp <- base::tempfile()
+        download.file(url=files$url[ifile],destfile=temp, quiet=TRUE)
+        res <- TRUE
+      },
+      error = function(e){
+        message(e)
+        return(FALSE)
+      } ,
+      warning = function(w){
+        return(FALSE)
+      }
+    )
+
+    if (!result) { # failed to download file
+      message(paste0("File ",files$url[ifile], " can not be downloaded. Please check the link @ https://www.nafo.int/Data/Catch-Statistics"))
+      base::unlink(temp)
+      next
+    }
+
+    # Read data
+    dataPart <- data.table::as.data.table(read.csv(unz(temp, files$filename[ifile])))
+    base::unlink(temp)
+
+    # make all coumn names consistent over all years data
+    # 2010 + data have different column headers.
+    # Use names from 1960
+    if(any(names(dataPart)=="Gear")){ # found in more recent years
+      data.table::setnames(dataPart,
+                         c('Gear', 'AreaCode', 'SpeciesEffort'),
+                         c('GearCode', 'Divcode', 'Code'))
+    }
+    if(any(names(dataPart)=="Month_NK")){
+      data.table::setnames(dataPart,'Month_NK','Catches')
+    }
+
+    # bind all years data into a large data frame
+    nafo <- rbind(nafo,dataPart)
+
+  }
+
+
+  # Remove US landings (Country code 22)
+  if (removeUSA) {
+    nafo <- nafo[Country != 22, ]
+  }
+
+  #Remove effort codes (1:3)
+  nafo <- nafo[Code > 3, ]
+
+  #Deal with unknown monthly catch????? The Catches column represent catch that couldn't be assigned to a month
+
+  #Get nafo code in a similar format to comland
+  nafoland <- nafo[, list(Year, GearCode, Tonnage, Divcode, Country, Code, Catches)]
+  # unknown monthly catch resides in "Catches" field. Assign as Month = 0
+  nafoland[, MONTH := 0]
+  data.table::setnames(nafoland, 'Catches', 'SPPLIVMT')
+
+
+  month <- c('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')
+  for(i in 1:12){
+    nafoland.month <- nafo[, list(Year, GearCode, Tonnage, Divcode, Country, Code, get(month[i]))]
+    nafoland.month[, MONTH := i]
+    data.table::setnames(nafoland.month,
+                         names(nafoland.month)[7],
+                         'SPPLIVMT')
+    nafoland <- data.table::rbindlist(list(nafoland, nafoland.month))
+  }
+
+  #aggregate nafo landings
+  #Aggregate by quarter year
+  nafoland[MONTH %in% 1:3,   QY := 1]
+  nafoland[MONTH %in% 4:6,   QY := 2]
+  nafoland[MONTH %in% 7:9,   QY := 3]
+  nafoland[MONTH %in% 10:12, QY := 4]
+  nafoland[MONTH == 0,       QY := 1] # Catches for Unknown MONTH
+
+  # aggregate over country
+  if (aggregateCountry) {
+    nafoland <- nafoland %>%
+      dplyr::group_by(Year,GearCode,Tonnage,Divcode,Code,MONTH,QY) %>%
+      dplyr::summarise(SPPLIVMT=sum(SPPLIVMT),.groups="drop") %>%
+      data.table::as.data.table(.)
+  }
+
+  # set NA's in monthly catch to zero
+  nafoland[is.na(SPPLIVMT), SPPLIVMT := 0]
+
+
+  return(nafoland)
+}