doc/NEFSC-Fishery.R

## ---- include = FALSE---------------------------------------------------------
# https://r-pkgs.org/vignettes.html
  # %\VignetteIndexEntry{FEUS-tables}
  # %\VignetteEngine{knitr::rmarkdown}
  # %\VignetteEncoding{UTF-8}
knitr::opts_chunk$set(message = FALSE, echo = TRUE, warning = FALSE, 
  collapse = TRUE,
  comment = "#>"
)

TF<-FALSE

## ----setup--------------------------------------------------------------------
PKG <- c(# devtools::install_github("emilymarkowitz-NOAA/FishEconProdOutput", force = TRUE)
         "FishEconProdOutput",
         
         #Seperating species by taxonomic group
         "taxize",  # install.packages("remotes"); remotes::install_github("ropensci/taxize")
         
         # Data Managment
         "tidyverse",
         "filesstrings", 
         "data.table", 
         "plyr",  
         "dplyr",
         "rlist",
         
         # #RMarkdown
         "rmarkdown",
         "ggpubr",
         "kableExtra",
         
         #Excel File Management
         "xlsx",
         "readxl"
)

for (p in PKG) {
  if(!require(p,character.only = TRUE)) {  
    install.packages(p, repos = "http://cran.us.r-project.org")
    require(p,character.only = TRUE)}
}

## -----------------------------------------------------------------------------
# Define what regions we are interested in
reg_order = c("Northeast")
reg_order_abbrv = c("NorE")

# Define Category
category0 = "category"

# Define Years
maxyr <- 2018
minyr <- 2007 #of data going into the analysis
baseyr <- minyr

## -----------------------------------------------------------------------------

# Folder name for output
folder<-"Northeast"
titleadd = paste0(minyr, "To", maxyr, "_NorE")
counter<-0
  
dir_in<-getwd()

if (TF) {
  #Local Directories
  dir_outputtables<-paste0(dir_in, "/output/")
  dir.create(dir_outputtables)

  # Define Directories
  dir_analyses = paste0(dir_outputtables, folder)
  dir.create(dir_analyses)
} else {
  dir_analyses<-dir_outputtables<-dir_in
}



## ---- results='asis'----------------------------------------------------------
counter<-0
landings_data<-FishEconProdOutput::land
landings_data<-landings_data[landings_data$Region %in% c("New England", "Mid-Atlantic"),]
landings_data$Region<-"Northeast"

# so you can see what this data looks like
knitr::kable(head(landings_data), booktabs = T) %>%
  kable_styling(latex_options = "striped")

## ---- results='asis', echo=FALSE----------------------------------------------

ne_spp<-data.frame(
  stringsAsFactors = FALSE,
  x = c("1      23    BF                 Bluefish",
        "2     352    DF            Spiny Dogfish",
        "3      81 GFISH             Atlantic Cod",
        "4     120 GFISH          Winter Flounder",
        "5     122 GFISH           Witch Flounder",
        "6     123 GFISH      Yellowtail Flounder",
        "7     124 GFISH American Plaice Flounder",
        "8     125 GFISH        Sand Dab Flounder",
        "9     147 GFISH         Atlantic Haddock",
        "10    153 GFISH               White Hake",
        "11    159 GFISH         Atlantic Halibut",
        "12    240 GFISH                  Redfish",
        "13    250 GFISH               Ocean Pout",
        "14    269 GFISH                  Pollock",
        "15    512 GFISH                 Wolffish",
        "16    168   HER         Atlantic Herring",
        "17     12  MONK                 Monkfish",
        "18    710 RCRAB                 Red Crab",
        "19    800  SCAL              Sea Scallop",
        "20    754  SCOQ             Ocean Quahog",
        "21    769  SCOQ                Surf clam",
        "22    121    SF          Summer Flounder",
        "23    329    SF                     Scup",
        "24    335    SF           Black Sea Bass",
        "25    364 SKATE            Rosette Skate",
        "26    365 SKATE                   Skates",
        "27    366 SKATE             Little Skate",
        "28    367 SKATE             Winter Skate",
        "29    368 SKATE           Barndoor Skate",
        "30    369 SKATE             Smooth Skate",
        "31    370 SKATE             Thorny Skate",
        "32    372 SKATE          Clearnose Skate",
        "33     51   SMB               Butterfish",
        "34    212   SMB        Atlantic Mackerel",
        "35    801   SMB             Loligo Squid",
        "36    802   SMB              Illex Squid",
        "37    152 SMESH                 Red Hake",
        "38    508 SMESH            Offshore Hake",
        "39    509 SMESH              Silver Hake",
        "40    444    TF        Blueline Tilefish",
        "41    446    TF          Golden Tilefish")
)

