In EmilyMarkowitz-NOAA/FishEconProdOutput: Price Method Fisheries Economics Total Factor Productivity Outputs

# 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

Create Tables from the Fisheries Economics of the US (FEUS) Report

Purpose: Construct the FEUS Commerical Fisheries state and national tables and output them to csv files

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)}
}

1. Set knowns

# Define what regions we are interested in
reg_order = c("National", "North Pacific", "Pacific", "Western Pacific (Hawai`i)", 
              "New England", 
              "Mid-Atlantic", "South Atlantic", "Gulf of Mexico")

reg_order_abbrv = c("US", "NP", "Pac", "WP", "NE", "MA", "SA", "GOM")

# Define Category
category0 = "category"

# Define Years
maxyr<-2018
yr <- minyr <- minyr.data<-as.numeric(paste0(floor((maxyr-24)/10), 
                              ifelse(substr(maxyr, start = nchar((maxyr-24)), 
                                            stop = nchar((maxyr-24)))>=5, 6, 1))) #of data going into the analysis
minyr.ProdOut<-maxyr-19 # That will be shown in the analysis
baseyr<-as.numeric(paste0(floor(maxyr/10), 
                          ifelse(substr(maxyr, start = nchar(maxyr), 
                                        stop = nchar(maxyr))>=5, 5, 0))) #Will change every 5 years, e.g., maxyr 2019 = byr 2015; maxyr 2020 = byr 2020; maxyr 2021 = byr 2020

2. Set your directories where you will save everything

# Folder name for output
folder<-"T567_ProdOutput"
titleadd = paste0(minyr.ProdOut, "To", maxyr, "_FSFEUS")
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
}

3. Load example data

counter<-0
landings_data<-FishEconProdOutput::land
landings_data$category<-NULL # for this example, let's pretend that this column doesn't already exist
knitr::kable(head(landings_data), booktabs = T) %>%
  kable_styling(latex_options = "striped")

4. Use itis_reclassify() to categorize all of the species

This can take a minute!

temp <- itis_reclassify(tsn = unique(landings_data$Tsn), 
                 categories = list('Finfish' = c(914179, #  Infraphylum Gnathostomata
                                                -914181), # Tetrapoda; - = do NOT include
                                   "Shellfish" = c(82696, # Phylum  Arthropoda
                                                   69458)), # Phylum    Mollusca
                 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)

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

5. Run Analysis

out <- OutputAnalysis(landings_data = landings_data, 
               category0 = category0, # the name of the column you are categorizing by
               baseyr = baseyr, 
               titleadd = titleadd, 
               dir_analyses = dir_analyses, 
               skipplots = TRUE, 
               reg_order = reg_order, # The region(s) you want to assess
               reg_order_abbrv = reg_order_abbrv, # 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)

for (jjj in 1:length(out)) {
  assign(names(out)[jjj], out[[jjj]])
}

6. Create FEUS Tables

Table 5. Regional Törnqvist Price Index, r minyr.data-r maxyr (r baseyr = 1)

result <- lapply(index_list, "[", , c("Year", "cat", "PI_CB"))

a<-data.frame(result[1][[1]]$Year, 
              result[1][[1]]$cat)
for (i in 1:length(result)) {
  a<-cbind.data.frame(a, result[i][[1]]$PI_CB)
}
names(a)<-c("Year", "cat", names(result))
a <- a[a$Year %in% minyr.ProdOut:maxyr & 
         a$cat %in% "Total", ]

a$cat<-NULL

a$Footnotes<-NA
temp_code<-a

a[,reg_order]<-round(x = a[,reg_order], digits = 2)

temp_print <- a

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

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

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

Table 6. Regional Real Landing Törnqvist Values, r minyr.data-r maxyr (r baseyr $ Million)

result <- lapply(index_list, "[", , c("Year", "cat", "Q_CB"))

a<-data.frame(result[1][[1]]$Year, 
              result[1][[1]]$cat)
for (i in 1:length(result)) {
  a<-cbind.data.frame(a, result[i][[1]]$Q_CB)
}
names(a)<-c("Year", "cat", names(result))
a <- a[a$Year %in% minyr.ProdOut:maxyr & 
         a$cat %in% "Total", ]

a$cat<-NULL

a$Footnotes<-NA
temp_code<-a

a[,reg_order]<-round(x = a[,reg_order]/1e6, digits = 2)
for (i in 2:length(reg_order)){
  a[,i]<-prettyNum(x = a[,i], big.mark = ",")
}
temp_print <- a

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

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

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

Table 7. National Nominal Landing Values ($ Million), Törnqvist Price Index, (r baseyr = 1), and Real Landing Törnqvist Values (r baseyr $ Million), r minyr.data-r maxyr

result <- lapply(index_list, "[", , c("Year", "cat", "PI_CB", "Q_CB", "v"))
a<-result$National
a<-a[a$Year %in% minyr.ProdOut:maxyr, ]

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

# temp_code
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

# temp_print
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

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

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

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

7. Figures

Here are a few figures that come out of this analysis!

Some come already in convient grids...

gridfigures_list$`000_All_byr2015_categoryPI_Total`

gridfigures_list$`000_All_byr2015_categoryQ_CB_Q`

And in single plots!

figures_list$National__PI_Finfish

figures_list$National__Q_CB_CatTot_QCatTot

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