ne_spp <- separate(data = ne_spp, 
                   col = x, 
                   into = c(NA,  "code", "plan", "name", "name2", "name3", "name4"), 
                   sep = "[[:blank:]]+") 

ne_spp$name2[is.na(ne_spp$name2)]<-ne_spp$name3[is.na(ne_spp$name3)]<-ne_spp$name4[is.na(ne_spp$name4)]<-""

ne_spp$name<-trimws(paste(ne_spp$name, ne_spp$name2, ne_spp$name3, ne_spp$name4))

ne_spp$name2<-ne_spp$name3<-ne_spp$name4<-NULL

knitr::kable((ne_spp), booktabs = T) %>%
  kable_styling(latex_options = "striped")

## -----------------------------------------------------------------------------

# Find TSN values for species of interest

spcat.list<-list('Bluefish' = 168559, # Species	Pomatomus saltatrix (Linnaeus, 1766) – bluefish, anjova
                 'Spiny dogfish' = 160617, #Species	Squalus acanthias Linnaeus, 1758 – cazón espinoso común, piked dogfish, spiny dogfish, galludo espinoso, aiguillat commun, dogfish, grayfish, spurdog
                 'Atlantic Cod' = 164712, # Species	Gadus morhua Linnaeus, 1758 – morue de l'Atlantique, bacalao del Atlántico, cod, rock cod, morue franche, Atlantic cod 
                 'Summer flounder' = 172735, #Species	Paralichthys dentatus (Linnaeus, 1766) – summer flounder, fluke, cardeau d'été, Summer Flounder
                 'Winter Flounder' = 172905, # Species	Pseudopleuronectes americanus (Walbaum, 1792) – plie rouge, blackback, Georges Bank flounder, lemon sole, rough flounder, winter flounder, Winter Flounder
                 'Witch Flounder' = 172873, #Species	Glyptocephalus cynoglossus (Linnaeus, 1758) – witch flounder, gray sole, plie grise, Witch Flounder
                 'Yellowtail Flounder' = 172909, #Species	Limanda ferruginea (Storer, 1839) – limande à queue jaune, rusty flounder, yellowtail flounder, Yellowtail Flounder
                 'American Plaice Flounder' = 172877, # Species	Hippoglossoides platessoides (Fabricius, 1780) – American plaice, plie canadienne, American dab, Canadian plaice, dab, American Plaice
                 'Sand Dab Flounder' = 172746, #Species	Scophthalmus aquosus (Mitchill, 1815) – windowpane, brill, sand dab, spotted flounder, turbot de sable, Windowpane
                 'Atlantic haddock' = 164744, # Species	Melanogrammus aeglefinus (Linnaeus, 1758) – haddock, aiglefin
                 'White hake' = 164732, # Species	Urophycis tenuis (Mitchill, 1814) – white hake, mud hake, merluche blanche
                 'Red hake' = c(164730 #  Species	Urophycis chuss (Walbaum, 1792) – red hake, squirrel hake, merluche-écureuil
                 ),#164729), # Genus	Urophycis Gill, 1863 – codlings # Toledo, includes other hake
                 'Silver hake' = c(164791 #Species	Merluccius bilinearis (Mitchill, 1814) – silver hake, merlu argenté
                 ), # 164790), # Genus	Merluccius Rafinesque, 1810 – hakes # Toledo, includes other hake
                 'Skates' = 160845, # Family	Rajidae Blainville, 1816 – rayas, rays, skates, raies
                 "Rosette skate" = 564136,# Species	Leucoraja garmani (Whitley, 1939) – rosette skate
                 'Little Skate' = 564130,#Species	Leucoraja erinacea (Mitchill, 1825) – raie-hérisson, common skate, little skate, summer skate
                 'Winter Skate' = 564145,#Species	Leucoraja ocellata (Mitchill, 1815) – raie tachetée, big skate, eyed skate, winter skate
                 'Barndoor Skate' = 564139,#Species	Dipturus laevis (Mitchill, 1818) – grande raie, barndoor skate
                 'Smooth Skate' = 564151,# Species	Malacoraja senta (Garman, 1885) – raie à queue de velours, smooth skate
                 'Thorny Skate' = 564149,#Species	Amblyraja radiata (Donovan, 1808) – raie épineuse, starry skate, thorny skate
                 'Clearnose Skate' = 160855,#Species	Raja eglanteria Bosc in Lacepède, 1800 – raya naricita, clearnose skate
                 'Loligo squid' = 82370, # Genus	Loligo Lamarck, 1798
                 'Illex Squid' = 82520, # Genus	Illex Steenstrup, 1880
                 'Ocean pout' = 630979, # Species	Zoarces americanus (Bloch and Schneider, 1801) – ocean pout, loquette d'Amérique
                 'Atlantic mackerel' = 172414, #Species	Scomber scombrus Linnaeus, 1758 – caballa del Atlántico, maquereau commun, maquereau bleu, Atlantic mackerel
                 'Atlantic pollock' = 164727, #Species	Pollachius virens (Linnaeus, 1758) – pollock, coalfish, carbonero, lieu noir, saithe, goberge 
                 'Atlantic Wolffish' = 171336, # Genus	Anarhichas Linnaeus, 1758 – Atlantic wolffishes
                 'Black sea bass' = 167687, # Species	Centropristis striata (Linnaeus, 1758) – black sea bass
                 'Scups' = 169181, # Genus	Stenotomus Gill, 1865
                 'Butterfish' = 172567, # Species	Peprilus triacanthus (Peck, 1804) – palometa estrecha, butterfish, stromatée à fossettes
                 'Blueline Tilefish' = 168543, #  Species	Caulolatilus microps Goode and Bean, 1878 – blueline tilefish, blanquillo lucio
                 'Golden Tilefish' = 168546, # Species	Lopholatilus chamaeleonticeps Goode and Bean, 1879 – blue tilefish, tilefish, conejo amarillo
                 'Monkfish' = 164499 , #Species	Lophius americanus Valenciennes in Cuvier and Valenciennes, 1837 – goosefish, monkfish, baudroie d'Amérique
                 'Acadian Redfish' = 166774, # Species	Sebastes fasciatus Storer, 1854 – Acadian redfish, Labrador redfish, Acadian rockfish, sébaste acadien
                 'Atlantic Herring' = 161722, # Species	Clupea harengus Linnaeus, 1758 – Baltic herring, herring, hareng atlantique, Atlantic herring
                 
                 'Atlantic surf clam' = 80944, #Species	Spisula solidissima (Dillwyn, 1817) – Atlantic surfclam
                 'Offshore Hake' = 164793, # Species	Merluccius albidus (Mitchill, 1818) – offshore hake, offshore whiting
                 'Ocean quahog clam' = 81343, # Species	Arctica islandica (Linnaeus, 1767) – ocean quahog
                 'Red Crab' = 620992, # Species	Chaceon quinquedens (S. I. Smith, 1879) – red deepsea crab
                 'Sea scallop' = 79718, #Species	Placopecten magellanicus (Gmelin, 1791) – sea scallop
                 'Atlantic halibut' = 172933 # Species	Hippoglossus hippoglossus (Linnaeus, 1758) – Atlantic halibut, flétan atlantique, Atlantic Halibut
)

## -----------------------------------------------------------------------------

# a bit hacky, but I am linking all of the TSN numbers to their respective species here in the northeast fisheries list
spcat<-c()

for (i in 1:nrow(ne_spp)) {
  spcat<-c(spcat, 
           ifelse(sum(grepl(pattern = ne_spp$name[i], x = names(spcat.list) , ignore.case = T)) == 0, 
                  NA, grep(pattern = ne_spp$name[i], x = names(spcat.list), ignore.case = T) ))
}

ne_spp$TSN<-as.numeric(unlist(spcat.list[spcat]))

# Now convert the Northeast Fisheires list into a list for the itis_reclassify function

categories<-list()
for (i in 1:length(unique(ne_spp$plan))) {
  categories[i]<-list(ne_spp$TSN[ne_spp$plan %in% unique(ne_spp$plan)[i]])
  names(categories)[i]<-unique(ne_spp$plan)[i]
}


## -----------------------------------------------------------------------------

# Use the itis_reclassify function to sort each species listed in the FOSS data into each classification group

temp<-itis_reclassify(tsn = unique(landings_data$Tsn), 
                         categories = categories, 
                         uncategorized_name="Uncategorized")


tsn_id<-temp$df_out

# Remove anything that wasn't classified (we don't them for what we are doing here)
if (sum(tsn_id$category %in% c("Other", "Uncategorized"))>0) {
  tsn_id<-tsn_id[!(tsn_id$category %in% c("Other", "Uncategorized")), 
                 c("TSN", "category")]
}

# renaming columns for joining other datasets to this dataset
landings_data<-dplyr::rename(landings_data, 
                 TSN = Tsn)

tsn_id$TSN<-as.numeric(tsn_id$TSN)

# Join the FOSS landings data to their respctive categories

landings_data<-dplyr::left_join(x = landings_data, 
                    y = tsn_id, 
                    by = "TSN")

# Rename columns so they match what the funciton uses

landings_data<-dplyr::rename(landings_data, 
                 Tsn = TSN, 
                 category = category.y)

# Minor data editing. 

landings_data<-landings_data[landings_data$Year>=minyr & landings_data$Year<=maxyr, # Only include years that you intend to assess. 
       c("Year","Pounds","Dollars","category","Tsn", "State", "Region", "abbvreg")] # These are all of the columns you need


# Sometimes negative numbers can be in these columns. They're flags and not real values, so we'll want to remove those here

landings_data<-landings_data[(landings_data$Pounds>=0), ]
landings_data<-landings_data[(landings_data$Dollars>=0), ]

# Print out the resultant table so we can see our hard work!
knitr::kable(head(landings_data), booktabs = T) %>%
  kable_styling(latex_options = "striped")


## -----------------------------------------------------------------------------

out <- OutputAnalysis(landings_data = landings_data, 
               category0 = "category", # the name of the column you are categorizing by
               baseyr = baseyr, 
               titleadd = titleadd, 
               dir_analyses = dir_analyses, 
               skipplots = TRUE, 
               reg_order = "Northeast", # The region(s) you want to assess
               reg_order_abbrv = "NorE", # The region(s) you want to assess
               save_outputs_to_file = TF) # Here I use the variable TF so I can change it once at the begining of my code, depending on my reporting purposes
names(out)

# make an object of everything that comes out of this function 
for (jjj in 1:length(out)) {
  assign(names(out)[jjj], out[[jjj]])
}

## ---- results='asis'----------------------------------------------------------
result <- lapply(index_list, "[", , c("Year", "cat", "PI_CB", "Q_CB", "v"))
a<-result$Northeast
a<-a[a$Year %in% minyr:maxyr, ]

a<-dplyr::rename(a, 
                 PI = PI_CB, 
                 Q = Q_CB, 
                 V = v)

# Create table of raw values
a.pi<-spread(a[!(names(a) %in% c("V", "Q"))], cat, PI)
names(a.pi)[-1]<-paste0(names(a.pi)[-1], "_PI")
a.q<-spread(a[!(names(a) %in% c("PI", "V"))], cat, Q)
names(a.q)[-1]<-paste0(names(a.q)[-1], "_Q")
a.v<-spread(a[!(names(a) %in% c("PI", "Q"))], cat, V)
names(a.v)[-1]<-paste0(names(a.v)[-1], "_V")

b<-left_join(a.pi, a.q, by = c("Year"))
b<-left_join(b, a.v, by = c("Year"))


b<-b[,match(x = c("Year", 
                  names(b)[grep(pattern = "_V", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "_PI", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "_Q", x = names(b), ignore.case = T)]), 
            names(b))]

b<-b[,match(x = c("Year", 
                  names(b)[grep(pattern = "fin", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "Shell", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "Total", x = names(b))]), 
            names(b))]

b<-b[b$Year %in% minyr:maxyr, ]
temp_code<-b
temp_code$Footnotes<-NA


# Create a nice-looking formatted table of values with PrettyNum
b<-a
b$PI<-round(x = b$PI, digits = 2)
b$Q<-prettyNum(x = round(x = b$Q/1e6), digits = 2, big.mark = ",")
b$V<-prettyNum(x = round(x = b$V/1e6), digits = 2, big.mark = ",")

b.pi<-spread(b[!(names(b) %in% c("V", "Q"))], cat, PI)
names(b.pi)[-1]<-paste0(names(b.pi)[-1], "_PI")
b.q<-spread(b[!(names(b) %in% c("PI", "V"))], cat, Q)
names(b.q)[-1]<-paste0(names(b.q)[-1], "_Q")
b.v<-spread(b[!(names(b) %in% c("PI", "Q"))], cat, V)
names(b.v)[-1]<-paste0(names(b.v)[-1], "_V")

b<-left_join(b.pi, b.q, by = c("Year"))
b<-left_join(b, b.v, by = c("Year"))

b<-b[,match(x = c("Year", 
                  names(b)[grep(pattern = "_V", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "_PI", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "_Q", x = names(b), ignore.case = T)]), 
            names(b))]

b<-b[,match(x = c("Year", 
                  names(b)[grep(pattern = "fin", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "Shell", x = names(b), ignore.case = T)], 
                  names(b)[grep(pattern = "Total", x = names(b))]), 
            names(b))]

b<-b[b$Year %in% minyr:maxyr, ]
temp_print<-b
temp_print$Footnotes<-NA

# Save Outputs. 
# Here I use the variable TF so I can change it once at the begining of my code, depending on my reporting purposes

ProdOutputUS_Raw<-temp_code
if (TF) {
  write_csv(x = ProdOutputUS_Raw, file = paste0(dir_analyses, "/ProdOutputNorE_Raw.csv"))
}

ProdOutputUS_Print<-temp_print
if (TF) {
  write_csv(x = ProdOutputUS_Print, file = paste0(dir_analyses, "/ProdOutputNorE_Print.csv"))
}

# Print out the resultant table so we can see our hard work!

ProdOutputUS_Print$Footnotes<-NULL
knitr::kable(ProdOutputUS_Print, booktabs = T) %>%
  kable_styling(latex_options = "striped")

## ---- fig.width=8-------------------------------------------------------------
figures_list$Northeast__PI_CB_PI

figures_list$Northeast__Q_CB_CatTot_QCatTot
EmilyMarkowitz-NOAA/FishEconProdOutput documentation built on Aug. 30, 2021, 6:49 p.m.