From 0142a56e936da73869b0576c3fedc58c4554982d Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 12:12:24 -0400
Subject: [PATCH 01/29] refactor: change edit page target to `main` branch
---
_output.yml | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/_output.yml b/_output.yml
index 807e88fc..99b4ae90 100644
--- a/_output.yml
+++ b/_output.yml
@@ -14,7 +14,7 @@ bookdown::gitbook:
# collapse: section
# before: |
# Mastering Shiny
- edit: https://github.com/NOAA-EDAB/tech-doc/edit/master/%s
+ edit: https://github.com/NOAA-EDAB/tech-doc/edit/main/%s
download: []
sharing:
facebook: no
@@ -42,7 +42,7 @@ bookdown::epub_book: default
# Published with bookdown
# toolbar:
# position: static
-# edit: https://github.com/NOAA-EDAB/tech-doc/edit/master/%s
+# edit: https://github.com/NOAA-EDAB/tech-doc/edit/main/%s
# download: ["pdf"]
# bookdown::pdf_book:
# keep_tex: yes
@@ -62,6 +62,6 @@ bookdown::epub_book: default
#
#
# edit:
-# link: https://github.com/NOAA-EDAB/tech-doc/edit/master/%s
+# link: https://github.com/NOAA-EDAB/tech-doc/edit/main/%s
#bookdown::pdf_book:
# keep_tex: yes
\ No newline at end of file
From bab8302aa71b9cebe1d515b885aba7f5aaf34ece Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 12:12:43 -0400
Subject: [PATCH 02/29] refactor: change build book trigger to `main` branch
---
.github/workflows/bookdown.yaml | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/.github/workflows/bookdown.yaml b/.github/workflows/bookdown.yaml
index d3cb5282..c1a99526 100644
--- a/.github/workflows/bookdown.yaml
+++ b/.github/workflows/bookdown.yaml
@@ -3,12 +3,12 @@
on:
push:
branches:
- - master
+ - main
- dev
pull_request:
branches:
- - master
+ - main
name: build-book
From caea8d13ec0d0b67c47485ac5f144f68522c5d17 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 12:13:12 -0400
Subject: [PATCH 03/29] refactor: change verify PR action to trigger on `main`
---
.github/workflows/verify_pr.yml | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/.github/workflows/verify_pr.yml b/.github/workflows/verify_pr.yml
index bad88b90..fd3b3b0d 100644
--- a/.github/workflows/verify_pr.yml
+++ b/.github/workflows/verify_pr.yml
@@ -2,7 +2,7 @@ name: Run PR Checks
on:
pull_request:
branches:
- - master
+ - main
jobs:
check_description:
From a060fc189f0b49460229fdad44fcaaef7332bf00 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 12:14:06 -0400
Subject: [PATCH 04/29] fix: reference `main` branch in the `how_we_published`
page
---
chapters/how_we_published.Rmd | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/chapters/how_we_published.Rmd b/chapters/how_we_published.Rmd
index b16d131c..1792f34c 100644
--- a/chapters/how_we_published.Rmd
+++ b/chapters/how_we_published.Rmd
@@ -23,7 +23,7 @@ Copied in the order I did things to implement gh-pages:
>An alternative approach is to create a `gh-pages` branch in your repository, build the book, put the HTML output (including all external resources like images, CSS, and JavaScript files) in this branch, and push the branch to the remote repository. If your book repository does not have the `gh-pages` branch, you may use the following commands to create one:
-**Sarah's notes**: Do this on your _local_ machine, using the terminal under the git-tracked directory, pushing to the github repo last. Don't be tempted to make the gh-pages branch on github first, it causes pain. Using [checkout --orphan](https://git-scm.com/docs/git-checkout) means you are making a new branch that has no history (you don't need to carry the version control history here; it stays on the master branch). Next you are removing all the files from this new branch using [rm -rf .](https://git-scm.com/docs/git-rm) because it will only have the compiled book files on it. All rmd files, etc will remain on the master branch. At the end of this step in the terminal you push to create the gh-pages branch on github. You should see it there, containing only .nojekyll
+**Sarah's notes**: Do this on your _local_ machine, using the terminal under the git-tracked directory, pushing to the github repo last. Don't be tempted to make the gh-pages branch on github first, it causes pain. Using [checkout --orphan](https://git-scm.com/docs/git-checkout) means you are making a new branch that has no history (you don't need to carry the version control history here; it stays on the main branch). Next you are removing all the files from this new branch using [rm -rf .](https://git-scm.com/docs/git-rm) because it will only have the compiled book files on it. All rmd files, etc will remain on the main branch. At the end of this step in the terminal you push to create the gh-pages branch on github. You should see it there, containing only .nojekyll
>
>From bookdown github chapter:
@@ -43,8 +43,8 @@ git add .nojekyll
git commit -m"Initial commit"
git push origin gh-pages
-# when done, go back to master branch
-git checkout master
+# when done, go back to main branch
+git checkout main
```
>
>
@@ -135,7 +135,7 @@ Rscript -e "bookdown::render_book('index.Rmd', 'bookdown::gitbook')"
set -e
[ -z "${GITHUB_PAT}" ] && exit 0
-[ "${TRAVIS_BRANCH}" != "master" ] && exit 0
+[ "${TRAVIS_BRANCH}" != "main" ] && exit 0
git config --global user.email "Sarah.Gaichas@noaa.gov"
git config --global user.name "Sarah Gaichas"
From d8edde714eeda0bd837edae55c9c43a964915748 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 14:15:39 -0400
Subject: [PATCH 05/29] chore: add pull request template for standard branching
---
.github/pull_request_template.md | 36 ++++++++++++++++++++++++++++++++
1 file changed, 36 insertions(+)
create mode 100644 .github/pull_request_template.md
diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md
new file mode 100644
index 00000000..fae769fa
--- /dev/null
+++ b/.github/pull_request_template.md
@@ -0,0 +1,36 @@
+Your commits explain the `who`, `what`, `where` and `when` of these changes. Your code shows the `how`. You do not need to reiterate this. This PR should complete the picture by explaining `why` these changes are necessary.
+Please complete the fields below, replacing or removing placeholder text where necessary:
+
+### Justification
+
+Please describe the importance/impact of the problem and a description of how the changes in this pull request will address, resolve or improve it. This section should sufficiently explain to reviewers why these changes should be approved.
+If the proposed changes should close an issue, be sure to link to it below:
+Fixes #?
+
+### Types of changes
+
+What types of changes does this pull request introduce? Put an `x` in the boxes that apply.
+This will inform the new release number.
+
+- [ ] Fix (non-breaking change which fixes a bug)
+- [ ] Feature (non-breaking change which adds or changes functionality)
+- [ ] Breaking change (fix or feature that would cause existing functionality to not work as expected)
+- [ ] Other change (if none of the other choices apply)
+
+### Further comments
+
+If this is a relatively large or complex change, kick off a discussion by explaining why you chose the solution you did, what alternatives you considered, problems you may have encountered, etc.
+
+### Reviewer instructions
+
+Assign at least 2 reviewers:
+* one of which should be a maintainer of this repo,
+* the others should be familiar with the subject or problem.
+
+Please detail the process reviewers will need to follow to properly test these changes. It is especially helpful to identify the exact code needed to conduct a local build/review/test and to specify any aspects of the testing that may not be obvious.
+
+### Formatting
+
+This repo contains an `air.toml` file that automatically formats code to a set of standards.
+It is preferred that contributors and reviewers install the [Air](https://posit-dev.github.io/air/) formatting tool.
+Code submitted in this pull request will be automatically checked for correct formatting.
From 08084a8169d2edacd915741a49ab3310263e346c Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 14:15:52 -0400
Subject: [PATCH 06/29] chore: add template for blank issues
---
.github/ISSUE_TEMPLATE/blank_issue.yml | 17 +++++++++++++++++
1 file changed, 17 insertions(+)
create mode 100644 .github/ISSUE_TEMPLATE/blank_issue.yml
diff --git a/.github/ISSUE_TEMPLATE/blank_issue.yml b/.github/ISSUE_TEMPLATE/blank_issue.yml
new file mode 100644
index 00000000..cbfa01f9
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/blank_issue.yml
@@ -0,0 +1,17 @@
+name: Blank issue
+description: Create a new issue from scratch
+body:
+ - type: markdown
+ attributes:
+ value: |
+ Thank you for contributing an issue to our project!
+ - type: markdown
+ attributes:
+ value: |
+ If you are reporting a bug or requesting a feature, please click "Choose a different template" above.
+ - type: textarea
+ id: description
+ attributes:
+ label: Description
+ validations:
+ required: true
\ No newline at end of file
From c19c68d232c77c06d467923d0d2f43839d4c3c67 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 14:16:09 -0400
Subject: [PATCH 07/29] chore: rewrite bug report issue template with new
fields
---
.github/ISSUE_TEMPLATE/bug_report.yml | 76 +++++++++++++++++++++------
1 file changed, 61 insertions(+), 15 deletions(-)
diff --git a/.github/ISSUE_TEMPLATE/bug_report.yml b/.github/ISSUE_TEMPLATE/bug_report.yml
index 2a6d87c1..aeef4668 100644
--- a/.github/ISSUE_TEMPLATE/bug_report.yml
+++ b/.github/ISSUE_TEMPLATE/bug_report.yml
@@ -1,31 +1,77 @@
-name: SOE Tech Doc - Bug Report
-description: Use this issue template to report bugs in the State of the Ecosystem technical documentation.
-title: "[Bug Report]: "
+name: Bug Report
+description: Identify a problem or unexpected outcome
+title: "[Bug]: "
labels: ["bug"]
-assignees: "BBeltz1"
body:
- - type: markdown
+ - type: textarea
+ id: bug-description
+ attributes:
+ label: Bug description
+ description: Please explain the problem you are experiencing
+ validations:
+ required: true
+ - type: input
+ id: version
+ attributes:
+ label: Version
+ description: What version of our product are you using?
+ placeholder: X.X.X
+ validations:
+ required: true
+ - type: dropdown
+ id: operating-system
attributes:
+ label: Operating system
+ description: What operating system are you using?
+ options:
+ - Windows
+ - Mac
+ - Linux
+ validations:
+ required: true
+ - type: textarea
+ id: system-info
+ attributes:
+ label: System information
+ description: Please provide the following system information
value: |
- Please use the fields below to identify the bug and provide related information we can use to troubleshoot. Thanks.
+ - R version:
+ - IDE:
+ - IDE version:
+ validations:
+ required: true
- type: textarea
- id: bugdesc
+ id: reproduction-steps
attributes:
- label: Describe the bug
- description: A clear and concise description of what the bug is.
+ label: Reproduction steps
+ description: Please explain the steps required to reproduce the problem. Ideally, include a minimal reproducible example (AKA a reprex). If you've never heard of a [reprex](http://reprex.tidyverse.org/) before, start by reading .
validations:
required: true
- type: textarea
- id: bugdisc
+ id: actual-result
attributes:
- label: Describe the situation
- description: How did you discover this bug? What were you trying to accomplish?
+ label: Actual result
+ description: What is the observed outcome of following the steps above?
validations:
required: true
- type: textarea
- id: addinfo
+ id: expected-result
+ attributes:
+ label: Expected result
+ description: What outcome did you expect from following the steps above?
+ validations:
+ required: true
+ - type: input
+ id: bug-impact
+ attributes:
+ label: Bug impact
+ description: How severely does this problem impact you and/or your work?
+ validations:
+ required: true
+ - type: upload
+ id: screenshots
attributes:
- label: Additional information
- description: Add any other information about the problem here.
+ label: Upload screenshots
+ description: If applicable, you may upload screenshots to demonstrate the problem.
validations:
required: false
From 905218243b432ba376ff329aae07694c06c7376b Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 14:16:34 -0400
Subject: [PATCH 08/29] chore: disable blank issue use
---
.github/ISSUE_TEMPLATE/config.yml | 1 +
1 file changed, 1 insertion(+)
create mode 100644 .github/ISSUE_TEMPLATE/config.yml
diff --git a/.github/ISSUE_TEMPLATE/config.yml b/.github/ISSUE_TEMPLATE/config.yml
new file mode 100644
index 00000000..ec4bb386
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/config.yml
@@ -0,0 +1 @@
+blank_issues_enabled: false
\ No newline at end of file
From fcce8cba4dba856c730fb5eac82383dc3c9f0f06 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 14:17:00 -0400
Subject: [PATCH 09/29] chore: add feature request issue template
---
.github/ISSUE_TEMPLATE/feature_request.yml | 33 ++++++++++++++++++++++
1 file changed, 33 insertions(+)
create mode 100644 .github/ISSUE_TEMPLATE/feature_request.yml
diff --git a/.github/ISSUE_TEMPLATE/feature_request.yml b/.github/ISSUE_TEMPLATE/feature_request.yml
new file mode 100644
index 00000000..b4234c58
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE/feature_request.yml
@@ -0,0 +1,33 @@
+name: Feature Request
+description: Request the addition of a new feature
+title: "[Feature]: "
+labels: ["feature"]
+body:
+ - type: textarea
+ id: feature-description
+ attributes:
+ label: Feature description
+ description: Please explain the feature you are requesting
+ validations:
+ required: true
+ - type: textarea
+ id: feature-reason
+ attributes:
+ label: Justification
+ description: How would this feature improve your use of our product?
+ validations:
+ required: true
+ - type: textarea
+ id: example-features
+ attributes:
+ label: Examples
+ description: If applicable, please provide an example of the feature. If you have seen or used an analagous feature elsewhere, please provide a link to it.
+ validations:
+ required: false
+ - type: upload
+ id: screenshots
+ attributes:
+ label: Upload screenshots
+ description: If applicable, you may upload screenshots to supplement your request.
+ validations:
+ required: false
\ No newline at end of file
From f2f6598cdb05402214d2dfa4a3e9eef2e857b0e0 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 14:17:30 -0400
Subject: [PATCH 10/29] chore: add pull request template for syncing `dev` and
`main`
---
.github/PULL_REQUEST_TEMPLATE/dev_pr.md | 25 +++++++++++++++++++++++++
1 file changed, 25 insertions(+)
create mode 100644 .github/PULL_REQUEST_TEMPLATE/dev_pr.md
diff --git a/.github/PULL_REQUEST_TEMPLATE/dev_pr.md b/.github/PULL_REQUEST_TEMPLATE/dev_pr.md
new file mode 100644
index 00000000..3c36fdb9
--- /dev/null
+++ b/.github/PULL_REQUEST_TEMPLATE/dev_pr.md
@@ -0,0 +1,25 @@
+PRs into `dev` contained all necessary info. They have already been approved.
+Please provide the information below so `main` can be synced with `dev`:
+
+### List PRs
+
+List the PRs that were merged into `dev` that will be pulled into `main` and any issues they fix:
+
+* PR #? which fixes #?
+
+### Types of changes
+
+What types of changes does this pull request introduce? Put an `x` in the boxes that apply.
+This will inform the new release number.
+
+- [ ] Fix (non-breaking change which fixes a bug)
+- [ ] Feature (non-breaking change which adds or changes functionality)
+- [ ] Breaking change (fix or feature that would cause existing functionality to not work as expected)
+- [ ] Other change (if none of the other choices apply)
+
+### Reviewer instructions
+
+The underlying PRs should have been reviewed. Please check that the proposed merge is correct before approving.
+If any checkboxes other than "Other change" have been selected please prepare the following file changes for a new release version:
+- [ ] changelog.Rmd - add release notes
+- [ ] DESCRIPTION - increment the version number according to [Semantic Versioning](https://semver.org)
From a331aa6e73f0a08a8a53d8d2f05eef559906283b Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 15:25:07 -0400
Subject: [PATCH 11/29] docs: add standard code of conduct
---
CODE_OF_CONDUCT.md | 68 ++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 68 insertions(+)
create mode 100644 CODE_OF_CONDUCT.md
diff --git a/CODE_OF_CONDUCT.md b/CODE_OF_CONDUCT.md
new file mode 100644
index 00000000..e731ba03
--- /dev/null
+++ b/CODE_OF_CONDUCT.md
@@ -0,0 +1,68 @@
+# NOAA Fisheries Open Science Code of Conduct
+
+This code of conduct was developed and adapted from the Atom code of conduct in October 2021,
+and revised from NOAA-NMFS-Brand-Resources in June 2024
+
+## Our Pledge
+
+In the interest of fostering an open and welcoming environment, we as
+contributors and maintainers pledge to making participation in our project and
+our community a harassment-free experience for everyone.
+
+## Our Standards
+
+Examples of behavior that contributes to creating a positive environment
+include:
+
+* Using welcoming and inclusive language
+* Being respectful of differing viewpoints and experiences
+* Gracefully accepting constructive criticism
+* Focusing on what is best for the community
+* Showing empathy towards other community members
+
+Examples of unacceptable behavior by participants include:
+
+* The use of sexualized language or imagery and unwelcome sexual attention or
+ advances
+* Trolling, insulting/derogatory comments, and personal or political attacks
+* Public or private harassment
+* Publishing others' private information, such as a physical or electronic
+ address, without explicit permission
+* Other conduct which could reasonably be considered inappropriate in a
+ professional setting
+
+## Our Responsibilities
+
+Project maintainers are responsible for clarifying the standards of acceptable
+behavior and are expected to take appropriate and fair corrective action in
+response to any instances of unacceptable behavior.
+
+Project maintainers have the right and responsibility to remove, edit, or
+reject comments, commits, code, wiki edits, issues, and other contributions
+that are not aligned to this Code of Conduct, or to ban temporarily or
+permanently any contributor for other behaviors that they deem inappropriate,
+threatening, offensive, or harmful.
+
+## Scope
+
+This Code of Conduct applies both within project spaces and in public spaces
+when an individual is representing the project or its community. Examples of
+representing a project or community include using an official project e-mail
+address, posting via an official social media account, or acting as an appointed
+representative at an online or offline event. Representation of a project may be
+further defined and clarified by project maintainers.
+
+## Enforcement
+
+Instances of abusive, harassing, or otherwise unacceptable behavior may be reported
+by contacting the project team. All complaints will be reviewed and investigated
+and will result in a response that is deemed necessary and appropriate to the
+circumstances. Further details of specific enforcement policies may be posted
+separately.
+
+## Attribution
+
+This Code of Conduct is adapted from the [Contributor Covenant](https://www.contributor-covenant.org/), version 1.4,
+available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html
+
+
From 45d1a4c364b834b01115b9e0f699185f0bd98da9 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 15:28:23 -0400
Subject: [PATCH 12/29] docs: add standard contributing guidelines
---
CONTRIBUTING.md | 161 ++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 161 insertions(+)
create mode 100644 CONTRIBUTING.md
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
new file mode 100644
index 00000000..41f9051c
--- /dev/null
+++ b/CONTRIBUTING.md
@@ -0,0 +1,161 @@
+# Contributing Guidelines
+
+*Pull requests, bug reports, and all other forms of contribution are welcomed and highly encouraged!*
+
+### Contents
+
+- [Code of Conduct](#book-code-of-conduct)
+- [Asking Questions](#paperclip-asking-questions)
+- [Acceptable Types](#whale-acceptable-types)
+- [Opening an Issue](#fishing_pole_and_fish-opening-an-issue)
+- [Bug Reports and Other Issues](#blowfish-bug-reports-and-other-issues)
+- [Feature Requests](#tropical_fish-feature-requests)
+- [Creating a Branch](#anchor-creating-a-branch)
+- [Writing Commit Messages](#memo-writing-commit-messages)
+- [Submitting Pull Requests](#fish_cake-submitting-pull-requests)
+- [Coding Style](#shark-coding-style)
+- [Certificate of Origin](#crab-certificate-of-origin)
+- [Credits](#pray-credits)
+
+> **This guide serves to set clear expectations for everyone involved with the project so that we can improve it together while also creating a welcoming space for everyone to participate. Following these guidelines will help ensure a positive experience for contributors and maintainers.**
+
+## :book: Code of Conduct
+
+Please review our [Code of Conduct](CODE_OF_CONDUCT.md). It is in effect at all times. We expect it to be honored by everyone who contributes to this project.
+
+## :paperclip: Asking Questions
+
+GitHub issues are not the appropriate place to debug your specific project, but should be reserved for filing bugs and feature requests.
+
+## :whale: Acceptable Types
+
+Throughout this project, we use standard `types` to communicate more effectively. These types are used when labeling issues, creating branches, committing changes and naming pull requests. Please reference and use the `types` below when contributing to this project:
+
+- **fix:** Patch an unexpected or undesirable behavior
+
+- **build:** Add or modify build-related components (e.g. workflows, versioning, etc.)
+
+- **chore:** Maintenance of product or repository (e.g. gitignore, templates, etc.)
+
+- **docs:** Add or modify documentation
+
+- **feature:** Add or modify a feature or functionality
+
+- **refactor:** Rewrite or restructure code without altering behavior
+
+- **style:** Reformat code style without altering behavior
+
+- **test:** Add or modify tests
+
+All issues, branches, commits and pull requests should align with one of the above `types`. If you have questions or need assistance, please reach out to a maintainer.
+
+## :fishing_pole_and_fish: Opening an Issue
+
+Before [creating an issue](https://help.github.com/en/github/managing-your-work-on-github/creating-an-issue), check that you are using the latest version of the project. If you are not up-to-date, see if updating fixes your issue first.
+
+### :blowfish: Bug Reports and Other Issues
+
+A great way to contribute to the project is to send a detailed issue when you encounter a problem.
+This repo has a 'Bug Report' issue template that will guide you in submitting a well-written, thorough bug report. If possible, please also create a [reprex](https://reprex.tidyverse.org/) and include it in your issue. This helps us quickly identify and fix the problem.
+
+When opening an issue, please follow these guidelines:
+
+- **Review the documentation** before opening a new issue.
+
+- **Be specific.** Describe the problem in detail. What did you expect to happen? What actually happened? What were you doing when the problem occurred? What version of the library are you using? What version of the OS are you running?
+
+- **Provide a reproducible example (e.g. [reprex](https://reprex.tidyverse.org/))** If possible, provide a minimal, complete, and verifiable example that reproduces the issue. This is often the most important part of a bug report. If you can provide a sample project that reproduces the issue, that is even better!
+
+- **Prefer using [reactions](https://github.blog/2016-03-10-add-reactions-to-pull-requests-issues-and-comments/)**, not comments, if you simply want to "+1" an existing issue.
+
+- **Use [GitHub-flavored Markdown](https://help.github.com/en/github/writing-on-github/basic-writing-and-formatting-syntax).** Especially put code blocks and console outputs in backticks (```). This improves readability. In short, since you are most likely a developer, **provide a ticket that you would like to receive**.
+
+- **Do not open a duplicate issue!** Search through existing issues to see if your issue has previously been reported. If your issue exists, comment with any additional information you have. You may simply leave a reaction to bump the issue, which helps prioritize the most common problems and requests.
+
+- **Fully complete the provided issue template.** The bug report template requests all the information we need to quickly and efficiently address your issue. Be clear, concise, and descriptive. Provide as much information as you can, including steps to reproduce, stack traces, compiler errors, library versions, OS versions, and screenshots (if applicable).
+
+### :tropical_fish: Feature Requests
+
+Feature requests are more than welcome! While we will consider all requests, we cannot guarantee your request will be accepted or provide the timeline for implementation and release.
+
+- **Do not open a duplicate feature request.** Search for existing feature requests first. If you find your feature (or one very similar) previously requested, comment on or add a reaction to that issue.
+
+- **Fully complete the provided issue template.** The 'Feature Request' template asks for all necessary information for us to begin a productive conversation.
+
+- **Be precise** about the proposed outcome of the feature and how it relates to existing features. Include all implementation details.
+
+## :anchor: Creating a Branch
+
+Many contributions to this project will make use of [branching](https://docs.github.com/en/pull-requests/collaborating-with-pull-requests/proposing-changes-to-your-work-with-pull-requests/about-branches). This repo has two permanent branches: `main` and `dev`. To contribute via branching, you should create a branch from and pull request to the `dev` branch. Your branch name should follow these conventions:
+
+- Use `type/i#-describe-branch-purpose`, where # is the number of the target issue
+- Prefix with the `type` of change the branch will introduce (see [acceptable `types`](#whale-acceptable-types) above)
+- Include an issue number in your branch name (your changes should relate to an [existing issue](#fishing_pole_and_fish-opening-an-issue))
+- Provide a clear but concise description of the branch's purpose
+
+## :memo: Writing Commit Messages
+
+Please write a **conventional** commit message:
+
+1. Use `type(optional scope): commit message` structure (see above for [acceptable `types`](#whale-acceptable-types))
+1. Separate changes into their own commits with unique messages
+1. Write using imperative mood (example: "fix: correct the food web")
+1. Include a `scope` if a commit serves a larger purpose (example: "refactor(food web fix): reorder data ingestion")
+1. Be as brief as possible without losing clarity
+
+## :fish_cake: Submitting Pull Requests
+
+We appreciate pull requests! Before [forking the repo](https://help.github.com/en/github/getting-started-with-github/fork-a-repo) and [creating a pull request](https://help.github.com/en/github/collaborating-with-issues-and-pull-requests/proposing-changes-to-your-work-with-pull-requests) for non-trivial changes, it is usually best to first open an issue to discuss the changes, or discuss your intended approach for solving the problem in the comments for an existing issue.
+
+*Note: All contributions will be licensed under the project's license.*
+
+**Guidelines for happy pull requests:**
+
+- **Title meaningfully.** Consistent with the convention elsewhere, please title your pull request: "Type(#i): Describe Change Purpose", where "i" is the number of the issue addressed by the PR. Please reference the [acceptable types](#whale-acceptable-types) above.
+
+- **Request appropriate reviewers.** At the very least, please request review from one or all of the project maintainers (maintainers are listed on the [README](README.md)). You should include additional reviews from people familiar with the subject or problem your proposed changes address.
+
+- **Communication is the key to success.** If you are unsure about something, ask! We are happy to help. We have an open channel of communication, make sure to reach out and further develop your ideas or changes before working on a pull request.
+
+- **Smaller is better.** Submit **one** pull request per bug fix or feature. A pull request should contain isolated changes pertaining to a single bug fix or feature implementation. **Do not** refactor or reformat code that is unrelated to your change. It is better to **submit many small pull requests** rather than a single large one. Enormous pull requests will take enormous amounts of time to review, or may be rejected altogether.
+
+- **Coordinate bigger changes.** For large and non-trivial changes, open an issue to discuss a strategy with the maintainers. Otherwise, you risk doing a lot of work for nothing!
+
+- **Prioritize understanding over cleverness.** Write code **clearly** and **concisely**, please supply comments when it is needed. Remember that source code usually gets written once and read often. Ensure the code is clear to the reader. The purpose and logic should be obvious to a reasonably skilled developer, otherwise you should add a comment that explains it.
+
+- **Follow the existing architecture.** If you are adding new functionality, try to follow the existing architecture and patterns in the code base. If you are unsure, ask for guidance.
+
+- **Include test coverage.** Add unit tests or UI tests when possible. Follow existing patterns for implementing tests.
+
+- **Update the example project** if one exists to exercise any new functionality you have added.
+
+- **Add documentation.** Document your changes with code comments or other documentation.
+
+- **Use the correct branch.** Branch from and [submit your pull request](https://help.github.com/en/github/collaborating-with-issues-and-pull-requests/creating-a-pull-request-from-a-fork) to the correct branch (see above for [branching instructions](#anchor-creating-a-branch)). In this repo, it will be the `dev` branch.
+
+- **[Resolve any merge conflicts](https://help.github.com/en/github/collaborating-with-issues-and-pull-requests/resolving-a-merge-conflict-on-github)** that occur.
+
+## :shark: Coding Style
+
+Consistent formatting is an essential part of effective collaboration and communication. Reading, writing and reviewing code all benefit from following the standards and conventions of a project. Failure to do so will result in a prolonged review process that has to focus on updating the superficial aspects of your code, rather than improving its functionality and performance. This repo uses and adheres to the [tidyverse style guide](https://style.tidyverse.org/) and the [Air autoformatting tool](https://posit-dev.github.io/air/) that follows it. Please read and follow these guides as you make contributions to the project.
+
+## :crab: Certificate of Origin
+
+*Developer's Certificate of Origin 1.1*
+
+By making a contribution to this project, I certify that:
+
+> 1. The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or
+> 1. The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or
+> 1. The contribution was provided directly to me by some other person who certified (1), (2) or (3) and I have not modified it.
+> 1. I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved.
+
+## :fish: Thank You!
+
+If you are reading this, thank you! We appreciate your interest in contributing to this project.
+
+To confirm that you have read this guide and are following it as best as possible, **include this emoji at the top** of your issue or pull request: :fish: `:fish:`
+
+## :pray: Credits
+
+This document was inspired by [@jessesquires](https://github.com/jessesquires).
From d6455bde27c7ea47766beb64a91cebee57f24728 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 16:15:47 -0400
Subject: [PATCH 13/29] docs: rewrite README with new information and new links
---
README.md | 27 ++++++++++++++++++---------
1 file changed, 18 insertions(+), 9 deletions(-)
diff --git a/README.md b/README.md
index 3013c72a..471721b7 100644
--- a/README.md
+++ b/README.md
@@ -1,19 +1,28 @@
# tech-doc
[](https://github.com/NOAA-EDAB/tech-doc/actions/workflows/bookdown.yaml)
-[
+[](https://github.com/NOAA-EDAB/tech-doc/actions/workflows/secretScan.yml)
[](https://github.com/NOAA-EDAB/tech-doc/actions/workflows/verify_pr.yml)
-Technical documentation for State of the Ecosystem indicators and general methods.
+## Overview
+`tech-doc` is a bookdown document developed by the Ecosystem Dynamics and Assessment Branch of the Northeast Fisheries Science Center which details the methodology used to create and maintain the indicators featured in State of the Ecosystem (SOE) reporting. In addition to methods specific to each indictor, `tech-doc` also includes general methods related to the production, maintenance and dissemination of the SOE reports and other regional information. This document should be referenced when using the [`ecodata` package](https://noaa-edab.github.io/ecodata/) to access SOE indicators or datasets. For more context regarding SOE indicators, please see the [Northeast US Ecosystem Indicator Catalog](https://noaa-edab.github.io/catalog/). Full SOE reports can be accessed using the table below:
-| Year | Technical Documentation | State of the Ecosystem: Mid-Atlantic | State of the Ecosystem: New England |
-|--------------|-----------|--------------|----------------------------|
-|2020 | [Technical Documentation, State of the Ecosystem 2020](https://doi.org/10.25923/64pf-sc70) | [State of the Ecosystem: Mid-Atlantic 2020](https://doi.org/10.25923/1f8j-d564) | [State of the Ecosystem: New England 2020](https://doi.org/10.25923/4tdk-eg57) |
-| 2021 | [Technical Documentation, State of the Ecosystem 2021](https://repository.library.noaa.gov/view/noaa/29277) | [State of the Ecosystem: Mid-Atlantic 2021](https://doi.org/10.25923/jd1w-dc26) | [State of the Ecosystem: New England 2021](https://doi.org/10.25923/6pww-mw45]) |
-| 2022 | [Technical Documentation, State of the Ecosystem 2022](
-https://doi.org/10.25923/xq8b-dn10) | [State of the Ecosystem: Mid-Atlantic 2022](https://doi.org/10.25923/5s5y-0h81) | [State of the Ecosystem: New England 2022](https://doi.org/10.25923/ypv2-mw79]) |
+| Year | State of the Ecosystem: New England | State of the Ecosystem: Mid-Atlantic |
+|------|-------------------------------------|--------------------------------------|
+| 2020 | [State of the Ecosystem 2020: New England](https://doi.org/10.25923/4tdk-eg57) | [State of the Ecosystem 2020: Mid-Atlantic](https://doi.org/10.25923/1f8j-d564) |
+| 2021 | [State of the Ecosystem 2021: New England](https://doi.org/10.25923/6pww-mw45) | [State of the Ecosystem 2021: Mid-Atlantic](https://doi.org/10.25923/jd1w-dc26) |
+| 2022 | [State of the Ecosystem 2022: New England](https://doi.org/10.25923/ypv2-mw79) | [State of the Ecosystem 2022: Mid-Atlantic](https://doi.org/10.25923/5s5y-0h81) |
+| 2023 | [State of the Ecosystem 2023: New England](https://doi.org/10.25923/9sb9-nj66) | [State of the Ecosystem 2023: Mid-Atlantic](https://doi.org/10.25923/vy6j-w454) |
+| 2024 | [State of the Ecosystem 2024: New England](https://doi.org/10.25923/f8xc-hj17) | [State of the Ecosystem 2024: Mid-Atlantic](https://doi.org/10.25923/vz5a-d111) |
+| 2025 | [State of the Ecosystem 2025: New England](https://doi.org/10.25923/zr75-a788) | [State of the Ecosystem 2025: Mid-Atlantic](https://doi.org/10.25923/23nx-qf59) |
+## Maintainers
+| [Brandon Beltz](https://github.com/BBeltz1) | [Andy Beet](https://github.com/andybeet) |
+|---------------------------------------------|---------------------------------------------|
+| [](https://github.com/BBeltz1) | [](https://github.com/andybeet) |
-This repository is a scientific product and is not official communication of the National Oceanic and Atmospheric Administration, or the United States Department of Commerce. All NOAA GitHub project code is provided on an ‘as is’ basis and the user assumes responsibility for its use. Any claims against the Department of Commerce or Department of Commerce bureaus stemming from the use of this GitHub project will be governed by all applicable Federal law. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by the Department of Commerce. The Department of Commerce seal and logo, or the seal and logo of a DOC bureau, shall not be used in any manner to imply endorsement of any commercial product or activity by DOC or the United States Government.
+## Legal Disclaimer
+
+This repository is a scientific product and is not official communication of the National Oceanic and Atmospheric Administration, or the United States Department of Commerce. All NOAA GitHub project code is provided on an 'as is' basis and the user assumes responsibility for its use. Any claims against the Department of Commerce or Department of Commerce bureaus stemming from the use of this GitHub project will be governed by all applicable Federal law. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by the Department of Commerce. The Department of Commerce seal and logo, or the seal and logo of a DOC bureau, shall not be used in any manner to imply endorsement of any commercial product or activity by DOC or the United States Government.
From 4bc56c5a2b228ec6472f3f6640b822efd2cbefd9 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 16:20:09 -0400
Subject: [PATCH 14/29] docs: reduce excess space in maintainer table
---
README.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/README.md b/README.md
index 471721b7..515f747b 100644
--- a/README.md
+++ b/README.md
@@ -20,7 +20,7 @@
## Maintainers
| [Brandon Beltz](https://github.com/BBeltz1) | [Andy Beet](https://github.com/andybeet) |
-|---------------------------------------------|---------------------------------------------|
+|----|----|
| [](https://github.com/BBeltz1) | [](https://github.com/andybeet) |
## Legal Disclaimer
From d1b79b0da8e1c2dacbd02c43d6022ba1d2f5f1cc Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 16:25:33 -0400
Subject: [PATCH 15/29] docs: switch maintainer images to html for correct
resizing
---
README.md | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/README.md b/README.md
index 515f747b..c0748acd 100644
--- a/README.md
+++ b/README.md
@@ -21,7 +21,7 @@
| [Brandon Beltz](https://github.com/BBeltz1) | [Andy Beet](https://github.com/andybeet) |
|----|----|
-| [](https://github.com/BBeltz1) | [](https://github.com/andybeet) |
+| 
| 
|
## Legal Disclaimer
From aae2081d1886db1306d2e9afa983f8c0ca29c7c4 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Thu, 23 Jul 2026 16:51:43 -0400
Subject: [PATCH 16/29] docs: expand README title and link to online document
---
README.md | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/README.md b/README.md
index c0748acd..4eaea0a5 100644
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-# tech-doc
+# Technical Documentation, State of the Ecosystem
[](https://github.com/NOAA-EDAB/tech-doc/actions/workflows/bookdown.yaml)
[](https://github.com/NOAA-EDAB/tech-doc/actions/workflows/secretScan.yml)
@@ -6,7 +6,7 @@
## Overview
-`tech-doc` is a bookdown document developed by the Ecosystem Dynamics and Assessment Branch of the Northeast Fisheries Science Center which details the methodology used to create and maintain the indicators featured in State of the Ecosystem (SOE) reporting. In addition to methods specific to each indictor, `tech-doc` also includes general methods related to the production, maintenance and dissemination of the SOE reports and other regional information. This document should be referenced when using the [`ecodata` package](https://noaa-edab.github.io/ecodata/) to access SOE indicators or datasets. For more context regarding SOE indicators, please see the [Northeast US Ecosystem Indicator Catalog](https://noaa-edab.github.io/catalog/). Full SOE reports can be accessed using the table below:
+[Tech-Doc](https://noaa-edab.github.io/tech-doc/) is a bookdown document developed by the Ecosystem Dynamics and Assessment Branch of the Northeast Fisheries Science Center which details the methodology used to create and maintain the indicators featured in State of the Ecosystem (SOE) reporting. In addition to methods specific to each indictor, `tech-doc` also includes general methods related to the production, maintenance and dissemination of the SOE reports and other regional information. This document should be referenced when using the [`ecodata` package](https://noaa-edab.github.io/ecodata/) to access SOE indicators or datasets. For more context regarding SOE indicators, please see the [Northeast US Ecosystem Indicator Catalog](https://noaa-edab.github.io/catalog/). Full SOE reports can be accessed using the table below:
| Year | State of the Ecosystem: New England | State of the Ecosystem: Mid-Atlantic |
|------|-------------------------------------|--------------------------------------|
From 028bf4f6e03139d65e47a3799a0d72b791d2931a Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Fri, 24 Jul 2026 12:35:56 -0400
Subject: [PATCH 17/29] chore: remove automatic assignment
---
.github/ISSUE_TEMPLATE/page_edit.yml | 1 -
.github/ISSUE_TEMPLATE/techdoc_submission.yml | 1 -
2 files changed, 2 deletions(-)
diff --git a/.github/ISSUE_TEMPLATE/page_edit.yml b/.github/ISSUE_TEMPLATE/page_edit.yml
index 5b7cdc19..01577479 100644
--- a/.github/ISSUE_TEMPLATE/page_edit.yml
+++ b/.github/ISSUE_TEMPLATE/page_edit.yml
@@ -2,7 +2,6 @@ name: State of the Ecosystem - Edit Tech Doc Page
description: Use this issue template to suggest an edit to a page in the State of the Ecosystem technical documentation.
title: "[Tech Doc Page Edit]: "
labels: ["page edit"]
-assignees: "BBeltz1"
body:
- type: markdown
attributes:
diff --git a/.github/ISSUE_TEMPLATE/techdoc_submission.yml b/.github/ISSUE_TEMPLATE/techdoc_submission.yml
index 786cb0d8..2a464128 100644
--- a/.github/ISSUE_TEMPLATE/techdoc_submission.yml
+++ b/.github/ISSUE_TEMPLATE/techdoc_submission.yml
@@ -2,7 +2,6 @@ name: State of the Ecosystem - Tech Doc Submission
description: Use this issue template to submit tech doc information for the State of the Ecosystem reports.
title: "[Submission]: "
labels: ["submission"]
-assignees: "BBeltz1"
body:
- type: markdown
attributes:
From 70194329cc63e12213d3174b136340a8da1e3043 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Fri, 24 Jul 2026 13:13:10 -0400
Subject: [PATCH 18/29] build: update workflow triggers and bump action
versions
---
.github/workflows/bookdown.yaml | 11 +++--------
1 file changed, 3 insertions(+), 8 deletions(-)
diff --git a/.github/workflows/bookdown.yaml b/.github/workflows/bookdown.yaml
index c1a99526..c4242f41 100644
--- a/.github/workflows/bookdown.yaml
+++ b/.github/workflows/bookdown.yaml
@@ -4,12 +4,7 @@ on:
push:
branches:
- main
- - dev
-
- pull_request:
- branches:
- - main
-
+ workflow_dispatch:
name: build-book
@@ -22,7 +17,7 @@ jobs:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
runs-on: ubuntu-latest
steps:
- - uses: actions/checkout@v3
+ - uses: actions/checkout@v6
- uses: r-lib/actions/setup-pandoc@v2
@@ -36,7 +31,7 @@ jobs:
run: Rscript -e 'bookdown::render_book("index.Rmd", quiet = TRUE)'
- name: Deploy to gh-pages
- uses: JamesIves/github-pages-deploy-action@v4
+ uses: JamesIves/github-pages-deploy-action@v4.8.0
with:
GITHUB_TOKEN: ${{ secrets.ACCESS_TOKEN }}
BRANCH: gh-pages # The branch the action should deploy to.
From 2935a799ee8c586a967f9c24c70af77997233669 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Fri, 24 Jul 2026 13:13:30 -0400
Subject: [PATCH 19/29] build: bump checkout action version
---
.github/workflows/secretScan.yml | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/.github/workflows/secretScan.yml b/.github/workflows/secretScan.yml
index 32f7e3f1..e44d6a3d 100644
--- a/.github/workflows/secretScan.yml
+++ b/.github/workflows/secretScan.yml
@@ -6,7 +6,7 @@ jobs:
gitleaks:
runs-on: ubuntu-latest
steps:
- - uses: actions/checkout@v2
+ - uses: actions/checkout@v6
with:
fetch-depth: '2'
- name: gitleaks-action
From 3ef680893c605a92218cca7c96716ca69ac758db Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Fri, 24 Jul 2026 13:25:51 -0400
Subject: [PATCH 20/29] build: add changelog scan to verify PR workflow
---
.github/workflows/verify_pr.yml | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/.github/workflows/verify_pr.yml b/.github/workflows/verify_pr.yml
index fd3b3b0d..63a78c39 100644
--- a/.github/workflows/verify_pr.yml
+++ b/.github/workflows/verify_pr.yml
@@ -13,3 +13,8 @@ jobs:
uses: takanuva15/verify-file-updated@v1
with:
filename_to_check: DESCRIPTION
+
+ - name: Verify Changelog Updated
+ uses: takanuva15/verify-file-updated@v1
+ with:
+ filename_to_check: changelog.Rmd
From 5ffbd2d7b0a8bbe312e0f1e56bb0fca4ce7f0d1b Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Fri, 24 Jul 2026 16:00:32 -0400
Subject: [PATCH 21/29] style: add air.toml file to homogenize autoformatting
---
air.toml | 0
1 file changed, 0 insertions(+), 0 deletions(-)
create mode 100644 air.toml
diff --git a/air.toml b/air.toml
new file mode 100644
index 00000000..e69de29b
From baebb85fb09683473f4f2ffe96ed470851e3c9be Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Fri, 24 Jul 2026 16:01:03 -0400
Subject: [PATCH 22/29] style: create workflow to check formatting
---
.github/workflows/format-check.yml | 24 ++++++++++++++++++++++++
1 file changed, 24 insertions(+)
create mode 100644 .github/workflows/format-check.yml
diff --git a/.github/workflows/format-check.yml b/.github/workflows/format-check.yml
new file mode 100644
index 00000000..9ba132d6
--- /dev/null
+++ b/.github/workflows/format-check.yml
@@ -0,0 +1,24 @@
+# Workflow derived from https://github.com/posit-dev/setup-air/tree/main/examples
+
+on:
+ push:
+ branches: [main, dev]
+ pull_request:
+ workflow_dispatch:
+
+name: format-check.yaml
+
+permissions: read-all
+
+jobs:
+ format-check:
+ name: format-check
+ runs-on: ubuntu-latest
+ steps:
+ - uses: actions/checkout@v6
+
+ - name: Install
+ uses: posit-dev/setup-air@v1
+
+ - name: Check
+ run: air format . --check
\ No newline at end of file
From 486f29a9e1e059923f417b8d1e4de51a22db1aca Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Fri, 24 Jul 2026 16:01:18 -0400
Subject: [PATCH 23/29] style: create workflow to suggest formatting
corrections in PRs
---
.github/workflows/format-suggest.yml | 31 ++++++++++++++++++++++++++++
1 file changed, 31 insertions(+)
create mode 100644 .github/workflows/format-suggest.yml
diff --git a/.github/workflows/format-suggest.yml b/.github/workflows/format-suggest.yml
new file mode 100644
index 00000000..63f7c02d
--- /dev/null
+++ b/.github/workflows/format-suggest.yml
@@ -0,0 +1,31 @@
+# Workflow derived from https://github.com/posit-dev/setup-air/tree/main/examples
+
+on:
+ pull_request:
+
+name: format-suggest.yaml
+
+jobs:
+ format-suggest:
+ name: format-suggest
+ runs-on: ubuntu-latest
+
+ permissions:
+ # Required to push suggestion comments to the PR
+ pull-requests: write
+
+ steps:
+ - uses: actions/checkout@v6
+
+ - name: Install
+ uses: posit-dev/setup-air@v1
+
+ - name: Format
+ run: air format .
+
+ - name: Suggest
+ uses: reviewdog/action-suggester@v1
+ with:
+ level: error
+ fail_level: error
+ tool_name: air
From df609b46b73446846e157cd84bc0e5058cd47946 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Mon, 27 Jul 2026 11:52:07 -0400
Subject: [PATCH 24/29] style: reformat entire codebase
---
R/BasePlot_source.R | 525 +-
R/GIS_source.R | 32 +-
R/clean_env.R | 12 +-
R/find_contributors.R | 46 +-
R/find_text.R | 34 +-
R/get_erddap.R | 49 +-
R/stored_scripts/CalanusStage_SOE.R | 470 +-
.../Gruenburg_Hudson_River_Flow.R | 92 +-
R/stored_scripts/SOE-VASTForageIndices.R | 129 +-
.../WindRevenue_Code_for_Dissemination.R | 221 +-
.../annual_sst_cycles_analysis_and_plotting.R | 668 ++-
...ual_sst_cycles_extraction_and_processing.R | 295 +-
R/stored_scripts/bennet_analysis.R | 145 +-
R/stored_scripts/bennet_extraction.R | 126 +-
.../catch_and_fleet_diversity_plotting.R | 83 +-
R/stored_scripts/comm_rel_vuln_plotting.R | 136 +-
.../erddap_query_and_build_code.R | 103 +-
R/stored_scripts/hms_landings_plotting.R | 82 +-
R/stored_scripts/hp_indicator_plotting.R | 109 +-
R/stored_scripts/ich_div_plotting.R | 66 +-
R/stored_scripts/inshore_survey_analysis.R | 332 +-
R/stored_scripts/landings_extraction.R | 4840 +++++++++--------
R/stored_scripts/long-term-sst-extraction.R | 409 +-
R/stored_scripts/mab_hab_extraction.R | 373 +-
R/stored_scripts/ne_hab_plotting.R | 201 +-
R/stored_scripts/observer_data_plotting.R | 129 +-
R/stored_scripts/occupancy_plotting.R | 74 +-
R/stored_scripts/rec_catch_div_analysis.R | 62 +-
R/stored_scripts/rec_div_analysis.R | 75 +-
R/stored_scripts/rec_effort_div_analysis.R | 75 +-
R/stored_scripts/seabird_ne_div_analysis.R | 46 +-
R/stored_scripts/slopewater_analysis.R | 64 +-
R/stored_scripts/species_density_analysis.R | 801 ++-
.../species_distribution_analysis.R | 832 +--
R/stored_scripts/trend_analysis.R | 763 +--
R/stored_scripts/zooplankton_analysis.R | 588 +-
_common.R | 2 +-
data-raw/simplify_coastline.R | 48 +-
38 files changed, 7559 insertions(+), 5578 deletions(-)
diff --git a/R/BasePlot_source.R b/R/BasePlot_source.R
index 8336e256..126eed5f 100644
--- a/R/BasePlot_source.R
+++ b/R/BasePlot_source.R
@@ -1,13 +1,26 @@
#Base time series plots R code
#Libraries
-library(here);library(Kendall);library(data.table)
-library(dplyr);library(nlme);library(AICcmodavg)
-library(colorRamps);library(Hmisc);library(rgdal)
-library(maps);library(raster);library(mapdata)
-library(grid);library(stringr);library(png)
-library(ncdf4);library(marmap); library(magick);
-library(knitr);library(zoo)
+library(here)
+library(Kendall)
+library(data.table)
+library(dplyr)
+library(nlme)
+library(AICcmodavg)
+library(colorRamps)
+library(Hmisc)
+library(rgdal)
+library(maps)
+library(raster)
+library(mapdata)
+library(grid)
+library(stringr)
+library(png)
+library(ncdf4)
+library(marmap)
+library(magick)
+library(knitr)
+library(zoo)
#Set data directory
data.dir <- here("data")
@@ -18,99 +31,122 @@ fit_lm <- function(dat) {
# Remove missing values first so that all models
# use the same number of observations (important for AIC)
# dat <- dat %>% dplyr::filter(complete.cases(.))
-
- # Constant model (null model used to calculate
+
+ # Constant model (null model used to calculate
# overall p-value)
constant_norm <-
- nlme::gls(series ~ 1,
- data = dat)
-
+ nlme::gls(series ~ 1, data = dat)
+
constant_ar1 <-
- try(nlme::gls(series ~ 1,
- data = dat,
- correlation = nlme::corAR1(form = ~time)))
- if (class(constant_ar1) == "try-error"){
- return(best_lm <- data.frame(model = NA,
- aicc = NA,
- coefs..Intercept = NA,
- coefs.time = NA,
- coefs.time2 = NA,
- pval = NA))
- }
-
-
-
+ try(nlme::gls(
+ series ~ 1,
+ data = dat,
+ correlation = nlme::corAR1(form = ~time)
+ ))
+ if (class(constant_ar1) == "try-error") {
+ return(
+ best_lm <- data.frame(
+ model = NA,
+ aicc = NA,
+ coefs..Intercept = NA,
+ coefs.time = NA,
+ coefs.time2 = NA,
+ pval = NA
+ )
+ )
+ }
+
# Linear model with normal error
- linear_norm <-
- nlme::gls(series ~ time,
- data = dat)
-
+ linear_norm <-
+ nlme::gls(series ~ time, data = dat)
+
# Linear model with AR1 error
- linear_ar1 <-
- try(nlme::gls(series ~ time,
- data = dat,
- correlation = nlme::corAR1(form = ~time)))
- if (class(linear_ar1) == "try-error"){
- return(best_lm <- data.frame(model = NA,
- aicc = NA,
- coefs..Intercept = NA,
- coefs.time = NA,
- coefs.time2 = NA,
- pval = NA))
-
+ linear_ar1 <-
+ try(nlme::gls(
+ series ~ time,
+ data = dat,
+ correlation = nlme::corAR1(form = ~time)
+ ))
+ if (class(linear_ar1) == "try-error") {
+ return(
+ best_lm <- data.frame(
+ model = NA,
+ aicc = NA,
+ coefs..Intercept = NA,
+ coefs.time = NA,
+ coefs.time2 = NA,
+ pval = NA
+ )
+ )
}
-
+
# Polynomial model with normal error
dat$time2 <- dat$time^2
- poly_norm <-
- nlme::gls(series ~ time + time2,
- data = dat)
-
+ poly_norm <-
+ nlme::gls(series ~ time + time2, data = dat)
+
# Polynomial model with AR1 error
- poly_ar1 <-
- try(nlme::gls(series ~ time + time2,
- data = dat,
- correlation = nlme::corAR1(form = ~time)))
- if (class(poly_ar1) == "try-error"){
- return(best_lm <- data.frame(model = NA,
- aicc = NA,
- coefs..Intercept = NA,
- coefs.time = NA,
- coefs.time2 = NA,
- pval = NA))
-
+ poly_ar1 <-
+ try(nlme::gls(
+ series ~ time + time2,
+ data = dat,
+ correlation = nlme::corAR1(form = ~time)
+ ))
+ if (class(poly_ar1) == "try-error") {
+ return(
+ best_lm <- data.frame(
+ model = NA,
+ aicc = NA,
+ coefs..Intercept = NA,
+ coefs.time = NA,
+ coefs.time2 = NA,
+ pval = NA
+ )
+ )
}
-
+
# Calculate AICs for all models
df_aicc <-
- data.frame(model = c("poly_norm",
- "poly_ar1",
- "linear_norm",
- "linear_ar1"),
- aicc = c(AICc(poly_norm),
- AICc(poly_ar1),
- AICc(linear_norm),
- AICc(linear_ar1)),
- coefs = rbind(coef(poly_norm),
- coef(poly_ar1),
- c(coef(linear_norm), NA),
- c(coef(linear_ar1), NA)),
- # Calculate overall signifiance (need to use
- # ML not REML for this)
- pval = c(anova(update(constant_norm, method = "ML"),
- update(poly_norm, method = "ML"))$`p-value`[2],
- anova(update(constant_ar1, method = "ML"),
- update(poly_ar1, method = "ML"))$`p-value`[2],
- anova(update(constant_norm, method = "ML"),
- update(linear_norm, method = "ML"))$`p-value`[2],
- anova(update(constant_ar1, method = "ML"),
- update(linear_ar1, method = "ML"))$`p-value`[2]))
-
+ data.frame(
+ model = c("poly_norm", "poly_ar1", "linear_norm", "linear_ar1"),
+ aicc = c(
+ AICc(poly_norm),
+ AICc(poly_ar1),
+ AICc(linear_norm),
+ AICc(linear_ar1)
+ ),
+ coefs = rbind(
+ coef(poly_norm),
+ coef(poly_ar1),
+ c(coef(linear_norm), NA),
+ c(coef(linear_ar1), NA)
+ ),
+ # Calculate overall signifiance (need to use
+ # ML not REML for this)
+ pval = c(
+ anova(
+ update(constant_norm, method = "ML"),
+ update(poly_norm, method = "ML")
+ )$`p-value`[2],
+ anova(
+ update(constant_ar1, method = "ML"),
+ update(poly_ar1, method = "ML")
+ )$`p-value`[2],
+ anova(
+ update(constant_norm, method = "ML"),
+ update(linear_norm, method = "ML")
+ )$`p-value`[2],
+ anova(
+ update(constant_ar1, method = "ML"),
+ update(linear_ar1, method = "ML")
+ )$`p-value`[2]
+ )
+ )
+
best_lm <-
df_aicc %>%
dplyr::filter(aicc == min(aicc))
-
-
+
if (best_lm$model == "poly_norm") {
model <- poly_norm
} else if (best_lm$model == "poly_ar1") {
@@ -120,222 +156,293 @@ fit_lm <- function(dat) {
} else if (best_lm$model == "linear_ar1") {
model <- linear_ar1
}
-
- return(list(p = best_lm$pval,
- model = model))
+
+ return(list(p = best_lm$pval, model = model))
}
#Plotting code
-soe.plot <- function(data, x.var, y.var, x.label = '', y.label = '', tol = 0.1,
- x.start = NA, x.end = NA, end.start = 2008, bg.col = background, mean_line = T,
- end.col = recent, stacked = NA, x.line = 2.5, y.line = 3.5, scale.axis = 1,
- rel.y.num = 1.5, rel.y.text = 1.5, suppressAxis = FALSE,status = F,anomaly = F,
- endshade = TRUE, full.trend = TRUE, point.cex = 1.5, lwd = 2, ymax = TRUE,ymin = TRUE,
- y.upper = y.upper, y.lower = y.lower, extra = FALSE, x.var2 = x.var2, y.var2 = y.var2,
- line.forward = FALSE, mean_line.2 = T, cex.stacked = 1) {
-
+soe.plot <- function(
+ data,
+ x.var,
+ y.var,
+ x.label = '',
+ y.label = '',
+ tol = 0.1,
+ x.start = NA,
+ x.end = NA,
+ end.start = 2008,
+ bg.col = background,
+ mean_line = T,
+ end.col = recent,
+ stacked = NA,
+ x.line = 2.5,
+ y.line = 3.5,
+ scale.axis = 1,
+ rel.y.num = 1.5,
+ rel.y.text = 1.5,
+ suppressAxis = FALSE,
+ status = F,
+ anomaly = F,
+ endshade = TRUE,
+ full.trend = TRUE,
+ point.cex = 1.5,
+ lwd = 2,
+ ymax = TRUE,
+ ymin = TRUE,
+ y.upper = y.upper,
+ y.lower = y.lower,
+ extra = FALSE,
+ x.var2 = x.var2,
+ y.var2 = y.var2,
+ line.forward = FALSE,
+ mean_line.2 = T,
+ cex.stacked = 1
+) {
#print("You'll need to remove or interpolate NA values before this function will work")
-
+
#Select Data
x <- data[Var == y.var, ]
x <- x[order(x[, get(x.var)]), ]
setnames(x, x.var, 'X')
-
+
#Set common time step if necessary
- if(is.na(x.start)) x.start <- min(x[, X])
- if(is.na(x.end)) x.end <- max(x[, X])
+ if (is.na(x.start)) {
+ x.start <- min(x[, X])
+ }
+ if (is.na(x.end)) {
+ x.end <- max(x[, X])
+ }
x <- x[X >= x.start, ]
-
+
#Set up plot parameters
- if (ymax == TRUE){
+ if (ymax == TRUE) {
y.max <- max(x[, Value]) + tol * max(x[, Value])
} else {
y.max <- as.numeric(y.upper)
}
-
- if (ymin == TRUE){
+
+ if (ymin == TRUE) {
y.min <- min(x[, Value]) - tol * abs(min(x[, Value]))
- } else if (ymin == FALSE){
+ } else if (ymin == FALSE) {
y.min <- as.numeric(y.lower)
}
-
+
y.mean <- mean(x[, Value])
y.sd <- sd(x[, Value])
-
+
#Plot blank plot
- plot(x[X >= x.start, list(X, Var)]$X, xlim = c(x.start, x.end),
- ylim = c(y.min,y.max), xlab = '', ylab = '', axes = F, ty = 'n')
-
-
+ plot(
+ x[X >= x.start, list(X, Var)]$X,
+ xlim = c(x.start, x.end),
+ ylim = c(y.min, y.max),
+ xlab = '',
+ ylab = '',
+ axes = F,
+ ty = 'n'
+ )
+
#Add background
u <- par('usr')
rect(u[1], u[3], u[2], u[4], border = NA, col = bg.col)
-
+
#Add end period shading
- if (endshade == TRUE){
+ if (endshade == TRUE) {
rect(end.start - 0.5, u[3], u[2], u[4], border = NA, col = end.col)
}
-
+
#Add mean line
- if (anomaly == F){
- if (mean_line == TRUE){
+ if (anomaly == F) {
+ if (mean_line == TRUE) {
abline(h = y.mean, col = 'grey', lwd = 3, lty = 2)
- }
- } else if (anomaly == TRUE){
+ }
+ } else if (anomaly == TRUE) {
abline(h = 0, col = 'grey', lwd = 3, lty = 2)
}
-
+
#Add x y lines
- abline(h = u[3], lwd=3)
- abline(v = u[1], lwd=3)
-
+ abline(h = u[3], lwd = 3)
+ abline(v = u[1], lwd = 3)
+
#Add data points/lines
points(x[, list(X, Value)], pch = 16, cex = point.cex)
- lines( x[, list(X, Value)], lwd = lwd)
-
+ lines(x[, list(X, Value)], lwd = lwd)
+
#extra lines
- if (extra == TRUE){
+ if (extra == TRUE) {
x2 <- data[Var == y.var2, ]
x2 <- x2[order(x2[, get(x.var2)]), ]
setnames(x2, x.var2, 'X2')
x2 <- x2[X2 >= x.start, ]
- if (mean_line.2 == TRUE){
- abline(h = mean(x2[, Value]), col = 'lightcoral', lwd = 3, lty = 2)
+ if (mean_line.2 == TRUE) {
+ abline(h = mean(x2[, Value]), col = 'lightcoral', lwd = 3, lty = 2)
}
points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
}
-
-
+
#Add axis
- if (suppressAxis == FALSE){
- if(is.na(stacked)) axis(1, cex.axis = 1)
- if(!is.na(stacked)){
- if(stacked!= 'A') axis(3, cex.axis = 1.5, tck = 0.1, labels = F)
+ if (suppressAxis == FALSE) {
+ if (is.na(stacked)) {
+ axis(1, cex.axis = 1)
+ }
+ if (!is.na(stacked)) {
+ if (stacked != 'A') axis(3, cex.axis = 1.5, tck = 0.1, labels = F)
}
}
-
+
#Stacked axes with 0 overlap so need to remove
labels <- round((axTicks(2) / scale.axis), 5)
- if(labels[1] == 0) labels[1] <- ''
- axis(2, at = axTicks(2), labels = labels, cex.axis = rel.y.num,
- las = T)
-
+ if (labels[1] == 0) {
+ labels[1] <- ''
+ }
+ axis(2, at = axTicks(2), labels = labels, cex.axis = rel.y.num, las = T)
+
#Add axis labels
- if(!is.na(stacked)) text(u[1], u[4], labels = stacked, cex = cex.stacked, adj = c(-0.5, 1.5))
- if(is.na(stacked)){
+ if (!is.na(stacked)) {
+ text(u[1], u[4], labels = stacked, cex = cex.stacked, adj = c(-0.5, 1.5))
+ }
+ if (is.na(stacked)) {
mtext(1, text = x.label, line = x.line, cex = 1)
mtext(2, text = y.label, line = y.line, cex = rel.y.text)
}
-
- if (full.trend == T){
+
+ if (full.trend == T) {
#Split data into past decade and full time series
dat <- as.data.frame(x[, list(X, Value)])
-
- dat <- dat %>% dplyr::rename(series = Value) %>%
- mutate(time = seq(1,nrow(dat),1))
-
+
+ dat <- dat %>%
+ dplyr::rename(series = Value) %>%
+ mutate(time = seq(1, nrow(dat), 1))
+
# Fit linear model
lm_out <- fit_lm(dat = dat)
p <- lm_out$p
- if (p < .05){
-
- newtime <- seq(min(dat$time), max(dat$time), length.out=length(dat$time))
- newdata <- data.frame(time = newtime,
- time2 = newtime^2)
- lm_pred <- AICcmodavg::predictSE(lm_out$model,
- newdata = newdata,
- se.fit = TRUE)
-
- year <- seq(x$X[1],x$X[length(x$X)],length.out = length(dat$time))
-
+ if (p < .05) {
+ newtime <- seq(
+ min(dat$time),
+ max(dat$time),
+ length.out = length(dat$time)
+ )
+ newdata <- data.frame(time = newtime, time2 = newtime^2)
+ lm_pred <- AICcmodavg::predictSE(
+ lm_out$model,
+ newdata = newdata,
+ se.fit = TRUE
+ )
+
+ year <- seq(x$X[1], x$X[length(x$X)], length.out = length(dat$time))
+
# Make plot
- if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1]){
+ if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1]) {
lines(year, lm_pred$fit, col = main.pos, lwd = 7)
points(x[, list(X, Value)], pch = 16, cex = point.cex)
- lines( x[, list(X, Value)], lwd = lwd)
-
- if (line.forward == TRUE){
+ lines(x[, list(X, Value)], lwd = lwd)
+
+ if (line.forward == TRUE) {
lines(year, lm_pred$fit, col = main.pos, lwd = 7)
}
- } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]){
+ } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]) {
lines(year, lm_pred$fit, col = main.neg, lwd = 7)
points(x[, list(X, Value)], pch = 16, cex = point.cex)
- lines( x[, list(X, Value)], lwd = lwd)
- if (line.forward == TRUE){
+ lines(x[, list(X, Value)], lwd = lwd)
+ if (line.forward == TRUE) {
lines(year, lm_pred$fit, col = main.neg, lwd = 7)
}
}
}
-
- if (extra == TRUE){
-
+
+ if (extra == TRUE) {
# Second variable
dat <- as.data.frame(x2[, list(X2, Value)])
-
- dat <- dat %>% dplyr::rename(series = Value) %>%
- mutate(time = seq(1,nrow(dat),1))
-
+
+ dat <- dat %>%
+ dplyr::rename(series = Value) %>%
+ mutate(time = seq(1, nrow(dat), 1))
+
# Fit linear model
lm_out <- fit_lm(dat = dat)
p <- lm_out$p
- points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
- if (p < .05){
-
- newtime <- seq(min(dat$time), max(dat$time), length.out=length(dat$time))
- newdata <- data.frame(time = newtime,
- time2 = newtime^2)
- lm_pred <- AICcmodavg::predictSE(lm_out$model,
- newdata = newdata,
- se.fit = TRUE)
-
- year <- seq(x2$X2[1],x2$X2[length(x2$X2)],length.out =length(dat$time))
-
+ points(
+ x2[, list(X2, Value)],
+ pch = 16,
+ cex = point.cex,
+ col = "indianred"
+ )
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ if (p < .05) {
+ newtime <- seq(
+ min(dat$time),
+ max(dat$time),
+ length.out = length(dat$time)
+ )
+ newdata <- data.frame(time = newtime, time2 = newtime^2)
+ lm_pred <- AICcmodavg::predictSE(
+ lm_out$model,
+ newdata = newdata,
+ se.fit = TRUE
+ )
+
+ year <- seq(
+ x2$X2[1],
+ x2$X2[length(x2$X2)],
+ length.out = length(dat$time)
+ )
+
# Make plot
- if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1] ){
+ if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1]) {
lines(year, lm_pred$fit, col = main.pos, lwd = 7)
- points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
- } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]){
+ points(
+ x2[, list(X2, Value)],
+ pch = 16,
+ cex = point.cex,
+ col = "indianred"
+ )
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]) {
lines(year, lm_pred$fit, col = main.neg, lwd = 7)
- points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
- }
+ points(
+ x2[, list(X2, Value)],
+ pch = 16,
+ cex = point.cex,
+ col = "indianred"
+ )
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ }
}
}
-
}
-
-
-
-}
+}
#Add axis labels for stacked plots
-soe.stacked.axis <- function(x.label, y.label, x.line = 2.5,rel.x.text = 1.5,
- y.line = 3.5, rel.y.text = 1.5, outer = TRUE){
+soe.stacked.axis <- function(
+ x.label,
+ y.label,
+ x.line = 2.5,
+ rel.x.text = 1.5,
+ y.line = 3.5,
+ rel.y.text = 1.5,
+ outer = TRUE
+) {
axis(1, cex.axis = rel.x.text)
mtext(1, text = x.label, line = x.line, cex = rel.x.text, outer = outer)
mtext(2, text = y.label, line = y.line, cex = rel.y.text, outer = outer)
-
}
#Background colors
-background <- 'white'
-recent <- '#E6E6E6'
-main.pos <- rgb(253/255, 184/255, 99/255, alpha = .9)
-main.neg <- rgb(178/255, 171/255, 210/255, alpha = .9)
+background <- 'white'
+recent <- '#E6E6E6'
+main.pos <- rgb(253 / 255, 184 / 255, 99 / 255, alpha = .9)
+main.neg <- rgb(178 / 255, 171 / 255, 210 / 255, alpha = .9)
#Finder function for quickly finding variables based on partial match
-finder <- function(data, match = match, factor = T){
- found <- unique(data[grepl(match,data$Var),]$Var)
- if (factor == T){
+finder <- function(data, match = match, factor = T) {
+ found <- unique(data[grepl(match, data$Var), ]$Var)
+ if (factor == T) {
return(found)
} else {
return(as.character(found))
}
-
-}
\ No newline at end of file
+}
diff --git a/R/GIS_source.R b/R/GIS_source.R
index bd4a21ec..14d663e5 100644
--- a/R/GIS_source.R
+++ b/R/GIS_source.R
@@ -10,8 +10,14 @@ library(dplyr)
#Colors for SST anomalies
-colors <- colorRampPalette(c("darkblue",'blue', 'white', 'firebrick1',"firebrick4"))
-color_levels=100
+colors <- colorRampPalette(c(
+ "darkblue",
+ 'blue',
+ 'white',
+ 'firebrick1',
+ "firebrick4"
+))
+color_levels <- 100
#GIS Directory
gis.dir <- here::here("gis")
@@ -20,31 +26,33 @@ gis.dir <- here::here("gis")
data.dir <- here::here("data")
#Projection
-map.crs <- CRS("+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
- +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")
+map.crs <- CRS(
+ "+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
+ +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0"
+)
#Bathymetry
-bathy <- raster(paste0(gis.dir,"/NES_bathymetry.tif"))
-e <- extent(-78.5, -64, 33, 45)
+bathy <- raster(paste0(gis.dir, "/NES_bathymetry.tif"))
+e <- extent(-78.5, -64, 33, 45)
bathy <- crop(bathy, e)
#Coastline
coast <- readOGR(gis.dir, 'NES_LME_coast', verbose = F)
-coast <- spTransform(coast,map.crs)
+coast <- spTransform(coast, map.crs)
#Extent for SST anomaly function
-e <- extent(-77.2, -64.2, 35, 48)
+e <- extent(-77.2, -64.2, 35, 48)
#Extent for thermal habitat
-th_extent <-extent(-77,-65,35,45)
+th_extent <- extent(-77, -65, 35, 45)
#crop bathymetry
-th <- crop(bathy,th_extent)
+th <- crop(bathy, th_extent)
#projections
projection(th) <- map.crs
projection(bathy) <- map.crs
#get strata files to clip thermal habitat projections
-strata <- readOGR(gis.dir,"strata", verbose = F)
-strata@proj4string <- map.crs
\ No newline at end of file
+strata <- readOGR(gis.dir, "strata", verbose = F)
+strata@proj4string <- map.crs
diff --git a/R/clean_env.R b/R/clean_env.R
index 6001c475..a308ef3f 100644
--- a/R/clean_env.R
+++ b/R/clean_env.R
@@ -1,6 +1,6 @@
-clean_env <- function(clean=FALSE) {
- if(clean) {
- file.remove(here::here("tech_doc.Rmd"))
- }
- bookdown::clean_book(clean)
-}
+clean_env <- function(clean = FALSE) {
+ if (clean) {
+ file.remove(here::here("tech_doc.Rmd"))
+ }
+ bookdown::clean_book(clean)
+}
diff --git a/R/find_contributors.R b/R/find_contributors.R
index ed9e6729..424cef63 100644
--- a/R/find_contributors.R
+++ b/R/find_contributors.R
@@ -5,41 +5,41 @@
#' @return Character vector. Unique names of contributors to the current tech doc
#'
-find_contributors <- function(){
+find_contributors <- function() {
# read yml file
yml <- readLines(here::here("_bookdown.yml"))
# find reference to rmd files but not ones commented out
- indRmd <- grepl("\\.[rR]md",yml)
- indHash <- grepl("\\#",yml)
+ indRmd <- grepl("\\.[rR]md", yml)
+ indHash <- grepl("\\#", yml)
ind <- as.logical(indRmd * !indHash)
lines <- yml[ind]
# split by .rmd extension
- fList <- strsplit(lines,"\\.[rR]md")
- fList <- simplify2array(lapply(fList,'[[',1))[-1] # omit first line, (index file)
- nfList <- lapply(fList,strsplit,"chapters/")
- filenames <- head(simplify2array(lapply(simplify2array(nfList),'[[',2)),-1)
+ fList <- strsplit(lines, "\\.[rR]md")
+ fList <- simplify2array(lapply(fList, '[[', 1))[-1] # omit first line, (index file)
+ nfList <- lapply(fList, strsplit, "chapters/")
+ filenames <- head(simplify2array(lapply(simplify2array(nfList), '[[', 2)), -1)
# read in each file and pick out contributors
- options(warn=-1)
- tdContributors <- vector(mode="character")
+ options(warn = -1)
+ tdContributors <- vector(mode = "character")
# loop over each rmd file
for (afile in filenames) {
# read in rmd
- chapterContent <- readLines(here::here("chapters",paste0(afile,".Rmd")))
- # pick out contributor line
- lineContrib <- chapterContent[grepl("Contributor",chapterContent)]
-
- if (length(lineContrib) == 0) next #no contributors for this chapter
+ chapterContent <- readLines(here::here("chapters", paste0(afile, ".Rmd")))
+ # pick out contributor line
+ lineContrib <- chapterContent[grepl("Contributor", chapterContent)]
+
+ if (length(lineContrib) == 0) {
+ next
+ } #no contributors for this chapter
# Now clean up vector of names
- contribs <- strsplit(lineContrib,":")[[1]][2]
- contribs <- strsplit(contribs,",")[[1]]
- contribs <- sub(pattern="\\s+and\\s+",replacement="",contribs) # remove and if present
- contribs <- sub(pattern="\\.",replacement="",contribs) # remove period if present
- contribs <- sub(pattern="^\\s+",replacement="",contribs) # remove whitespace before
- contribs <- sub(pattern="\\s+$",replacement="",contribs) #and after name
- tdContributors <- c(tdContributors,contribs)
-
+ contribs <- strsplit(lineContrib, ":")[[1]][2]
+ contribs <- strsplit(contribs, ",")[[1]]
+ contribs <- sub(pattern = "\\s+and\\s+", replacement = "", contribs) # remove and if present
+ contribs <- sub(pattern = "\\.", replacement = "", contribs) # remove period if present
+ contribs <- sub(pattern = "^\\s+", replacement = "", contribs) # remove whitespace before
+ contribs <- sub(pattern = "\\s+$", replacement = "", contribs) #and after name
+ tdContributors <- c(tdContributors, contribs)
}
return(unique(sort(tdContributors)))
-
}
diff --git a/R/find_text.R b/R/find_text.R
index 2f788f6d..609eaa07 100644
--- a/R/find_text.R
+++ b/R/find_text.R
@@ -7,35 +7,33 @@
#' @return Character vector. Unique names of contributors to the current tech doc
#'
-find_text <- function(textSnippet){
+find_text <- function(textSnippet) {
# read yml file
yml <- readLines(here::here("_bookdown.yml"))
# find reference to rmd files but not ones commented out
- indRmd <- grepl("\\.[rR]md",yml)
- indHash <- grepl("\\#",yml)
+ indRmd <- grepl("\\.[rR]md", yml)
+ indHash <- grepl("\\#", yml)
ind <- as.logical(indRmd * !indHash)
lines <- yml[ind]
# split by .rmd extension
- fList <- strsplit(lines,"\\.[rR]md")
- fList <- simplify2array(lapply(fList,'[[',1))[-1] # omit first line, (index file)
- nfList <- lapply(fList,strsplit,"chapters/")
- filenames <- head(simplify2array(lapply(simplify2array(nfList),'[[',2)),-1)
+ fList <- strsplit(lines, "\\.[rR]md")
+ fList <- simplify2array(lapply(fList, '[[', 1))[-1] # omit first line, (index file)
+ nfList <- lapply(fList, strsplit, "chapters/")
+ filenames <- head(simplify2array(lapply(simplify2array(nfList), '[[', 2)), -1)
- options(warn=-1)
+ options(warn = -1)
# loop over each rmd file
for (afile in filenames) {
# read in rmd
- chapterContent <- readLines(here::here("chapters",paste0(afile,".Rmd")))
- # pick out contributor line
-
- lineContrib <- chapterContent[grepl(textSnippet,chapterContent)]
- if (length(lineContrib) == 0) next
-
+ chapterContent <- readLines(here::here("chapters", paste0(afile, ".Rmd")))
+ # pick out contributor line
+
+ lineContrib <- chapterContent[grepl(textSnippet, chapterContent)]
+ if (length(lineContrib) == 0) {
+ next
+ }
+
print(afile)
#print(lineContrib)
-
-
-
}
-
}
diff --git a/R/get_erddap.R b/R/get_erddap.R
index 6cff57e4..e0b114f5 100644
--- a/R/get_erddap.R
+++ b/R/get_erddap.R
@@ -1,45 +1,42 @@
#get latest data sets from ERDDAP
-get_erddap <- function(df, id = NULL){
-
+get_erddap <- function(df, id = NULL) {
`%>%` <- magrittr::`%>%`
-
+
df$Dataset.ID
-
- if (!is.null(id)){
+
+ if (!is.null(id)) {
df <- df %>% dplyr::filter(stringr::str_detect(Dataset.ID, id))
}
-
-
- versions <- stringr::str_split_fixed(df$Dataset.ID, "(?=\\d+)",2)
- versions <- data.frame(Dataset.ID = versions[,1],
- v = as.numeric(versions[,2]))
-
+
+ versions <- stringr::str_split_fixed(df$Dataset.ID, "(?=\\d+)", 2)
+ versions <- data.frame(
+ Dataset.ID = versions[, 1],
+ v = as.numeric(versions[, 2])
+ )
+
newest <- versions %>%
dplyr::group_by(Dataset.ID) %>%
- dplyr::filter(v == max(v)) %>%
- tidyr::unite(., Dataset.ID, c("Dataset.ID","v"), sep = "") %>%
- dplyr::inner_join(df,.)
-
- if (is.null(id)){
-
+ dplyr::filter(v == max(v)) %>%
+ tidyr::unite(., Dataset.ID, c("Dataset.ID", "v"), sep = "") %>%
+ dplyr::inner_join(df, .)
+
+ if (is.null(id)) {
return(newest)
-
} else {
-
- single_out <- sprintf("http://comet.nefsc.noaa.gov/erddap/tabledap/%s.csv",
- newest$Dataset.ID) %>%
+ single_out <- sprintf(
+ "http://comet.nefsc.noaa.gov/erddap/tabledap/%s.csv",
+ newest$Dataset.ID
+ ) %>%
purrr::map(function(x) {
readr::read_csv(url(x))
- })
-
+ })
+
single_out <- single_out[[1]]
- if (all(is.na(single_out[1,]))){
+ if (all(is.na(single_out[1, ]))) {
single_out <- dplyr::slice(single_out, -1)
}
return(single_out)
}
-
-
}
diff --git a/R/stored_scripts/CalanusStage_SOE.R b/R/stored_scripts/CalanusStage_SOE.R
index 2c0c53fa..818c0677 100644
--- a/R/stored_scripts/CalanusStage_SOE.R
+++ b/R/stored_scripts/CalanusStage_SOE.R
@@ -14,180 +14,358 @@ library(mapdata)
library(raster)
## function to standardize highly skewed data - log normalize data and compute mean, return exponent
-log_mean1 = function(x, na.rm=TRUE){
- x2=log10(x+1)
- x3=mean(x2, na.rm=na.rm)
- x4=10^x3
+log_mean1 <- function(x, na.rm = TRUE) {
+ x2 <- log10(x + 1)
+ x3 <- mean(x2, na.rm = na.rm)
+ x4 <- 10^x3
return(x4)
}
### load data file, format date
### Stage codes in MARMAP/EcoMon:
-# 020 COPEPODITE I
-# 021 COPEPODITE II
-# 022 COPEPODITE III
-# 023 COPEPODITE IV
-# 024 COPEPODITE V
-# 000 ADULT
-# 999 UNKNOWN
-ZPD=read.csv('/home/ryan/Desktop/Z/SOE_2021_PlanktonData/Ryan_Morse_2021_01_14.csv', stringsAsFactors = F) # 2021 from Harvey
-ZPD$date=as.Date(ZPD$FORMATED_EVENT_DATE, format="%m/%d/%y %R")
-ZPD$year=year(ZPD$date)
-ZPD$month=month(ZPD$date)
-ZPD$DOY=yday(ZPD$date)
+# 020 COPEPODITE I
+# 021 COPEPODITE II
+# 022 COPEPODITE III
+# 023 COPEPODITE IV
+# 024 COPEPODITE V
+# 000 ADULT
+# 999 UNKNOWN
+ZPD <- read.csv(
+ '/home/ryan/Desktop/Z/SOE_2021_PlanktonData/Ryan_Morse_2021_01_14.csv',
+ stringsAsFactors = F
+) # 2021 from Harvey
+ZPD$date <- as.Date(ZPD$FORMATED_EVENT_DATE, format = "%m/%d/%y %R")
+ZPD$year <- year(ZPD$date)
+ZPD$month <- month(ZPD$date)
+ZPD$DOY <- yday(ZPD$date)
## bin bimonthly date for EcoMon cruises
-cruises=unique(ZPD$CRUISE_NAME)
-ZPD$medmonth=NA
-for (i in 1:length(cruises)){
- ZPD$medmonth[ZPD$CRUISE_NAME == cruises[i]]=median(ZPD$DOY[ZPD$CRUISE_NAME == cruises[i]])
+cruises <- unique(ZPD$CRUISE_NAME)
+ZPD$medmonth <- NA
+for (i in 1:length(cruises)) {
+ ZPD$medmonth[ZPD$CRUISE_NAME == cruises[i]] <- median(ZPD$DOY[
+ ZPD$CRUISE_NAME == cruises[i]
+ ])
}
-ZPD$bmm=NA
-ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(0,59))]=1
-ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(60,120))]=3
-ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(121,181))]=5
-ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(182,243))]=7
-ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(244,304))]=9
-ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(305,366))]=11
+ZPD$bmm <- NA
+ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(0, 59))] <- 1
+ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(60, 120))] <- 3
+ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(121, 181))] <- 5
+ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(182, 243))] <- 7
+ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(244, 304))] <- 9
+ZPD$bmm[which(as.integer(ZPD$medmonth) %in% seq(305, 366))] <- 11
### Assign locations to EPUs
# EPU=ecodata::epu_sf # not sure how to make this work with my methods using spatialpolygonsdataframe
-gbk=rgdal::readOGR("EPU_GBKPoly.shp")
-gom=rgdal::readOGR("EPU_GOMPoly.shp")
-mab=rgdal::readOGR("EPU_MABPoly.shp")
-scs=rgdal::readOGR("EPU_SCSPoly.shp")
+gbk <- rgdal::readOGR("EPU_GBKPoly.shp")
+gom <- rgdal::readOGR("EPU_GOMPoly.shp")
+mab <- rgdal::readOGR("EPU_MABPoly.shp")
+scs <- rgdal::readOGR("EPU_SCSPoly.shp")
#extract just lat/lons for lines
-gbk.lonlat =as.data.frame(lapply(slot(gbk, "polygons"), function(x) lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))))
-gom.lonlat =as.data.frame(lapply(slot(gom, "polygons"), function(x) lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))))
-mab.lonlat =as.data.frame(lapply(slot(mab, "polygons"), function(x) lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))))
-scs.lonlat =as.data.frame(lapply(slot(scs, "polygons"), function(x) lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))))
+gbk.lonlat <- as.data.frame(lapply(slot(gbk, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+}))
+gom.lonlat <- as.data.frame(lapply(slot(gom, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+}))
+mab.lonlat <- as.data.frame(lapply(slot(mab, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+}))
+scs.lonlat <- as.data.frame(lapply(slot(scs, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+}))
# create matrix to use in in.out function from package 'mgcv'
-gom.mat=as.matrix(gom.lonlat)
-gbk.mat=as.matrix(gbk.lonlat)
-mab.mat=as.matrix(mab.lonlat)
-scs.mat=as.matrix(scs.lonlat)
-m4=as.matrix(ZPD[,c('LONGITUDE','LATITUDE')]) #lon,lat from ZPD
-ZPD$epu=NA
-ZPD$epu[which(in.out(gbk.mat, m4))]='GB'
-ZPD$epu[which(in.out(gom.mat, m4))]='GOM'
-ZPD$epu[which(in.out(scs.mat, m4))]='SS'
-ZPD$epu[which(in.out(mab.mat, m4))]='MAB'
-test=ZPD[is.na(ZPD$epu),] #unassigned
+gom.mat <- as.matrix(gom.lonlat)
+gbk.mat <- as.matrix(gbk.lonlat)
+mab.mat <- as.matrix(mab.lonlat)
+scs.mat <- as.matrix(scs.lonlat)
+m4 <- as.matrix(ZPD[, c('LONGITUDE', 'LATITUDE')]) #lon,lat from ZPD
+ZPD$epu <- NA
+ZPD$epu[which(in.out(gbk.mat, m4))] <- 'GB'
+ZPD$epu[which(in.out(gom.mat, m4))] <- 'GOM'
+ZPD$epu[which(in.out(scs.mat, m4))] <- 'SS'
+ZPD$epu[which(in.out(mab.mat, m4))] <- 'MAB'
+test <- ZPD[is.na(ZPD$epu), ] #unassigned
# sum all counts across stage categories, necessary for calculations below
-ZPD$zooplankton_count=apply(ZPD[,c(12:18)], 1, sum)
+ZPD$zooplankton_count <- apply(ZPD[, c(12:18)], 1, sum)
## convert from counts to units of # per 100m^-3 following MARMAP protocol
-ZPD$c1_100m3=(ZPD$ZOO_STAGE_020+(ZPD$zooplankton_count/(ZPD$zooplankton_count-ZPD$ZOO_STAGE_999)*ZPD$ZOO_STAGE_999))*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
-ZPD$c2_100m3=(ZPD$ZOO_STAGE_021+(ZPD$zooplankton_count/(ZPD$zooplankton_count-ZPD$ZOO_STAGE_999)*ZPD$ZOO_STAGE_999))*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
-ZPD$c3_100m3=(ZPD$ZOO_STAGE_022+(ZPD$zooplankton_count/(ZPD$zooplankton_count-ZPD$ZOO_STAGE_999)*ZPD$ZOO_STAGE_999))*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
-ZPD$c4_100m3=(ZPD$ZOO_STAGE_023+(ZPD$zooplankton_count/(ZPD$zooplankton_count-ZPD$ZOO_STAGE_999)*ZPD$ZOO_STAGE_999))*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
-ZPD$c5_100m3=(ZPD$ZOO_STAGE_024+(ZPD$zooplankton_count/(ZPD$zooplankton_count-ZPD$ZOO_STAGE_999)*ZPD$ZOO_STAGE_999))*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
-ZPD$adult_100m3=(ZPD$ZOO_STAGE_000+(ZPD$zooplankton_count/(ZPD$zooplankton_count-ZPD$ZOO_STAGE_999)*ZPD$ZOO_STAGE_999))*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
-ZPD$unstaged_100m3=(ZPD$ZOO_STAGE_999+(ZPD$zooplankton_count/(ZPD$zooplankton_count-ZPD$ZOO_STAGE_999)*ZPD$ZOO_STAGE_999))*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
-ZPD$total_100m3=ZPD$zooplankton_count*ZPD$ZOO_ALIQUOT*(100/ZPD$GEAR_VOLUME_FILTERED)
+ZPD$c1_100m3 <- (ZPD$ZOO_STAGE_020 +
+ (ZPD$zooplankton_count /
+ (ZPD$zooplankton_count - ZPD$ZOO_STAGE_999) *
+ ZPD$ZOO_STAGE_999)) *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
+ZPD$c2_100m3 <- (ZPD$ZOO_STAGE_021 +
+ (ZPD$zooplankton_count /
+ (ZPD$zooplankton_count - ZPD$ZOO_STAGE_999) *
+ ZPD$ZOO_STAGE_999)) *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
+ZPD$c3_100m3 <- (ZPD$ZOO_STAGE_022 +
+ (ZPD$zooplankton_count /
+ (ZPD$zooplankton_count - ZPD$ZOO_STAGE_999) *
+ ZPD$ZOO_STAGE_999)) *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
+ZPD$c4_100m3 <- (ZPD$ZOO_STAGE_023 +
+ (ZPD$zooplankton_count /
+ (ZPD$zooplankton_count - ZPD$ZOO_STAGE_999) *
+ ZPD$ZOO_STAGE_999)) *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
+ZPD$c5_100m3 <- (ZPD$ZOO_STAGE_024 +
+ (ZPD$zooplankton_count /
+ (ZPD$zooplankton_count - ZPD$ZOO_STAGE_999) *
+ ZPD$ZOO_STAGE_999)) *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
+ZPD$adult_100m3 <- (ZPD$ZOO_STAGE_000 +
+ (ZPD$zooplankton_count /
+ (ZPD$zooplankton_count - ZPD$ZOO_STAGE_999) *
+ ZPD$ZOO_STAGE_999)) *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
+ZPD$unstaged_100m3 <- (ZPD$ZOO_STAGE_999 +
+ (ZPD$zooplankton_count /
+ (ZPD$zooplankton_count - ZPD$ZOO_STAGE_999) *
+ ZPD$ZOO_STAGE_999)) *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
+ZPD$total_100m3 <- ZPD$zooplankton_count *
+ ZPD$ZOO_ALIQUOT *
+ (100 / ZPD$GEAR_VOLUME_FILTERED)
## deal with instances of bad values
-ZPD$c1_100m3[ZPD$c1_100m3==Inf]=NA
-ZPD$c2_100m3[ZPD$c2_100m3==Inf]=NA
-ZPD$c3_100m3[ZPD$c3_100m3==Inf]=NA
-ZPD$c4_100m3[ZPD$c4_100m3==Inf]=NA
-ZPD$c5_100m3[ZPD$c5_100m3==Inf]=NA
-ZPD$adult_100m3[ZPD$adult_100m3==Inf]=NA
+ZPD$c1_100m3[ZPD$c1_100m3 == Inf] <- NA
+ZPD$c2_100m3[ZPD$c2_100m3 == Inf] <- NA
+ZPD$c3_100m3[ZPD$c3_100m3 == Inf] <- NA
+ZPD$c4_100m3[ZPD$c4_100m3 == Inf] <- NA
+ZPD$c5_100m3[ZPD$c5_100m3 == Inf] <- NA
+ZPD$adult_100m3[ZPD$adult_100m3 == Inf] <- NA
## subset to just Calanus finmarchicus
-Cfin=ZPD[ZPD$TAXA_004==101,]
+Cfin <- ZPD[ZPD$TAXA_004 == 101, ]
### Aggregate samples to EPU, season, year
## Early spring months (bimonth means in 1 or 3)
-biseas=Cfin[which((Cfin$bmm==1) | (Cfin$bmm==3)),]; SEASON='Spring'
-s.yr.c3=aggregate(biseas$c3_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.c4=aggregate(biseas$c4_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.c5=aggregate(biseas$c5_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.adt=aggregate(biseas$adult_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.tot=aggregate(biseas$total_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-Calfin=s.yr.c3
-Calfin=left_join(Calfin, s.yr.c4, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.c5, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.adt, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.tot, by=c("Group.1", "Group.2"))
-meanday=aggregate(biseas$DOY, by=list(biseas$year, biseas$epu), FUN=mean, na.rm=T)
-nday=aggregate(biseas$DOY, by=list(biseas$year, biseas$epu), FUN=length)
-Calfin=left_join(Calfin, meanday, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, nday, by=c("Group.1", "Group.2"))
-colnames(Calfin)=c('Year', 'epu', 'c3', 'c4', 'c5', 'adt', 'tot', 'meanday', 'ndays')
-Calfin$season=SEASON
-Calfin$C3pct=Calfin$c3/Calfin$tot
-Calfin$C4pct=Calfin$c4/Calfin$tot
-Calfin$C5pct=Calfin$c5/Calfin$tot
-Calfin$Adtpct=Calfin$adt/Calfin$tot
-Cfspr=Calfin
+biseas <- Cfin[which((Cfin$bmm == 1) | (Cfin$bmm == 3)), ]
+SEASON <- 'Spring'
+s.yr.c3 <- aggregate(
+ biseas$c3_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.c4 <- aggregate(
+ biseas$c4_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.c5 <- aggregate(
+ biseas$c5_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.adt <- aggregate(
+ biseas$adult_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.tot <- aggregate(
+ biseas$total_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+Calfin <- s.yr.c3
+Calfin <- left_join(Calfin, s.yr.c4, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.c5, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.adt, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.tot, by = c("Group.1", "Group.2"))
+meanday <- aggregate(
+ biseas$DOY,
+ by = list(biseas$year, biseas$epu),
+ FUN = mean,
+ na.rm = T
+)
+nday <- aggregate(biseas$DOY, by = list(biseas$year, biseas$epu), FUN = length)
+Calfin <- left_join(Calfin, meanday, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, nday, by = c("Group.1", "Group.2"))
+colnames(Calfin) <- c(
+ 'Year',
+ 'epu',
+ 'c3',
+ 'c4',
+ 'c5',
+ 'adt',
+ 'tot',
+ 'meanday',
+ 'ndays'
+)
+Calfin$season <- SEASON
+Calfin$C3pct <- Calfin$c3 / Calfin$tot
+Calfin$C4pct <- Calfin$c4 / Calfin$tot
+Calfin$C5pct <- Calfin$c5 / Calfin$tot
+Calfin$Adtpct <- Calfin$adt / Calfin$tot
+Cfspr <- Calfin
## Summer months (bimonth means in 5 or 7)
-biseas=Cfin[which((Cfin$bmm==5) | (Cfin$bmm==7)),]; SEASON='Summer'
-s.yr.c3=aggregate(biseas$c3_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.c4=aggregate(biseas$c4_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.c5=aggregate(biseas$c5_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.adt=aggregate(biseas$adult_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.tot=aggregate(biseas$total_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-Calfin=s.yr.c3
-Calfin=left_join(Calfin, s.yr.c4, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.c5, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.adt, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.tot, by=c("Group.1", "Group.2"))
-meanday=aggregate(biseas$DOY, by=list(biseas$year, biseas$epu), FUN=mean, na.rm=T)
-nday=aggregate(biseas$DOY, by=list(biseas$year, biseas$epu), FUN=length)
-Calfin=left_join(Calfin, meanday, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, nday, by=c("Group.1", "Group.2"))
-colnames(Calfin)=c('Year', 'epu', 'c3', 'c4', 'c5', 'adt', 'tot', 'meanday', 'ndays')
-Calfin$season=SEASON
-Calfin$C3pct=Calfin$c3/Calfin$tot
-Calfin$C4pct=Calfin$c4/Calfin$tot
-Calfin$C5pct=Calfin$c5/Calfin$tot
-Calfin$Adtpct=Calfin$adt/Calfin$tot
-Cfsum=Calfin
+biseas <- Cfin[which((Cfin$bmm == 5) | (Cfin$bmm == 7)), ]
+SEASON <- 'Summer'
+s.yr.c3 <- aggregate(
+ biseas$c3_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.c4 <- aggregate(
+ biseas$c4_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.c5 <- aggregate(
+ biseas$c5_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.adt <- aggregate(
+ biseas$adult_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.tot <- aggregate(
+ biseas$total_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+Calfin <- s.yr.c3
+Calfin <- left_join(Calfin, s.yr.c4, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.c5, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.adt, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.tot, by = c("Group.1", "Group.2"))
+meanday <- aggregate(
+ biseas$DOY,
+ by = list(biseas$year, biseas$epu),
+ FUN = mean,
+ na.rm = T
+)
+nday <- aggregate(biseas$DOY, by = list(biseas$year, biseas$epu), FUN = length)
+Calfin <- left_join(Calfin, meanday, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, nday, by = c("Group.1", "Group.2"))
+colnames(Calfin) <- c(
+ 'Year',
+ 'epu',
+ 'c3',
+ 'c4',
+ 'c5',
+ 'adt',
+ 'tot',
+ 'meanday',
+ 'ndays'
+)
+Calfin$season <- SEASON
+Calfin$C3pct <- Calfin$c3 / Calfin$tot
+Calfin$C4pct <- Calfin$c4 / Calfin$tot
+Calfin$C5pct <- Calfin$c5 / Calfin$tot
+Calfin$Adtpct <- Calfin$adt / Calfin$tot
+Cfsum <- Calfin
## Fall months (bimonth means in 9 or 11)
-biseas=Cfin[which((Cfin$bmm==9) | (Cfin$bmm==11)),]; SEASON='Fall'
-s.yr.c3=aggregate(biseas$c3_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.c4=aggregate(biseas$c4_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.c5=aggregate(biseas$c5_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.adt=aggregate(biseas$adult_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-s.yr.tot=aggregate(biseas$total_100m3, by=list(biseas$year, biseas$epu), FUN=log_mean1, na.rm=T)
-Calfin=s.yr.c3
-Calfin=left_join(Calfin, s.yr.c4, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.c5, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.adt, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, s.yr.tot, by=c("Group.1", "Group.2"))
-meanday=aggregate(biseas$DOY, by=list(biseas$year, biseas$epu), FUN=mean, na.rm=T)
-nday=aggregate(biseas$DOY, by=list(biseas$year, biseas$epu), FUN=length)
-Calfin=left_join(Calfin, meanday, by=c("Group.1", "Group.2"))
-Calfin=left_join(Calfin, nday, by=c("Group.1", "Group.2"))
-colnames(Calfin)=c('Year', 'epu', 'c3', 'c4', 'c5', 'adt', 'tot', 'meanday', 'ndays')
-Calfin$season=SEASON
-Calfin$C3pct=Calfin$c3/Calfin$tot
-Calfin$C4pct=Calfin$c4/Calfin$tot
-Calfin$C5pct=Calfin$c5/Calfin$tot
-Calfin$Adtpct=Calfin$adt/Calfin$tot
-Cffal=Calfin
+biseas <- Cfin[which((Cfin$bmm == 9) | (Cfin$bmm == 11)), ]
+SEASON <- 'Fall'
+s.yr.c3 <- aggregate(
+ biseas$c3_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.c4 <- aggregate(
+ biseas$c4_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.c5 <- aggregate(
+ biseas$c5_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.adt <- aggregate(
+ biseas$adult_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+s.yr.tot <- aggregate(
+ biseas$total_100m3,
+ by = list(biseas$year, biseas$epu),
+ FUN = log_mean1,
+ na.rm = T
+)
+Calfin <- s.yr.c3
+Calfin <- left_join(Calfin, s.yr.c4, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.c5, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.adt, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, s.yr.tot, by = c("Group.1", "Group.2"))
+meanday <- aggregate(
+ biseas$DOY,
+ by = list(biseas$year, biseas$epu),
+ FUN = mean,
+ na.rm = T
+)
+nday <- aggregate(biseas$DOY, by = list(biseas$year, biseas$epu), FUN = length)
+Calfin <- left_join(Calfin, meanday, by = c("Group.1", "Group.2"))
+Calfin <- left_join(Calfin, nday, by = c("Group.1", "Group.2"))
+colnames(Calfin) <- c(
+ 'Year',
+ 'epu',
+ 'c3',
+ 'c4',
+ 'c5',
+ 'adt',
+ 'tot',
+ 'meanday',
+ 'ndays'
+)
+Calfin$season <- SEASON
+Calfin$C3pct <- Calfin$c3 / Calfin$tot
+Calfin$C4pct <- Calfin$c4 / Calfin$tot
+Calfin$C5pct <- Calfin$c5 / Calfin$tot
+Calfin$Adtpct <- Calfin$adt / Calfin$tot
+Cffal <- Calfin
# Format data wide to long and save data for SOE report 2021
-t1=rbind(Cfspr, Cfsum)
-wide=rbind(t1, Cffal)
-long=melt(wide, id.vars = 1:2, variable.name = "year")
-long=wide %>%
- tidyr::pivot_longer(cols = c(c3, c4, c5, adt, C3pct, C4pct, C5pct, Adtpct),
- names_to = "Var", values_to = "Value") %>% dplyr::mutate(Units=c("No. per 100m^-3"))
-long$Units[which(long$Var== "C3pct")]=c("percent abundance")
-long$Units[which(long$Var== "C4pct")]=c("percent abundance")
-long$Units[which(long$Var== "C5pct")]=c("percent abundance")
-long$Units[which(long$Var== "Adtpct")]=c("percent abundance")
-CalanusStage=long
+t1 <- rbind(Cfspr, Cfsum)
+wide <- rbind(t1, Cffal)
+long <- melt(wide, id.vars = 1:2, variable.name = "year")
+long <- wide %>%
+ tidyr::pivot_longer(
+ cols = c(c3, c4, c5, adt, C3pct, C4pct, C5pct, Adtpct),
+ names_to = "Var",
+ values_to = "Value"
+ ) %>%
+ dplyr::mutate(Units = c("No. per 100m^-3"))
+long$Units[which(long$Var == "C3pct")] <- c("percent abundance")
+long$Units[which(long$Var == "C4pct")] <- c("percent abundance")
+long$Units[which(long$Var == "C5pct")] <- c("percent abundance")
+long$Units[which(long$Var == "Adtpct")] <- c("percent abundance")
+CalanusStage <- long
## Subset to just adults and c5 copepodites; substitute NA when less than 10 days are available for a crusie (poor sample coverage for year-season)
# add scaled biomass based on day of year (experimental - not for use until validated)
-CS2=CalanusStage %>% filter(Var==c('c5', 'adt')) %>%
- mutate(newval=ifelse(ndays<10, NA, Value)) %>%
- mutate(newday= (meanday/ 365)) %>%
- mutate(scaledval=newval*newday)
+CS2 <- CalanusStage %>%
+ filter(Var == c('c5', 'adt')) %>%
+ mutate(newval = ifelse(ndays < 10, NA, Value)) %>%
+ mutate(newday = (meanday / 365)) %>%
+ mutate(scaledval = newval * newday)
-CalanusStage2=CS2 %>% select(Year, epu, season, Var, newval, Units)
-colnames(CalanusStage2)[5]='Value'
-save(CalanusStage2, file='/home/ryan/Desktop/Z/RM_20210205_CalanusStage.Rda')
\ No newline at end of file
+CalanusStage2 <- CS2 %>% select(Year, epu, season, Var, newval, Units)
+colnames(CalanusStage2)[5] <- 'Value'
+save(CalanusStage2, file = '/home/ryan/Desktop/Z/RM_20210205_CalanusStage.Rda')
diff --git a/R/stored_scripts/Gruenburg_Hudson_River_Flow.R b/R/stored_scripts/Gruenburg_Hudson_River_Flow.R
index 8eb1d1e6..6efa7b6a 100644
--- a/R/stored_scripts/Gruenburg_Hudson_River_Flow.R
+++ b/R/stored_scripts/Gruenburg_Hudson_River_Flow.R
@@ -3,7 +3,6 @@
#Fit GAM and use year effect as indicator
#Created by Laura Gruenburg - Last edited DEC 01, 2021
-
#####load required functions
# You will need to download the Deriv functions from here https://gist.github.com/gavinsimpson/e73f011fdaaab4bb5a30
@@ -15,46 +14,91 @@ library(ggplot2)
#######Load the datasets
setwd("~/Desktop/NYB Indicators/Final_timeseries")
-meanflow<-read.csv("Gruenburg_Riverflow2021.csv", header = TRUE)
+meanflow <- read.csv("Gruenburg_Riverflow2021.csv", header = TRUE)
# Hudson river mean flow data where one column is year and the other is flowrate in m3s-1
# Creat a GAM - adjust k and remember to check model
-mod<- gam(flowrate ~ s(year, k=15), data = meanflow)
+mod <- gam(flowrate ~ s(year, k = 15), data = meanflow)
summary(mod) #check out model
gam.check(mod)
pdata <- with(meanflow, data.frame(year = year))
-p2_mod <- predict(mod, newdata = pdata, type = "terms", se.fit = TRUE)
-intercept = 411.6686 # look at p2_mod and extract the intercept
-pdata <- transform(pdata, p2_mod = p2_mod$fit[,1], se2 = p2_mod$se.fit[,1])
+p2_mod <- predict(mod, newdata = pdata, type = "terms", se.fit = TRUE)
+intercept <- 411.6686 # look at p2_mod and extract the intercept
+pdata <- transform(pdata, p2_mod = p2_mod$fit[, 1], se2 = p2_mod$se.fit[, 1])
# Now that we have the model prediction, the next step is to calculate the first derivative
# Then determine which increases and decreases are significant
-Term = "year"
-mod.d <- Deriv(mod, n=70) # n is the number of years
+Term <- "year"
+mod.d <- Deriv(mod, n = 70) # n is the number of years
mod.dci <- confint(mod.d, term = Term)
-mod.dsig <- signifD(pdata$p2_mod, d = mod.d[[Term]]$deriv,
- + mod.dci[[Term]]$upper, mod.dci[[Term]]$lower)
+mod.dsig <- signifD(
+ pdata$p2_mod,
+ d = mod.d[[Term]]$deriv,
+ +mod.dci[[Term]]$upper,
+ mod.dci[[Term]]$lower
+)
# Take a quick look to make sure it appears ok before final plotting
plot(flowrate ~ year, data = meanflow)
lines(flowrate ~ year, data = meanflow)
-lines(p2_mod+intercept ~ year, data = pdata, type = "n")
-lines(p2_mod+intercept ~ year, data = pdata)
-lines(unlist(mod.dsig$incr)+intercept ~ year, data = pdata, col = "blue", lwd = 3)
-lines(unlist(mod.dsig$decr)+intercept ~ year, data = pdata, col = "red", lwd = 3)
+lines(p2_mod + intercept ~ year, data = pdata, type = "n")
+lines(p2_mod + intercept ~ year, data = pdata)
+lines(
+ unlist(mod.dsig$incr) + intercept ~ year,
+ data = pdata,
+ col = "blue",
+ lwd = 3
+)
+lines(
+ unlist(mod.dsig$decr) + intercept ~ year,
+ data = pdata,
+ col = "red",
+ lwd = 3
+)
-linearMod<- lm(flowrate ~ year, data=meanflow)
+linearMod <- lm(flowrate ~ year, data = meanflow)
summary(linearMod)
-mf = meanflow
-ggplot() +
+mf <- meanflow
+ggplot() +
geom_line(data = meanflow, aes(x = year, y = flowrate), color = 'grey53') +
- geom_point(data = meanflow, aes(x = year, y = flowrate), color = 'gray53') +
- geom_smooth(data = meanflow, aes(x = year, y = flowrate), method = lm, se = FALSE, color = 'black') +
- geom_line(data=pdata, aes(x = year, y = p2_mod+intercept), se = FALSE, color = 'black', linetype = 'twodash', size = 1) +
- geom_line(data = pdata, aes(y = unlist(mod.dsig$incr)+intercept, x = year), color = "blue", size = 1) +
- geom_line(data = pdata, aes(y = unlist(mod.dsig$decr)+intercept, x = year), color = 'red', size = 1) +
+ geom_point(data = meanflow, aes(x = year, y = flowrate), color = 'gray53') +
+ geom_smooth(
+ data = meanflow,
+ aes(x = year, y = flowrate),
+ method = lm,
+ se = FALSE,
+ color = 'black'
+ ) +
+ geom_line(
+ data = pdata,
+ aes(x = year, y = p2_mod + intercept),
+ se = FALSE,
+ color = 'black',
+ linetype = 'twodash',
+ size = 1
+ ) +
+ geom_line(
+ data = pdata,
+ aes(y = unlist(mod.dsig$incr) + intercept, x = year),
+ color = "blue",
+ size = 1
+ ) +
+ geom_line(
+ data = pdata,
+ aes(y = unlist(mod.dsig$decr) + intercept, x = year),
+ color = 'red',
+ size = 1
+ ) +
theme_bw() +
- labs (y = bquote("Mean Flow "~m^3~"/s"), x = 'Year', title = 'Hudson Mean Flow at Green Island') +
- theme(plot.title=element_text(size = 16,face = 'bold',hjust = 0.5), axis.title=element_text(size = 14, face = 'bold'), axis.text= element_text(color = 'black', size = 12))
+ labs(
+ y = bquote("Mean Flow " ~ m^3 ~ "/s"),
+ x = 'Year',
+ title = 'Hudson Mean Flow at Green Island'
+ ) +
+ theme(
+ plot.title = element_text(size = 16, face = 'bold', hjust = 0.5),
+ axis.title = element_text(size = 14, face = 'bold'),
+ axis.text = element_text(color = 'black', size = 12)
+ )
diff --git a/R/stored_scripts/SOE-VASTForageIndices.R b/R/stored_scripts/SOE-VASTForageIndices.R
index 4cb35039..c9f0fa0f 100644
--- a/R/stored_scripts/SOE-VASTForageIndices.R
+++ b/R/stored_scripts/SOE-VASTForageIndices.R
@@ -1,90 +1,101 @@
# create csv for ecodata input
# aim for similar structure to other ecodata datasets
-
library(dplyr)
library(ggplot2)
library(tidyr)
SOEinputs <- function(infile, season, outfile) {
-
splitoutput <- read.csv(infile)
-
+
# warning, hardcoded. obviously
- stratlook <- data.frame(Stratum = c("Stratum_1",
- "Stratum_2",
- "Stratum_3",
- "Stratum_4",
- "Stratum_5",
- "Stratum_6",
- "Stratum_7",
- "Stratum_8",
- "Stratum_9",
- "Stratum_10",
- "Stratum_11",
- "Stratum_12",
- "Stratum_13",
- "Stratum_14",
- "Stratum_15"),
- Region = c("AllEPU",
- "MABGB",
- "MABGBstate",
- "MABGBfed",
- "MAB",
- "GB",
- "GOM",
- "bfall",
- "bfin",
- "bfoff",
- "MABGBalbinshore",
- "MABGBothoffshore",
- "albbfin",
- "albbfall",
- "allother"))
-
+ stratlook <- data.frame(
+ Stratum = c(
+ "Stratum_1",
+ "Stratum_2",
+ "Stratum_3",
+ "Stratum_4",
+ "Stratum_5",
+ "Stratum_6",
+ "Stratum_7",
+ "Stratum_8",
+ "Stratum_9",
+ "Stratum_10",
+ "Stratum_11",
+ "Stratum_12",
+ "Stratum_13",
+ "Stratum_14",
+ "Stratum_15"
+ ),
+ Region = c(
+ "AllEPU",
+ "MABGB",
+ "MABGBstate",
+ "MABGBfed",
+ "MAB",
+ "GB",
+ "GOM",
+ "bfall",
+ "bfin",
+ "bfoff",
+ "MABGBalbinshore",
+ "MABGBothoffshore",
+ "albbfin",
+ "albbfall",
+ "allother"
+ )
+ )
+
forageindex <- splitoutput %>%
left_join(stratlook) %>%
- dplyr::select(Time,
- EPU = Region,
- "Forage Fish Biomass Estimate" = Estimate,
- "Forage Fish Biomass Estimate SE" = Std..Error.for.Estimate) %>%
- tidyr::pivot_longer(c("Forage Fish Biomass Estimate", "Forage Fish Biomass Estimate SE"),
- names_to = "Var", values_to = "Value") %>%
+ dplyr::select(
+ Time,
+ EPU = Region,
+ "Forage Fish Biomass Estimate" = Estimate,
+ "Forage Fish Biomass Estimate SE" = Std..Error.for.Estimate
+ ) %>%
+ tidyr::pivot_longer(
+ c("Forage Fish Biomass Estimate", "Forage Fish Biomass Estimate SE"),
+ names_to = "Var",
+ values_to = "Value"
+ ) %>%
dplyr::filter(EPU %in% c("MAB", "GB", "GOM", "AllEPU")) %>%
dplyr::mutate(Units = "grams per stomach") %>%
dplyr::select(Time, Var, Value, EPU, Units)
-
+
forageindex$Var <- stringr::str_c(season, forageindex$Var, sep = " ")
-
+
#readr::write_csv(forageindex, outfile)
saveRDS(forageindex, outfile)
-
-}
+}
# make data files
-SOEinputs(infile = "pyindex/allagg_fall_500_lennosst_ALLsplit_biascorrect/Index.csv",
- season = "Fall",
- outfile = "toSOE/fallforageindex.rds")
-
-SOEinputs(infile = "pyindex/allagg_spring_500_lennosst_ALLsplit_biascorrect/Index.csv",
- season = "Spring",
- outfile = "toSOE/springforageindex.rds")
-
-SOEinputs(infile = "pyindex/allagg_annual_500_lennosst_ALLsplit_biascorrect/Index.csv",
- season = "Annual",
- outfile = "toSOE/annualforageindex.rds")
+SOEinputs(
+ infile = "pyindex/allagg_fall_500_lennosst_ALLsplit_biascorrect/Index.csv",
+ season = "Fall",
+ outfile = "toSOE/fallforageindex.rds"
+)
+SOEinputs(
+ infile = "pyindex/allagg_spring_500_lennosst_ALLsplit_biascorrect/Index.csv",
+ season = "Spring",
+ outfile = "toSOE/springforageindex.rds"
+)
+SOEinputs(
+ infile = "pyindex/allagg_annual_500_lennosst_ALLsplit_biascorrect/Index.csv",
+ season = "Annual",
+ outfile = "toSOE/annualforageindex.rds"
+)
# test plot
# foragewide <- forageindex %>%
# pivot_wider(names_from = Var, values_from = Value)
-#
-#
+#
+#
# ggplot(foragewide, aes(x=Time, y=`Forage Fish Biomass Estimate`, colour = EPU)) +
-# geom_errorbar(aes(ymin=`Forage Fish Biomass Estimate`+`Forage Fish Biomass Estimate SE`,
+# geom_errorbar(aes(ymin=`Forage Fish Biomass Estimate`+`Forage Fish Biomass Estimate SE`,
# ymax=`Forage Fish Biomass Estimate`-`Forage Fish Biomass Estimate SE`))+
# geom_point()+
# geom_line()
-
diff --git a/R/stored_scripts/WindRevenue_Code_for_Dissemination.R b/R/stored_scripts/WindRevenue_Code_for_Dissemination.R
index 26d884e7..98cabaf6 100644
--- a/R/stored_scripts/WindRevenue_Code_for_Dissemination.R
+++ b/R/stored_scripts/WindRevenue_Code_for_Dissemination.R
@@ -7,24 +7,66 @@ require(dplyr)
require(stringr)
setwd("Folder with confidential data sources")
-file_list<- list.files("Folder with confidential data sources")
+file_list <- list.files("Folder with confidential data sources")
-number_of_top_species = 5 #Setting number of species to display
+number_of_top_species <- 5 #Setting number of species to display
REVENUE <- NULL
#Sppnames <- unique(REVENUEFILE[,c("NESPP3","SPPNM"),])
-MAB <- c(23,51,754,769,11,12,352,121,801,335,446,802,
- 329,212,444,215)
-
-NE <- c(81,82,11,12,269,120,364:370,800,147,
- 352,153,168,122,123,124,125,152,155,507:509,
- 512,240,159,710,250,372,373,154)
+MAB <- c(
+ 23,
+ 51,
+ 754,
+ 769,
+ 11,
+ 12,
+ 352,
+ 121,
+ 801,
+ 335,
+ 446,
+ 802,
+ 329,
+ 212,
+ 444,
+ 215
+)
+
+NE <- c(
+ 81,
+ 82,
+ 11,
+ 12,
+ 269,
+ 120,
+ 364:370,
+ 800,
+ 147,
+ 352,
+ 153,
+ 168,
+ 122,
+ 123,
+ 124,
+ 125,
+ 152,
+ 155,
+ 507:509,
+ 512,
+ 240,
+ 159,
+ 710,
+ 250,
+ 372,
+ 373,
+ 154
+)
#had to specify columns to get rid of the total column
for (i in 1:length(file_list)) {
- load(file=file_list[i]) #read in files using the fread function from the data.table
- REVENUEFILE <- REVENUEFILE[which(REVENUEFILE$BROADZONE!="Other"),]
+ load(file = file_list[i]) #read in files using the fread function from the data.table
+ REVENUEFILE <- REVENUEFILE[which(REVENUEFILE$BROADZONE != "Other"), ]
REVENUE <- rbind(REVENUE, REVENUEFILE) #for each iteration, bind the new data to the building dataset
}
@@ -32,74 +74,101 @@ Top_5_Managed <- NULL
Top_5_Unfiltered_Names <- NULL
for (x in c("MAB", "NE")) {
-
-pii_all_yr_area_top_species <- subset(REVENUE, !is.na(SPPNM)) %>%
- dplyr::select(SPPNM, NESPP3, InsideREV, InsideLANDED, PERMIT, DEALNUM) %>%
- filter(NESPP3%in%get(x)) %>%
- group_by(SPPNM) %>%
- dplyr::summarize(
- InsideREV = sum(InsideREV, na.rm = T),
- InsideLANDED = sum(InsideLANDED, na.rm = T),
- npermits = length(unique(PERMIT)),
- ndealers = length(unique(DEALNUM))
- ) %>%
- #mutate(CONF = npermits < 3 | ndealers < 3) %>%
- #mutate(SPPNM_CONF = ifelse(CONF == T, 'All Others', SPPNM)) %>%
- mutate(SPPNM_CONF=SPPNM) %>%
- ungroup() %>%
- group_by(SPPNM_CONF) %>%
- dplyr::summarize(
- yfa_rev = sum(InsideREV, na.rm = T),
- yfa_land = sum(InsideLANDED, na.rm = T),
- npermits = sum(npermits, na.rm = T),
- ndealers = sum(ndealers, na.rm = T)
- ) %>%
- dplyr::rename("Species"= SPPNM_CONF) %>%
- arrange(desc(yfa_rev)) %>%
- top_n(n=number_of_top_species, wt=yfa_rev) %>%
- pull(Species)
-
-top_species_names <- str_to_title(pii_all_yr_area_top_species)
-top_species_names <- paste0(paste0(!top_species_names %in% tail(top_species_names, n=1), collapse = ", ") , " and ", tail(top_species_names, n=1))
-
-
-piispecies <- subset(REVENUE, !is.na(SPPNM)) %>%
- dplyr::select(SPPNM, NESPP3, Year, InsideREV, InsideLANDED, PERMIT, DEALNUM) %>%
- mutate(SPPNM = ifelse(SPPNM%in% pii_all_yr_area_top_species,SPPNM,'All Other')) %>%
- mutate(SPPNM = ifelse(SPPNM%in% "RED CRAB",'All Other',SPPNM)) %>%
- group_by(SPPNM, Year) %>%
- dplyr::summarize(
- InsideREV = sum(InsideREV, na.rm = T),
- InsideLANDED = sum(InsideLANDED, na.rm = T),
- npermits = length(unique(PERMIT)),
- ndealers = length(unique(DEALNUM))
- ) %>%
- mutate(CONF = npermits < 3 | ndealers < 3) %>%
- mutate(SPPNM_CONF = ifelse(CONF == T, 'All Other', SPPNM)) %>%
- ungroup() %>%
- group_by(SPPNM_CONF, Year) %>%
- dplyr::summarize(
- Value = sum(InsideREV, na.rm = T),
- yfa_land = sum(InsideLANDED, na.rm = T),
- npermits = sum(npermits, na.rm = T),
- ndealers = sum(ndealers, na.rm = T)) %>%
- dplyr::rename("Species"= SPPNM_CONF)
-
-piispecies$EPU <- x
-pii_all_yr_area_top_species <- cbind(pii_all_yr_area_top_species,x)
-
-Top_5_Managed <- rbind(Top_5_Managed,piispecies)
-Top_5_Unfiltered_Names <- rbind(Top_5_Unfiltered_Names,pii_all_yr_area_top_species)
-
+ pii_all_yr_area_top_species <- subset(REVENUE, !is.na(SPPNM)) %>%
+ dplyr::select(SPPNM, NESPP3, InsideREV, InsideLANDED, PERMIT, DEALNUM) %>%
+ filter(NESPP3 %in% get(x)) %>%
+ group_by(SPPNM) %>%
+ dplyr::summarize(
+ InsideREV = sum(InsideREV, na.rm = T),
+ InsideLANDED = sum(InsideLANDED, na.rm = T),
+ npermits = length(unique(PERMIT)),
+ ndealers = length(unique(DEALNUM))
+ ) %>%
+ #mutate(CONF = npermits < 3 | ndealers < 3) %>%
+ #mutate(SPPNM_CONF = ifelse(CONF == T, 'All Others', SPPNM)) %>%
+ mutate(SPPNM_CONF = SPPNM) %>%
+ ungroup() %>%
+ group_by(SPPNM_CONF) %>%
+ dplyr::summarize(
+ yfa_rev = sum(InsideREV, na.rm = T),
+ yfa_land = sum(InsideLANDED, na.rm = T),
+ npermits = sum(npermits, na.rm = T),
+ ndealers = sum(ndealers, na.rm = T)
+ ) %>%
+ dplyr::rename("Species" = SPPNM_CONF) %>%
+ arrange(desc(yfa_rev)) %>%
+ top_n(n = number_of_top_species, wt = yfa_rev) %>%
+ pull(Species)
+
+ top_species_names <- str_to_title(pii_all_yr_area_top_species)
+ top_species_names <- paste0(
+ paste0(
+ !top_species_names %in% tail(top_species_names, n = 1),
+ collapse = ", "
+ ),
+ " and ",
+ tail(top_species_names, n = 1)
+ )
+
+ piispecies <- subset(REVENUE, !is.na(SPPNM)) %>%
+ dplyr::select(
+ SPPNM,
+ NESPP3,
+ Year,
+ InsideREV,
+ InsideLANDED,
+ PERMIT,
+ DEALNUM
+ ) %>%
+ mutate(
+ SPPNM = ifelse(SPPNM %in% pii_all_yr_area_top_species, SPPNM, 'All Other')
+ ) %>%
+ mutate(SPPNM = ifelse(SPPNM %in% "RED CRAB", 'All Other', SPPNM)) %>%
+ group_by(SPPNM, Year) %>%
+ dplyr::summarize(
+ InsideREV = sum(InsideREV, na.rm = T),
+ InsideLANDED = sum(InsideLANDED, na.rm = T),
+ npermits = length(unique(PERMIT)),
+ ndealers = length(unique(DEALNUM))
+ ) %>%
+ mutate(CONF = npermits < 3 | ndealers < 3) %>%
+ mutate(SPPNM_CONF = ifelse(CONF == T, 'All Other', SPPNM)) %>%
+ ungroup() %>%
+ group_by(SPPNM_CONF, Year) %>%
+ dplyr::summarize(
+ Value = sum(InsideREV, na.rm = T),
+ yfa_land = sum(InsideLANDED, na.rm = T),
+ npermits = sum(npermits, na.rm = T),
+ ndealers = sum(ndealers, na.rm = T)
+ ) %>%
+ dplyr::rename("Species" = SPPNM_CONF)
+
+ piispecies$EPU <- x
+ pii_all_yr_area_top_species <- cbind(pii_all_yr_area_top_species, x)
+
+ Top_5_Managed <- rbind(Top_5_Managed, piispecies)
+ Top_5_Unfiltered_Names <- rbind(
+ Top_5_Unfiltered_Names,
+ pii_all_yr_area_top_species
+ )
}
-Top_5_Managed$Species <-str_to_title(Top_5_Managed$Species)
+Top_5_Managed$Species <- str_to_title(Top_5_Managed$Species)
-Top_5_Managed <- Top_5_Managed[,c("Species","Year","Value","EPU")] %>%
- pivot_longer(Species, values_to="Var") %>%
- mutate(Var = paste0(Var," (Top 5 Species Revenue from Wind Development Areas)", sep="")) %>%
+Top_5_Managed <- Top_5_Managed[, c("Species", "Year", "Value", "EPU")] %>%
+ pivot_longer(Species, values_to = "Var") %>%
+ mutate(
+ Var = paste0(
+ Var,
+ " (Top 5 Species Revenue from Wind Development Areas)",
+ sep = ""
+ )
+ ) %>%
mutate(Units = "2019 Constant Dollars") %>%
- mutate(Time=Year) %>%
- dplyr::select(Time,Var,Value,EPU,Units)
+ mutate(Time = Year) %>%
+ dplyr::select(Time, Var, Value, EPU, Units)
-write.csv(Top_5_Managed,"X:/gdepiper/ESR2020/Data/FINAL/Wind_Energy_Revenue.csv")
+write.csv(
+ Top_5_Managed,
+ "X:/gdepiper/ESR2020/Data/FINAL/Wind_Energy_Revenue.csv"
+)
diff --git a/R/stored_scripts/annual_sst_cycles_analysis_and_plotting.R b/R/stored_scripts/annual_sst_cycles_analysis_and_plotting.R
index 0e961379..a606c3c5 100644
--- a/R/stored_scripts/annual_sst_cycles_analysis_and_plotting.R
+++ b/R/stored_scripts/annual_sst_cycles_analysis_and_plotting.R
@@ -1,297 +1,371 @@
-#### annual sst cycles data analysis and plotting
-
-### Analysis
-#----------------------Load results--------------------------#
-load("dir1_sst.Rdata")
-load("dir2_sst.Rdata")
-load("dir3_sst.Rdata")
-load("sst_2017.Rdata")
-
-#Get long term mean and standard deviation
-d <- rbind(data1, data2, data3)
-
-ltm <- d %>% group_by(EPU, day) %>% dplyr::summarise(mean = mean(Value),
- sd = sd(Value))
-
-
-### Plotting
-# ```{r plotting, echo = T, eval = T, fig.cap = "Long-term mean SSTs for the Mid-Atlantic Bight (A),
-# Georges Bank (B), and Gulf of Maine (C). Orange and cyan shading show where the 2017 daily SST
-# values were above or below the long-term mean respectively; red and dark blue shades indicate days
-# when the 2017 mean exceeded +/- 1 standard deviation from the long-term mean.", fig.width=8,
-# fig.height=3.25, fig.align='center'}
-
-# Load data
-load(file.path(data.dir,"SOE_data_erddap.Rdata"))
-
-##---------------------------------MAB-----------------------------------------#
-par(mfrow = c(1,3))
-doy <- as.numeric(SOE.data[SOE.data$Var == "sst mean 2017 MAB",]$Time)
-val_2017 <- SOE.data[SOE.data$Var == "sst mean 2017 MAB",]$Value
-val_LT <- SOE.data[SOE.data$Var == "sst mean long term MAB",]$Value
-val_LT_sd <- SOE.data[SOE.data$Var == "sst sd long term MAB",]$Value
-
-
-# val_2017 <- approx(doy,val_2017, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-# val_LT <- approx(doy,val_LT, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-# val_LT_sd <- approx(doy,val_LT_sd, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-doy <- seq(doy[1],doy[length(doy)],length.out = 365*1)
-
-
-above_mean <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] >= val_LT[i]){
- above_mean[i] <- val_2017[i]
- } else if (val_2017[i] < val_LT [i]){
- above_mean[i] <- NA
- }
-}
-
-below_mean <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] <= val_LT[i]){
- below_mean[i] <- val_2017[i]
- } else if (val_2017[i] > val_LT [i]){
- below_mean[i] <- NA
- }
-}
-
-above_sd <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] >= val_LT_sd[i] + val_LT[i]){
- above_sd[i] <- val_2017[i]
- } else if (val_2017[i] < val_LT_sd [i] + val_LT[i]){
- above_sd[i] <- NA
- }
-}
-
-below_sd <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] <= val_LT[i] - val_LT_sd[i]){
- below_sd[i] <- val_2017[i]
- } else if (val_2017[i] > val_LT[i] - val_LT_sd [i]){
- below_sd[i] <- NA
- }
-}
-
-#Lines for polygons
-above_sd[is.na(above_sd)] <- val_LT_sd[which(is.na(above_sd))] + val_LT[which(is.na(above_sd))]
-below_sd[is.na(above_sd)] <- val_LT[which(is.na(below_sd))] - val_LT_sd[which(is.na(below_sd))]
-above_mean[is.na(above_mean)] <- val_LT[which(is.na(above_mean))]
-below_mean[is.na(below_mean)] <- val_LT[which(is.na(below_mean))]
-
-upper <- val_LT_sd + val_LT
-lower <- val_LT - val_LT_sd
-
-#Null figure
-plot(NULL, xlim = c(doy[1],doy[(length(doy))]), ylim = c(4,25), las = 1,
- ylab = "", yaxt = "n", xaxt = "n", xlab = "")
-axis(2, cex.axis = 1.25, las = 1)
-axis(1, labels = c("Jan","Mar","May","July","Sep","Nov","Jan"),
- at = c(1,61,122,183,245,306,365), cex.axis= 1.25)
-mtext(2, line = 2.3, text = expression(paste("Mean SST (",degree,"C)")), cex = 1.1)
-mtext(1, line = 2.5, text = "Time", cex = 1.1)
-text(15,25*.95,"A",cex = 1.5)
-# +/- 1 sd
-polygon(c(doy, rev(doy)),
- c(upper, rev(lower)),
- col = "grey85", border = NA)
-
-#Fills plot
-polygon(c(doy, rev(doy)),
- c(below_mean + (val_LT-below_mean), rev(below_mean)),
- col = "lightblue", border = NA)
-polygon(c(doy, rev(doy)),
- c(above_mean - (above_mean-val_LT), rev(above_mean)),
- col = "orange", border = NA)
-polygon(c(doy, rev(doy)),
- c(above_sd - (above_sd-(val_LT + val_LT_sd)), rev(above_sd)),
- col = "red", border = NA)
-polygon(c(doy, rev(doy)),
- c(below_sd + (below_sd-(val_LT - val_LT_sd)), rev(below_sd)),
- col = "blue", border = NA)
-points(doy,val_LT, type = "l", lwd = 1, "grey90")
-
-
-##-------------------------------------GB-------------------------------------#
-
-doy <- as.numeric(SOE.data[SOE.data$Var == "sst mean 2017 GB",]$Time)
-val_2017 <- SOE.data[SOE.data$Var == "sst mean 2017 GB",]$Value
-val_LT <- SOE.data[SOE.data$Var == "sst mean long term GB",]$Value
-val_LT_sd <- SOE.data[SOE.data$Var == "sst sd long term GB",]$Value
-
-
-# val_2017 <- approx(doy,val_2017, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-# val_LT <- approx(doy,val_LT, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-# val_LT_sd <- approx(doy,val_LT_sd, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-doy <- seq(doy[1],doy[length(doy)],length.out = 365*1)
-
-
-above_mean <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] >= val_LT[i]){
- above_mean[i] <- val_2017[i]
- } else if (val_2017[i] < val_LT [i]){
- above_mean[i] <- NA
- }
-}
-
-below_mean <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] <= val_LT[i]){
- below_mean[i] <- val_2017[i]
- } else if (val_2017[i] > val_LT [i]){
- below_mean[i] <- NA
- }
-}
-
-above_sd <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] >= val_LT_sd[i] + val_LT[i]){
- above_sd[i] <- val_2017[i]
- } else if (val_2017[i] < val_LT_sd [i] + val_LT[i]){
- above_sd[i] <- NA
- }
-}
-
-below_sd <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] <= val_LT[i] - val_LT_sd[i]){
- below_sd[i] <- val_2017[i]
- } else if (val_2017[i] > val_LT[i] - val_LT_sd [i]){
- below_sd[i] <- NA
- }
-}
-
-#Lines for polygons
-above_sd[is.na(above_sd)] <- val_LT_sd[which(is.na(above_sd))] + val_LT[which(is.na(above_sd))]
-below_sd[is.na(above_sd)] <- val_LT[which(is.na(below_sd))] - val_LT_sd[which(is.na(below_sd))]
-above_mean[is.na(above_mean)] <- val_LT[which(is.na(above_mean))]
-below_mean[is.na(below_mean)] <- val_LT[which(is.na(below_mean))]
-
-upper <- val_LT_sd + val_LT
-lower <- val_LT - val_LT_sd
-
-#Null figure
-plot(NULL, xlim = c(doy[1],doy[(length(doy))]), ylim = c(4,21), las = 1,
- ylab = "", yaxt = "n", xaxt = "n", xlab = "")
-axis(2, cex.axis = 1.25, las = 1)
-axis(1, labels = c("Jan","Mar","May","July","Sep","Nov","Jan"),
- at = c(1,61,122,183,245,306,365), cex.axis= 1.25)
-#mtext(2, line = 2.5, text = expression(paste("Mean SST (",degree,"C)")), cex = 1.1)
-mtext(1, line = 2.5, text = "Time", cex = 1.1)
-text(15,21*.95,"B",cex = 1.5)
-# +/- 1 sd
-polygon(c(doy, rev(doy)),
- c(upper, rev(lower)),
- col = "grey85", border = NA)
-
-#Fills plot
-polygon(c(doy, rev(doy)),
- c(below_mean + (val_LT-below_mean), rev(below_mean)),
- col = "lightblue", border = NA)
-polygon(c(doy, rev(doy)),
- c(above_mean - (above_mean-val_LT), rev(above_mean)),
- col = "orange", border = NA)
-polygon(c(doy, rev(doy)),
- c(above_sd - (above_sd-(val_LT + val_LT_sd)), rev(above_sd)),
- col = "red", border = NA)
-polygon(c(doy, rev(doy)),
- c(below_sd + (below_sd-(val_LT - val_LT_sd)), rev(below_sd)),
- col = "blue", border = NA)
-points(doy,val_LT, type = "l", lwd = 1, "grey90")
-
-#----------------------------------------------------------------------------#
-
-## SST GOM
-
-doy <- as.numeric(SOE.data[SOE.data$Var == "sst mean 2017 GOM",]$Time)
-val_2017 <- SOE.data[SOE.data$Var == "sst mean 2017 GOM",]$Value
-val_LT <- SOE.data[SOE.data$Var == "sst mean long term GOM",]$Value
-val_LT_sd <- SOE.data[SOE.data$Var == "sst sd long term GOM",]$Value
-
-
-# val_2017 <- approx(doy,val_2017, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-# val_LT <- approx(doy,val_LT, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-# val_LT_sd <- approx(doy,val_LT_sd, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
-doy <- seq(doy[1],doy[length(doy)],length.out = 365*1)
-
-
-above_mean <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] >= val_LT[i]){
- above_mean[i] <- val_2017[i]
- } else if (val_2017[i] < val_LT [i]){
- above_mean[i] <- NA
- }
-}
-
-below_mean <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] <= val_LT[i]){
- below_mean[i] <- val_2017[i]
- } else if (val_2017[i] > val_LT [i]){
- below_mean[i] <- NA
- }
-}
-
-above_sd <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] >= val_LT_sd[i] + val_LT[i]){
- above_sd[i] <- val_2017[i]
- } else if (val_2017[i] < val_LT_sd [i] + val_LT[i]){
- above_sd[i] <- NA
- }
-}
-
-below_sd <- NULL
-for (i in 1:length(val_2017)){
- if (val_2017[i] <= val_LT[i] - val_LT_sd[i]){
- below_sd[i] <- val_2017[i]
- } else if (val_2017[i] > val_LT[i] - val_LT_sd [i]){
- below_sd[i] <- NA
- }
-}
-
-#Lines for polygons
-above_sd[is.na(above_sd)] <- val_LT_sd[which(is.na(above_sd))] + val_LT[which(is.na(above_sd))]
-below_sd[is.na(above_sd)] <- val_LT[which(is.na(below_sd))] - val_LT_sd[which(is.na(below_sd))]
-above_mean[is.na(above_mean)] <- val_LT[which(is.na(above_mean))]
-below_mean[is.na(below_mean)] <- val_LT[which(is.na(below_mean))]
-
-upper <- val_LT_sd + val_LT
-lower <- val_LT - val_LT_sd
-
-#Null figure
-plot(NULL, xlim = c(doy[1],doy[(length(doy))]), ylim = c(4,21), las = 1,
- ylab = "", yaxt = "n", xaxt = "n", xlab = "")
-axis(2, cex.axis = 1.25, las = 1)
-axis(1, labels = c("Jan","Mar","May","July","Sep","Nov","Jan"),
- at = c(1,61,122,183,245,306,365), cex.axis= 1.25)
-#(2, line = 2.5, text = expression(paste("Mean SST (",degree,"C)")), cex = 1.1)
-mtext(1, line = 2.5, text = "Time", cex = 1.1)
-text(15,21*.95,"C",cex = 1.5)
-# +/- 1 sd
-polygon(c(doy, rev(doy)),
- c(upper, rev(lower)),
- col = "grey85", border = NA)
-
-#Fills plot
-polygon(c(doy, rev(doy)),
- c(below_mean + (val_LT-below_mean), rev(below_mean)),
- col = "lightblue", border = NA)
-polygon(c(doy, rev(doy)),
- c(above_mean - (above_mean-val_LT), rev(above_mean)),
- col = "orange", border = NA)
-polygon(c(doy, rev(doy)),
- c(above_sd - (above_sd-(val_LT + val_LT_sd)), rev(above_sd)),
- col = "red", border = NA)
-polygon(c(doy, rev(doy)),
- c(below_sd + (below_sd-(val_LT - val_LT_sd)), rev(below_sd)),
- col = "blue", border = NA)
-points(doy,val_LT, type = "l", lwd = 1, "grey90")
-box()
-
-
-
-
+#### annual sst cycles data analysis and plotting
+
+### Analysis
+#----------------------Load results--------------------------#
+load("dir1_sst.Rdata")
+load("dir2_sst.Rdata")
+load("dir3_sst.Rdata")
+load("sst_2017.Rdata")
+
+#Get long term mean and standard deviation
+d <- rbind(data1, data2, data3)
+
+ltm <- d %>%
+ group_by(EPU, day) %>%
+ dplyr::summarise(mean = mean(Value), sd = sd(Value))
+
+
+### Plotting
+# ```{r plotting, echo = T, eval = T, fig.cap = "Long-term mean SSTs for the Mid-Atlantic Bight (A),
+# Georges Bank (B), and Gulf of Maine (C). Orange and cyan shading show where the 2017 daily SST
+# values were above or below the long-term mean respectively; red and dark blue shades indicate days
+# when the 2017 mean exceeded +/- 1 standard deviation from the long-term mean.", fig.width=8,
+# fig.height=3.25, fig.align='center'}
+
+# Load data
+load(file.path(data.dir, "SOE_data_erddap.Rdata"))
+
+##---------------------------------MAB-----------------------------------------#
+par(mfrow = c(1, 3))
+doy <- as.numeric(SOE.data[SOE.data$Var == "sst mean 2017 MAB", ]$Time)
+val_2017 <- SOE.data[SOE.data$Var == "sst mean 2017 MAB", ]$Value
+val_LT <- SOE.data[SOE.data$Var == "sst mean long term MAB", ]$Value
+val_LT_sd <- SOE.data[SOE.data$Var == "sst sd long term MAB", ]$Value
+
+
+# val_2017 <- approx(doy,val_2017, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+# val_LT <- approx(doy,val_LT, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+# val_LT_sd <- approx(doy,val_LT_sd, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+doy <- seq(doy[1], doy[length(doy)], length.out = 365 * 1)
+
+
+above_mean <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] >= val_LT[i]) {
+ above_mean[i] <- val_2017[i]
+ } else if (val_2017[i] < val_LT[i]) {
+ above_mean[i] <- NA
+ }
+}
+
+below_mean <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] <= val_LT[i]) {
+ below_mean[i] <- val_2017[i]
+ } else if (val_2017[i] > val_LT[i]) {
+ below_mean[i] <- NA
+ }
+}
+
+above_sd <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] >= val_LT_sd[i] + val_LT[i]) {
+ above_sd[i] <- val_2017[i]
+ } else if (val_2017[i] < val_LT_sd[i] + val_LT[i]) {
+ above_sd[i] <- NA
+ }
+}
+
+below_sd <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] <= val_LT[i] - val_LT_sd[i]) {
+ below_sd[i] <- val_2017[i]
+ } else if (val_2017[i] > val_LT[i] - val_LT_sd[i]) {
+ below_sd[i] <- NA
+ }
+}
+
+#Lines for polygons
+above_sd[is.na(above_sd)] <- val_LT_sd[which(is.na(above_sd))] +
+ val_LT[which(is.na(above_sd))]
+below_sd[is.na(above_sd)] <- val_LT[which(is.na(below_sd))] -
+ val_LT_sd[which(is.na(below_sd))]
+above_mean[is.na(above_mean)] <- val_LT[which(is.na(above_mean))]
+below_mean[is.na(below_mean)] <- val_LT[which(is.na(below_mean))]
+
+upper <- val_LT_sd + val_LT
+lower <- val_LT - val_LT_sd
+
+#Null figure
+plot(
+ NULL,
+ xlim = c(doy[1], doy[(length(doy))]),
+ ylim = c(4, 25),
+ las = 1,
+ ylab = "",
+ yaxt = "n",
+ xaxt = "n",
+ xlab = ""
+)
+axis(2, cex.axis = 1.25, las = 1)
+axis(
+ 1,
+ labels = c("Jan", "Mar", "May", "July", "Sep", "Nov", "Jan"),
+ at = c(1, 61, 122, 183, 245, 306, 365),
+ cex.axis = 1.25
+)
+mtext(
+ 2,
+ line = 2.3,
+ text = expression(paste("Mean SST (", degree, "C)")),
+ cex = 1.1
+)
+mtext(1, line = 2.5, text = "Time", cex = 1.1)
+text(15, 25 * .95, "A", cex = 1.5)
+# +/- 1 sd
+polygon(c(doy, rev(doy)), c(upper, rev(lower)), col = "grey85", border = NA)
+
+#Fills plot
+polygon(
+ c(doy, rev(doy)),
+ c(below_mean + (val_LT - below_mean), rev(below_mean)),
+ col = "lightblue",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(above_mean - (above_mean - val_LT), rev(above_mean)),
+ col = "orange",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(above_sd - (above_sd - (val_LT + val_LT_sd)), rev(above_sd)),
+ col = "red",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(below_sd + (below_sd - (val_LT - val_LT_sd)), rev(below_sd)),
+ col = "blue",
+ border = NA
+)
+points(doy, val_LT, type = "l", lwd = 1, "grey90")
+
+
+##-------------------------------------GB-------------------------------------#
+
+doy <- as.numeric(SOE.data[SOE.data$Var == "sst mean 2017 GB", ]$Time)
+val_2017 <- SOE.data[SOE.data$Var == "sst mean 2017 GB", ]$Value
+val_LT <- SOE.data[SOE.data$Var == "sst mean long term GB", ]$Value
+val_LT_sd <- SOE.data[SOE.data$Var == "sst sd long term GB", ]$Value
+
+
+# val_2017 <- approx(doy,val_2017, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+# val_LT <- approx(doy,val_LT, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+# val_LT_sd <- approx(doy,val_LT_sd, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+doy <- seq(doy[1], doy[length(doy)], length.out = 365 * 1)
+
+
+above_mean <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] >= val_LT[i]) {
+ above_mean[i] <- val_2017[i]
+ } else if (val_2017[i] < val_LT[i]) {
+ above_mean[i] <- NA
+ }
+}
+
+below_mean <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] <= val_LT[i]) {
+ below_mean[i] <- val_2017[i]
+ } else if (val_2017[i] > val_LT[i]) {
+ below_mean[i] <- NA
+ }
+}
+
+above_sd <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] >= val_LT_sd[i] + val_LT[i]) {
+ above_sd[i] <- val_2017[i]
+ } else if (val_2017[i] < val_LT_sd[i] + val_LT[i]) {
+ above_sd[i] <- NA
+ }
+}
+
+below_sd <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] <= val_LT[i] - val_LT_sd[i]) {
+ below_sd[i] <- val_2017[i]
+ } else if (val_2017[i] > val_LT[i] - val_LT_sd[i]) {
+ below_sd[i] <- NA
+ }
+}
+
+#Lines for polygons
+above_sd[is.na(above_sd)] <- val_LT_sd[which(is.na(above_sd))] +
+ val_LT[which(is.na(above_sd))]
+below_sd[is.na(above_sd)] <- val_LT[which(is.na(below_sd))] -
+ val_LT_sd[which(is.na(below_sd))]
+above_mean[is.na(above_mean)] <- val_LT[which(is.na(above_mean))]
+below_mean[is.na(below_mean)] <- val_LT[which(is.na(below_mean))]
+
+upper <- val_LT_sd + val_LT
+lower <- val_LT - val_LT_sd
+
+#Null figure
+plot(
+ NULL,
+ xlim = c(doy[1], doy[(length(doy))]),
+ ylim = c(4, 21),
+ las = 1,
+ ylab = "",
+ yaxt = "n",
+ xaxt = "n",
+ xlab = ""
+)
+axis(2, cex.axis = 1.25, las = 1)
+axis(
+ 1,
+ labels = c("Jan", "Mar", "May", "July", "Sep", "Nov", "Jan"),
+ at = c(1, 61, 122, 183, 245, 306, 365),
+ cex.axis = 1.25
+)
+#mtext(2, line = 2.5, text = expression(paste("Mean SST (",degree,"C)")), cex = 1.1)
+mtext(1, line = 2.5, text = "Time", cex = 1.1)
+text(15, 21 * .95, "B", cex = 1.5)
+# +/- 1 sd
+polygon(c(doy, rev(doy)), c(upper, rev(lower)), col = "grey85", border = NA)
+
+#Fills plot
+polygon(
+ c(doy, rev(doy)),
+ c(below_mean + (val_LT - below_mean), rev(below_mean)),
+ col = "lightblue",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(above_mean - (above_mean - val_LT), rev(above_mean)),
+ col = "orange",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(above_sd - (above_sd - (val_LT + val_LT_sd)), rev(above_sd)),
+ col = "red",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(below_sd + (below_sd - (val_LT - val_LT_sd)), rev(below_sd)),
+ col = "blue",
+ border = NA
+)
+points(doy, val_LT, type = "l", lwd = 1, "grey90")
+
+#----------------------------------------------------------------------------#
+
+## SST GOM
+
+doy <- as.numeric(SOE.data[SOE.data$Var == "sst mean 2017 GOM", ]$Time)
+val_2017 <- SOE.data[SOE.data$Var == "sst mean 2017 GOM", ]$Value
+val_LT <- SOE.data[SOE.data$Var == "sst mean long term GOM", ]$Value
+val_LT_sd <- SOE.data[SOE.data$Var == "sst sd long term GOM", ]$Value
+
+
+# val_2017 <- approx(doy,val_2017, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+# val_LT <- approx(doy,val_LT, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+# val_LT_sd <- approx(doy,val_LT_sd, xout = seq(doy[1],doy[length(doy)],length.out = 365*1))$y
+doy <- seq(doy[1], doy[length(doy)], length.out = 365 * 1)
+
+
+above_mean <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] >= val_LT[i]) {
+ above_mean[i] <- val_2017[i]
+ } else if (val_2017[i] < val_LT[i]) {
+ above_mean[i] <- NA
+ }
+}
+
+below_mean <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] <= val_LT[i]) {
+ below_mean[i] <- val_2017[i]
+ } else if (val_2017[i] > val_LT[i]) {
+ below_mean[i] <- NA
+ }
+}
+
+above_sd <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] >= val_LT_sd[i] + val_LT[i]) {
+ above_sd[i] <- val_2017[i]
+ } else if (val_2017[i] < val_LT_sd[i] + val_LT[i]) {
+ above_sd[i] <- NA
+ }
+}
+
+below_sd <- NULL
+for (i in 1:length(val_2017)) {
+ if (val_2017[i] <= val_LT[i] - val_LT_sd[i]) {
+ below_sd[i] <- val_2017[i]
+ } else if (val_2017[i] > val_LT[i] - val_LT_sd[i]) {
+ below_sd[i] <- NA
+ }
+}
+
+#Lines for polygons
+above_sd[is.na(above_sd)] <- val_LT_sd[which(is.na(above_sd))] +
+ val_LT[which(is.na(above_sd))]
+below_sd[is.na(above_sd)] <- val_LT[which(is.na(below_sd))] -
+ val_LT_sd[which(is.na(below_sd))]
+above_mean[is.na(above_mean)] <- val_LT[which(is.na(above_mean))]
+below_mean[is.na(below_mean)] <- val_LT[which(is.na(below_mean))]
+
+upper <- val_LT_sd + val_LT
+lower <- val_LT - val_LT_sd
+
+#Null figure
+plot(
+ NULL,
+ xlim = c(doy[1], doy[(length(doy))]),
+ ylim = c(4, 21),
+ las = 1,
+ ylab = "",
+ yaxt = "n",
+ xaxt = "n",
+ xlab = ""
+)
+axis(2, cex.axis = 1.25, las = 1)
+axis(
+ 1,
+ labels = c("Jan", "Mar", "May", "July", "Sep", "Nov", "Jan"),
+ at = c(1, 61, 122, 183, 245, 306, 365),
+ cex.axis = 1.25
+)
+#(2, line = 2.5, text = expression(paste("Mean SST (",degree,"C)")), cex = 1.1)
+mtext(1, line = 2.5, text = "Time", cex = 1.1)
+text(15, 21 * .95, "C", cex = 1.5)
+# +/- 1 sd
+polygon(c(doy, rev(doy)), c(upper, rev(lower)), col = "grey85", border = NA)
+
+#Fills plot
+polygon(
+ c(doy, rev(doy)),
+ c(below_mean + (val_LT - below_mean), rev(below_mean)),
+ col = "lightblue",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(above_mean - (above_mean - val_LT), rev(above_mean)),
+ col = "orange",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(above_sd - (above_sd - (val_LT + val_LT_sd)), rev(above_sd)),
+ col = "red",
+ border = NA
+)
+polygon(
+ c(doy, rev(doy)),
+ c(below_sd + (below_sd - (val_LT - val_LT_sd)), rev(below_sd)),
+ col = "blue",
+ border = NA
+)
+points(doy, val_LT, type = "l", lwd = 1, "grey90")
+box()
diff --git a/R/stored_scripts/annual_sst_cycles_extraction_and_processing.R b/R/stored_scripts/annual_sst_cycles_extraction_and_processing.R
index 498f8bc0..fbb6166c 100644
--- a/R/stored_scripts/annual_sst_cycles_extraction_and_processing.R
+++ b/R/stored_scripts/annual_sst_cycles_extraction_and_processing.R
@@ -1,142 +1,153 @@
-#### Annual SST cycles Extraction and Processing
-
-#libraries
-library(ncdf4);library(dplyr)
-library(readr);library(tidyr)
-library(sp);library(rgdal)
-library(raster);library(stringr)
-
-#get spatial polygons for Ecological Production Units (EPUs) that are used to clip SST data.
-EPU <- readOGR('Extended_EPU')
-
-map.crs <- CRS("+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
- +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")
-
-#find long term daily mean SSTs and 2017 SST anomaly
-MAB_sst_daily_mean <- NULL
-GB_sst_daily_mean <- NULL
-GOM_sst_daily_mean <- NULL
-
-#I split the data into three directories to loop through in separate R sessions concurrently.
-
-
-for (dir. in 1:3){
-
- #Loop through directories
- setwd(paste0('c:/users/sean.hardison/documents/sst_data/',dir.))
- print(getwd())
-
- for (f in 1:length(list.files())){
-
- if (!str_detect(list.files()[f],".nc")){
- print(paste(list.files()[f],"is not a raster")) #Based on file type
- next
- }
-
- for (j in c("MAB","GB","GOM")){
-
- sub_region <- EPU[EPU@data$EPU == j,]
- y <- as.numeric(str_extract(list.files()[f],"[0-9]+")) #get year
-
- for (i in 1:365){
- print(paste(j,y,i))
- daily_mean <- raster(paste0(list.files()[f]), band = i) #get band
-
- #set crs
- daily_mean@crs <- sub_region@proj4string
-
-
- #rotate to lon scale from 0-360 to -180-180
- daily_mean <- rotate(daily_mean)
-
- #mask raster with spatialpolygon
- daily_mean_clipped <- mask(daily_mean, sub_region)
-
-
- #add mean value to data.frame
- assign(paste0(j,"_sst_daily_mean"),
- rbind(get(paste0(j,"_sst_daily_mean")),
- c(mean(daily_mean_clipped@data@values, na.rm = T),y,i)))
-
- }
- }
-
-
- }
-}
-
-#Put results into data.frames
-mab <- data.frame(EPU = "MAB",
- year = MAB_sst_daily_mean[,2],
- day = MAB_sst_daily_mean[,3],
- Value = MAB_sst_daily_mean[,1])
-
-gb <- data.frame(EPU = "GB",
- year = GB_sst_daily_mean[,2],
- day = GB_sst_daily_mean[,3],
- Value = GB_sst_daily_mean[,1])
-
-gom <- data.frame(EPU = "GOM",
- year = GOM_sst_daily_mean[,2],
- day = GOM_sst_daily_mean[,3],
- Value = GOM_sst_daily_mean[,1])
-
-
-data3 <- rbind(mab, gb, gom)
-
-#Save as 1 of 3 files (one for each directory containing daily mean data)
-save(data3, file = "dir3_sst.Rdata")
-
-#--------------------------2017 SSTs----------------------------#
-MAB_2017 <- NULL
-GB_2017 <- NULL
-GOM_2017 <- NULL
-
-for (j in c("MAB","GB","GOM")){
-
- sub_region <- EPU[EPU@data$EPU == j,]
-
- for (i in 1:365){
- print(paste(j,i))
- daily_mean <- raster("sst.day.mean.2017.nc", band = i) #get band
-
-
- #set crs
- daily_mean@crs <- sub_region@proj4string
-
-
- #rotate to lon scale from 0-360 to -180-180
- daily_mean <- rotate(daily_mean)
-
- #mask raster with spatialpolygon
- daily_mean_clipped <- mask(daily_mean, sub_region)
-
-
- #add mean value to data.frame
- assign(paste0(j,"_2017"),
- rbind(get(paste0(j,"_2017")),
- c(mean(daily_mean_clipped@data@values, na.rm = T),"2017",i)))
-
- }
-}
-#Put results into data.frames
-mab_2017 <- data.frame(EPU = "MAB",
- year = MAB_2017[,2],
- day = MAB_2017[,3],
- Value = MAB_2017[,1])
-
-gb_2017 <- data.frame(EPU = "GB",
- year = GB_2017[,2],
- day = GB_2017[,3],
- Value = GB_2017[,1])
-
-gom_2017 <- data.frame(EPU = "GOM",
- year = GOM_2017[,2],
- day = GOM_2017[,3],
- Value = GOM_2017[,1])
-
-
-#Final 2017 daily mean data
-sst_2017 <- rbind(mab_2017, gb_2017, gom_2017)
-#save(sst_2017, file = "sst_2017.Rdata")
-
+#### Annual SST cycles Extraction and Processing
+
+#libraries
+library(ncdf4)
+library(dplyr)
+library(readr)
+library(tidyr)
+library(sp)
+library(rgdal)
+library(raster)
+library(stringr)
+
+#get spatial polygons for Ecological Production Units (EPUs) that are used to clip SST data.
+EPU <- readOGR('Extended_EPU')
+
+map.crs <- CRS(
+ "+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
+ +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0"
+)
+
+#find long term daily mean SSTs and 2017 SST anomaly
+MAB_sst_daily_mean <- NULL
+GB_sst_daily_mean <- NULL
+GOM_sst_daily_mean <- NULL
+
+#I split the data into three directories to loop through in separate R sessions concurrently.
+
+for (dir. in 1:3) {
+ #Loop through directories
+ setwd(paste0('c:/users/sean.hardison/documents/sst_data/', dir.))
+ print(getwd())
+
+ for (f in 1:length(list.files())) {
+ if (!str_detect(list.files()[f], ".nc")) {
+ print(paste(list.files()[f], "is not a raster")) #Based on file type
+ next
+ }
+
+ for (j in c("MAB", "GB", "GOM")) {
+ sub_region <- EPU[EPU@data$EPU == j, ]
+ y <- as.numeric(str_extract(list.files()[f], "[0-9]+")) #get year
+
+ for (i in 1:365) {
+ print(paste(j, y, i))
+ daily_mean <- raster(paste0(list.files()[f]), band = i) #get band
+
+ #set crs
+ daily_mean@crs <- sub_region@proj4string
+
+ #rotate to lon scale from 0-360 to -180-180
+ daily_mean <- rotate(daily_mean)
+
+ #mask raster with spatialpolygon
+ daily_mean_clipped <- mask(daily_mean, sub_region)
+
+ #add mean value to data.frame
+ assign(
+ paste0(j, "_sst_daily_mean"),
+ rbind(
+ get(paste0(j, "_sst_daily_mean")),
+ c(mean(daily_mean_clipped@data@values, na.rm = T), y, i)
+ )
+ )
+ }
+ }
+ }
+}
+
+#Put results into data.frames
+mab <- data.frame(
+ EPU = "MAB",
+ year = MAB_sst_daily_mean[, 2],
+ day = MAB_sst_daily_mean[, 3],
+ Value = MAB_sst_daily_mean[, 1]
+)
+
+gb <- data.frame(
+ EPU = "GB",
+ year = GB_sst_daily_mean[, 2],
+ day = GB_sst_daily_mean[, 3],
+ Value = GB_sst_daily_mean[, 1]
+)
+
+gom <- data.frame(
+ EPU = "GOM",
+ year = GOM_sst_daily_mean[, 2],
+ day = GOM_sst_daily_mean[, 3],
+ Value = GOM_sst_daily_mean[, 1]
+)
+
+
+data3 <- rbind(mab, gb, gom)
+
+#Save as 1 of 3 files (one for each directory containing daily mean data)
+save(data3, file = "dir3_sst.Rdata")
+
+#--------------------------2017 SSTs----------------------------#
+MAB_2017 <- NULL
+GB_2017 <- NULL
+GOM_2017 <- NULL
+
+for (j in c("MAB", "GB", "GOM")) {
+ sub_region <- EPU[EPU@data$EPU == j, ]
+
+ for (i in 1:365) {
+ print(paste(j, i))
+ daily_mean <- raster("sst.day.mean.2017.nc", band = i) #get band
+
+ #set crs
+ daily_mean@crs <- sub_region@proj4string
+
+ #rotate to lon scale from 0-360 to -180-180
+ daily_mean <- rotate(daily_mean)
+
+ #mask raster with spatialpolygon
+ daily_mean_clipped <- mask(daily_mean, sub_region)
+
+ #add mean value to data.frame
+ assign(
+ paste0(j, "_2017"),
+ rbind(
+ get(paste0(j, "_2017")),
+ c(mean(daily_mean_clipped@data@values, na.rm = T), "2017", i)
+ )
+ )
+ }
+}
+#Put results into data.frames
+mab_2017 <- data.frame(
+ EPU = "MAB",
+ year = MAB_2017[, 2],
+ day = MAB_2017[, 3],
+ Value = MAB_2017[, 1]
+)
+
+gb_2017 <- data.frame(
+ EPU = "GB",
+ year = GB_2017[, 2],
+ day = GB_2017[, 3],
+ Value = GB_2017[, 1]
+)
+
+gom_2017 <- data.frame(
+ EPU = "GOM",
+ year = GOM_2017[, 2],
+ day = GOM_2017[, 3],
+ Value = GOM_2017[, 1]
+)
+
+
+#Final 2017 daily mean data
+sst_2017 <- rbind(mab_2017, gb_2017, gom_2017)
+#save(sst_2017, file = "sst_2017.Rdata")
diff --git a/R/stored_scripts/bennet_analysis.R b/R/stored_scripts/bennet_analysis.R
index e9943918..6607456d 100644
--- a/R/stored_scripts/bennet_analysis.R
+++ b/R/stored_scripts/bennet_analysis.R
@@ -1,69 +1,76 @@
-### Bennet indicator analysis
-
-
-#```{r, echo = T, eval = F}
-#R code to construct Bennet Indicator for Ecosystem Project
-#Author: John Walden
-#Date: October 4, 2017
-#
-#Revised January 18, 2018 to calculate the indicator relative to average conditions
-#during each time period. Set EPU in extraction/processing code chunk above.
-
-
-#filter by specific EPU
-epu = "GB"
-value <- subset(landsum, EPU == epu)
-
-#Calculate price
-value$PRICE=value$SPPVALUE/value$SPPLIVMT
-value[is.na(value)]<-0
-
-
-#Next two lines are to calculate mean values for landings
-#and value for the time series by feeding guild
-
-meanval<-as.data.frame(value[,j=list(mean(SPPVALUE,na.rm=TRUE),
- mean(SPPLIVMT,na.rm=TRUE)), by=Feeding.guild])
-meanval<-rename(meanval, c("V1"="BASEV", "V2"="BASEQ"))
-meanval$BASEP=meanval$BASEV/meanval$BASEQ;
-
-#order by feeding guild
-
-value<-value[order(value$Feeding.guild),]
-meanval<-meanval[order(meanval$Feeding.guild),]
-
-#Merge Value data frame with Base Year Value Data Frame
-value<-merge(value, meanval, by="Feeding.guild")
-
-#Construct price and Volume Indicators
-#NOTE: ALL values are normalized to $1,000,000
-
-value$VI=((0.5*(value$BASEP+value$PRICE))*(value$SPPLIVMT-value$BASEQ))/1000000
-value$PI=((0.5*(value$BASEQ+value$SPPLIVMT))*(value$PRICE-value$BASEP))/1000000
-
-value<-value[order(value$YEAR),]
-
-#The next Data table sets up the yearly aggregate Bennet PI and VI
-
-biyear<-data.table(value)
-setkey(biyear, "YEAR")
-biyear<-biyear[,lapply(.SD, sum), by=key(biyear), .SDcols=c("VI","PI","BASEV","SPPVALUE")]
-biyear$revchange<-(biyear$VI+biyear$PI)
-biyear$BI<-(biyear$VI + biyear$PI)
-
-#The Next Steps restructure the year data frame so the yearly
-#Bennet Indicator can be plotted. Negative values are difficult in GGPLOT.
-#Since the Bennet indicator can have a negative value, separate data frames
-#need to be created. First, the data needs to be restructured to use the
-#stacked bar function in ggplot. GGPLOT is used because it can graph different
-# data layers on the same graph.
-
-y1<-biyear[,c(1,2)]
-y1$indicator='VI'
-y2<-biyear[,c(1,3)]
-y2$indicator='PI'
-
-colnames(y1)[2]<-"value"
-colnames(y2)[2]<-"value"
-ytotal<-rbind(y1,y2)
-```
\ No newline at end of file
+### Bennet indicator analysis
+
+#```{r, echo = T, eval = F}
+#R code to construct Bennet Indicator for Ecosystem Project
+#Author: John Walden
+#Date: October 4, 2017
+#
+#Revised January 18, 2018 to calculate the indicator relative to average conditions
+#during each time period. Set EPU in extraction/processing code chunk above.
+
+#filter by specific EPU
+epu <- "GB"
+value <- subset(landsum, EPU == epu)
+
+#Calculate price
+value$PRICE <- value$SPPVALUE / value$SPPLIVMT
+value[is.na(value)] <- 0
+
+
+#Next two lines are to calculate mean values for landings
+#and value for the time series by feeding guild
+
+meanval <- as.data.frame(value[,
+ j = list(mean(SPPVALUE, na.rm = TRUE), mean(SPPLIVMT, na.rm = TRUE)),
+ by = Feeding.guild
+])
+meanval <- rename(meanval, c("V1" = "BASEV", "V2" = "BASEQ"))
+meanval$BASEP <- meanval$BASEV / meanval$BASEQ
+
+#order by feeding guild
+
+value <- value[order(value$Feeding.guild), ]
+meanval <- meanval[order(meanval$Feeding.guild), ]
+
+#Merge Value data frame with Base Year Value Data Frame
+value <- merge(value, meanval, by = "Feeding.guild")
+
+#Construct price and Volume Indicators
+#NOTE: ALL values are normalized to $1,000,000
+
+value$VI <- ((0.5 * (value$BASEP + value$PRICE)) *
+ (value$SPPLIVMT - value$BASEQ)) /
+ 1000000
+value$PI <- ((0.5 * (value$BASEQ + value$SPPLIVMT)) *
+ (value$PRICE - value$BASEP)) /
+ 1000000
+
+value <- value[order(value$YEAR), ]
+
+#The next Data table sets up the yearly aggregate Bennet PI and VI
+
+biyear <- data.table(value)
+setkey(biyear, "YEAR")
+biyear <- biyear[,
+ lapply(.SD, sum),
+ by = key(biyear),
+ .SDcols = c("VI", "PI", "BASEV", "SPPVALUE")
+]
+biyear$revchange <- (biyear$VI + biyear$PI)
+biyear$BI <- (biyear$VI + biyear$PI)
+
+#The Next Steps restructure the year data frame so the yearly
+#Bennet Indicator can be plotted. Negative values are difficult in GGPLOT.
+#Since the Bennet indicator can have a negative value, separate data frames
+#need to be created. First, the data needs to be restructured to use the
+#stacked bar function in ggplot. GGPLOT is used because it can graph different
+# data layers on the same graph.
+
+y1 <- biyear[, c(1, 2)]
+y1$indicator <- 'VI'
+y2 <- biyear[, c(1, 3)]
+y2$indicator <- 'PI'
+
+colnames(y1)[2] <- "value"
+colnames(y2)[2] <- "value"
+ytotal <- rbind(y1, y2)
diff --git a/R/stored_scripts/bennet_extraction.R b/R/stored_scripts/bennet_extraction.R
index d312a73f..d1a0d983 100644
--- a/R/stored_scripts/bennet_extraction.R
+++ b/R/stored_scripts/bennet_extraction.R
@@ -1,52 +1,74 @@
-### bennet_extraction
-
-# ```{r, echo = T, eval = F, warning=F, message=F}
-#This code is used to load and process comland data.
-#See comland methods for source data (CFDBS) processing methods.
-
-drake::readd(proc_get_mass_inshore_survey.R)
-
-#Packages
-PKG <- c("data.table","plyr","RColorBrewer", "ggplot2","cowplot","gridExtra","grid")
-for (p in PKG) {
- if(!require(p,character.only = TRUE)) {
- install.packages(p)
- require(p,character.only = TRUE)}
-}
-# #Setting Save path
-
-
-#load "comland" data - These data are unavailble due to PII concerns.
-#See aggregated data load below
-ecosys2<-subset(comland, US=='TRUE' & YEAR>=1964 & SPPVALUE >=0)
-
-#Load species and PDT codes
-load(file.path(data.dir, "Species_codes.RData"))
-
-#Set EPU
-epu <- "GB"
-
-#processing
-spp<-subset(spp, NESPP3>0)
-spp2<-unique(spp[,c(3,12)], by='NESPP3')
-spp2<-spp2[which(!duplicated(spp2$NESPP3)),]
-sp_combine<-merge(ecosys2, spp2, by="NESPP3", all.x=TRUE)
-add.apex <- data.table(NESPP3 = 000, YEAR = 1971, QY = 1, GEAR = 'other',
- SIZE = 'small', EPU = epu, UTILCD = 0, SPPLIVMT = 0,
- SPPVALUE = 0, US = TRUE, Feeding.guild = 'Apex Predator')
-sp_combine <- rbindlist(list(sp_combine, add.apex))
-
-#Subset data into Georges Bank group
-LANDINGS<-subset(sp_combine)
-LANDINGS<-LANDINGS[which(!is.na(LANDINGS$Feeding.guild)),]
-
-#Set Up data Table
-landsum<-data.table(LANDINGS)
-# setkey(landsum, "EPU", "YEAR","Feeding.guild")
-setkey(landsum,"EPU","YEAR","Feeding.guild")
-
-
-#Sum by feeding guild
-landsum[,lapply(.SD, sum, na.rm=TRUE), by=key(landsum), .SDcols=c("SPPLIVMT","SPPVALUE")]
-
-# ```
\ No newline at end of file
+### bennet_extraction
+
+# ```{r, echo = T, eval = F, warning=F, message=F}
+#This code is used to load and process comland data.
+#See comland methods for source data (CFDBS) processing methods.
+
+drake::readd(proc_get_mass_inshore_survey.R)
+
+#Packages
+PKG <- c(
+ "data.table",
+ "plyr",
+ "RColorBrewer",
+ "ggplot2",
+ "cowplot",
+ "gridExtra",
+ "grid"
+)
+for (p in PKG) {
+ if (!require(p, character.only = TRUE)) {
+ install.packages(p)
+ require(p, character.only = TRUE)
+ }
+}
+# #Setting Save path
+
+#load "comland" data - These data are unavailble due to PII concerns.
+#See aggregated data load below
+ecosys2 <- subset(comland, US == 'TRUE' & YEAR >= 1964 & SPPVALUE >= 0)
+
+#Load species and PDT codes
+load(file.path(data.dir, "Species_codes.RData"))
+
+#Set EPU
+epu <- "GB"
+
+#processing
+spp <- subset(spp, NESPP3 > 0)
+spp2 <- unique(spp[, c(3, 12)], by = 'NESPP3')
+spp2 <- spp2[which(!duplicated(spp2$NESPP3)), ]
+sp_combine <- merge(ecosys2, spp2, by = "NESPP3", all.x = TRUE)
+add.apex <- data.table(
+ NESPP3 = 000,
+ YEAR = 1971,
+ QY = 1,
+ GEAR = 'other',
+ SIZE = 'small',
+ EPU = epu,
+ UTILCD = 0,
+ SPPLIVMT = 0,
+ SPPVALUE = 0,
+ US = TRUE,
+ Feeding.guild = 'Apex Predator'
+)
+sp_combine <- rbindlist(list(sp_combine, add.apex))
+
+#Subset data into Georges Bank group
+LANDINGS <- subset(sp_combine)
+LANDINGS <- LANDINGS[which(!is.na(LANDINGS$Feeding.guild)), ]
+
+#Set Up data Table
+landsum <- data.table(LANDINGS)
+# setkey(landsum, "EPU", "YEAR","Feeding.guild")
+setkey(landsum, "EPU", "YEAR", "Feeding.guild")
+
+
+#Sum by feeding guild
+landsum[,
+ lapply(.SD, sum, na.rm = TRUE),
+ by = key(landsum),
+ .SDcols = c("SPPLIVMT", "SPPVALUE")
+]
+
+# ```
diff --git a/R/stored_scripts/catch_and_fleet_diversity_plotting.R b/R/stored_scripts/catch_and_fleet_diversity_plotting.R
index 6eaf11db..5d4adef6 100644
--- a/R/stored_scripts/catch_and_fleet_diversity_plotting.R
+++ b/R/stored_scripts/catch_and_fleet_diversity_plotting.R
@@ -1,27 +1,56 @@
-## Catch and Fleet Diversity plotting
-
-#```{r fleet-diversity, fig.cap="Fleet diversity (A) and fleet count (B) in the Mid Atlantic Bight.", echo=T, message=FALSE, warning=FALSE, fig.align="center", eval = T}
-
-# Relative working directories
-data.dir <- here::here("data")
-r.dir <- here::here("R")
-
-# Load data
-load(file.path(data.dir,"SOE_data_erddap.Rdata"))
-
-# Source plotting functions
-source(file.path(r.dir,"BasePlot_source.R"))
-
-opar <- par(mfrow = c(2, 1), mar = c(0, 0, 0, 0), oma = c(4, 6, 2, 6))
-
-soe.plot(SOE.data, "Time", "Mid-Atlantic average fleet diversity", stacked = "A",
- rel.y.num = 0.9, end.start = 2008, tol = 0.15, full.trend = F, cex.stacked = 1.5)
-soe.stacked.axis("Year", "Fleet diversity", y.line = 2.5, outer = F,
- rel.x.text = 1, rel.y.text = 1)
-soe.plot(SOE.data,"Time", "Mid-Atlantic fleet count", stacked = "B",
- rel.y.num = 0.9, end.start = 2008, full.trend = F, cex.stacked = 1.5)
-
-soe.stacked.axis("Year", "Fleet count", y.line = 2.5, outer = F,
- rel.x.text = 1, rel.y.text = 0.95)
-
-#```
\ No newline at end of file
+## Catch and Fleet Diversity plotting
+
+#```{r fleet-diversity, fig.cap="Fleet diversity (A) and fleet count (B) in the Mid Atlantic Bight.", echo=T, message=FALSE, warning=FALSE, fig.align="center", eval = T}
+
+# Relative working directories
+data.dir <- here::here("data")
+r.dir <- here::here("R")
+
+# Load data
+load(file.path(data.dir, "SOE_data_erddap.Rdata"))
+
+# Source plotting functions
+source(file.path(r.dir, "BasePlot_source.R"))
+
+opar <- par(mfrow = c(2, 1), mar = c(0, 0, 0, 0), oma = c(4, 6, 2, 6))
+
+soe.plot(
+ SOE.data,
+ "Time",
+ "Mid-Atlantic average fleet diversity",
+ stacked = "A",
+ rel.y.num = 0.9,
+ end.start = 2008,
+ tol = 0.15,
+ full.trend = F,
+ cex.stacked = 1.5
+)
+soe.stacked.axis(
+ "Year",
+ "Fleet diversity",
+ y.line = 2.5,
+ outer = F,
+ rel.x.text = 1,
+ rel.y.text = 1
+)
+soe.plot(
+ SOE.data,
+ "Time",
+ "Mid-Atlantic fleet count",
+ stacked = "B",
+ rel.y.num = 0.9,
+ end.start = 2008,
+ full.trend = F,
+ cex.stacked = 1.5
+)
+
+soe.stacked.axis(
+ "Year",
+ "Fleet count",
+ y.line = 2.5,
+ outer = F,
+ rel.x.text = 1,
+ rel.y.text = 0.95
+)
+
+#```
diff --git a/R/stored_scripts/comm_rel_vuln_plotting.R b/R/stored_scripts/comm_rel_vuln_plotting.R
index d8118bcd..05b200c0 100644
--- a/R/stored_scripts/comm_rel_vuln_plotting.R
+++ b/R/stored_scripts/comm_rel_vuln_plotting.R
@@ -1,59 +1,77 @@
-## Community reliance vulnerability plotting
-
-#```{r map1, echo = T, eval=T, fig.cap="Commercial engagement (total pounds landed, value landed, commercial permits and commercial dealers in a community) and reliance (per capita engagement) based on 2016 landings and the ACS running average of 2012-2016 census data.", fig.width = 8, fig.height = 5.4, fig.align='center', fig.show='hold', message=F, warning=F}
-xmin = -78
-xmax = -70
-ymin = 35
-ymax = 42
-xlims <- c(xmin, xmax)
-ylims <- c(ymin, ymax)
-
-biv_col <- c("4" = "#ca0020", "3" = "#f4a582", "2" = "grey", "1" = "#92c5de", "0" = "#0571b0")
-
-eng_rel <- ecodata::eng_rel %>%
- filter(PRIMARY_LATITUDE < 42) %>%
- dplyr::rename(comeng = ComEng_NE16_ct,
- comrel = ComRel_NE16_ct,
- receng = RecEng_NE16_ct,
- recrel = RecRel_NE16_ct,
- Latitude = PRIMARY_LATITUDE,
- Longitude = PRIMARY_LONGITUDE,
- State = STATEABBR) %>%
- mutate(comsum = sum(as.numeric(comeng), as.numeric(comrel))) %>%
- mutate(comeng = factor(comeng, ordered = TRUE, levels = 1:4),
- comrel = factor(comrel, ordered = TRUE, levels = 1:4),
- receng = factor(receng, ordered = TRUE, levels = 1:4),
- recrel = factor(recrel, ordered = TRUE, levels = 1:4))
-
-
-
-(com <- eng_rel %>%
- dplyr::select(comeng, comrel, comsum, Latitude, Longitude) %>%
- filter(comeng != 0 &
- comrel != 0) %>%
- ggplot() +
- geom_sf(data = coast, size = map.lwd) +
- geom_sf(data = ne_states, size = map.lwd) +
- coord_sf(crs = crs, xlim = xlims, ylim = ylims) +
- geom_point(aes(x = Longitude, y = Latitude,
- fill = comeng, size = comrel),
- color = "black",pch = 21) +
- guides(fill = guide_legend(override.aes = list(size = 5),
- reverse = T,
- title = "Engagement"),
- size = guide_legend(reverse = T,
- title = "Reliance")) +
- scale_fill_manual(values = biv_col) +
- theme_map() +
- xlab("Longitude") +
- ylab("Latitude") +
- theme(legend.position = c(0.8, 0.25),
- legend.box = "horizontal",
- legend.direction = "vertical",
- legend.key=element_blank(),
- legend.key.width = unit(0, "cm"))+
- ggtitle("Commercial Reliance & Engagement"))
-
-# com + rec + plot_layout(ncol = 2) &
-# theme(plot.margin = unit(c(0, 0, 0, 0), "cm"))
-#```
\ No newline at end of file
+## Community reliance vulnerability plotting
+
+#```{r map1, echo = T, eval=T, fig.cap="Commercial engagement (total pounds landed, value landed, commercial permits and commercial dealers in a community) and reliance (per capita engagement) based on 2016 landings and the ACS running average of 2012-2016 census data.", fig.width = 8, fig.height = 5.4, fig.align='center', fig.show='hold', message=F, warning=F}
+xmin <- -78
+xmax <- -70
+ymin <- 35
+ymax <- 42
+xlims <- c(xmin, xmax)
+ylims <- c(ymin, ymax)
+
+biv_col <- c(
+ "4" = "#ca0020",
+ "3" = "#f4a582",
+ "2" = "grey",
+ "1" = "#92c5de",
+ "0" = "#0571b0"
+)
+
+eng_rel <- ecodata::eng_rel %>%
+ filter(PRIMARY_LATITUDE < 42) %>%
+ dplyr::rename(
+ comeng = ComEng_NE16_ct,
+ comrel = ComRel_NE16_ct,
+ receng = RecEng_NE16_ct,
+ recrel = RecRel_NE16_ct,
+ Latitude = PRIMARY_LATITUDE,
+ Longitude = PRIMARY_LONGITUDE,
+ State = STATEABBR
+ ) %>%
+ mutate(comsum = sum(as.numeric(comeng), as.numeric(comrel))) %>%
+ mutate(
+ comeng = factor(comeng, ordered = TRUE, levels = 1:4),
+ comrel = factor(comrel, ordered = TRUE, levels = 1:4),
+ receng = factor(receng, ordered = TRUE, levels = 1:4),
+ recrel = factor(recrel, ordered = TRUE, levels = 1:4)
+ )
+
+
+(com <- eng_rel %>%
+ dplyr::select(comeng, comrel, comsum, Latitude, Longitude) %>%
+ filter(
+ comeng != 0 &
+ comrel != 0
+ ) %>%
+ ggplot() +
+ geom_sf(data = coast, size = map.lwd) +
+ geom_sf(data = ne_states, size = map.lwd) +
+ coord_sf(crs = crs, xlim = xlims, ylim = ylims) +
+ geom_point(
+ aes(x = Longitude, y = Latitude, fill = comeng, size = comrel),
+ color = "black",
+ pch = 21
+ ) +
+ guides(
+ fill = guide_legend(
+ override.aes = list(size = 5),
+ reverse = T,
+ title = "Engagement"
+ ),
+ size = guide_legend(reverse = T, title = "Reliance")
+ ) +
+ scale_fill_manual(values = biv_col) +
+ theme_map() +
+ xlab("Longitude") +
+ ylab("Latitude") +
+ theme(
+ legend.position = c(0.8, 0.25),
+ legend.box = "horizontal",
+ legend.direction = "vertical",
+ legend.key = element_blank(),
+ legend.key.width = unit(0, "cm")
+ ) +
+ ggtitle("Commercial Reliance & Engagement"))
+
+# com + rec + plot_layout(ncol = 2) &
+# theme(plot.margin = unit(c(0, 0, 0, 0), "cm"))
+#```
diff --git a/R/stored_scripts/erddap_query_and_build_code.R b/R/stored_scripts/erddap_query_and_build_code.R
index 5c59217e..18ebe938 100644
--- a/R/stored_scripts/erddap_query_and_build_code.R
+++ b/R/stored_scripts/erddap_query_and_build_code.R
@@ -1,51 +1,52 @@
-# ERDDAP Query and build
-
-#```{r query, echo = T, eval = F, message=F, warning=F}
-
-build_latest <- FALSE
-
-if (build_latest){
-
- # Relative working directories
- data.dir <- here::here('data')
- r.dir <- here::here('R')
-
- #Source function for querying ERDDAP server
- source(file.path(r.dir,"get_erddap.R"))
-
- #Set URL for COMET (server where NEFSC ERDDAP lives)
- comet <- 'https://comet.nefsc.noaa.gov/erddap/'
-
- #List datasets on the NEFSC ERDDAP
- tab_list <- ed_datasets(url = comet)
-
- #Get updated data set IDs
- erddap_datasets <- tab_list %>%
- filter(str_detect(Dataset.ID, "soe_v")) %>%
- get_erddap(id = NULL)
-
- #Save and clean updated IDs for use in rest of report
- save(erddap_datasets, file = file.path(data.dir, "ERDDAP_datasets.Rdata"))
-
- # Exclude stock assessment status data, which have unique structure
- erddap_datasets <- erddap_datasets %>%
- dplyr::filter(!str_detect(Dataset.ID, "assess"))
-
- #Create SOE parent data set, filter out NAs. This queries based on
- #data set IDs that were collected above
- SOE.data.erd <- sprintf("http://comet.nefsc.noaa.gov/erddap/tabledap/%s.csv",
- erddap_datasets$Dataset.ID) %>%
- purrr::map(function(x) {
- readr::read_csv(url(x))
- }) %>%
- do.call(rbind,.) %>%
- mutate(Value = as.numeric(Value)) %>%
- dplyr::filter(!is.na(Value))
-
- #Convert to data.table
- SOE.data <- as.data.table(SOE.data.erd)
-
- #Save data
- save(SOE.data, file = file.path(data.dir,"SOE_data_erddap.Rdata"))
-}
-#```
\ No newline at end of file
+# ERDDAP Query and build
+
+#```{r query, echo = T, eval = F, message=F, warning=F}
+
+build_latest <- FALSE
+
+if (build_latest) {
+ # Relative working directories
+ data.dir <- here::here('data')
+ r.dir <- here::here('R')
+
+ #Source function for querying ERDDAP server
+ source(file.path(r.dir, "get_erddap.R"))
+
+ #Set URL for COMET (server where NEFSC ERDDAP lives)
+ comet <- 'https://comet.nefsc.noaa.gov/erddap/'
+
+ #List datasets on the NEFSC ERDDAP
+ tab_list <- ed_datasets(url = comet)
+
+ #Get updated data set IDs
+ erddap_datasets <- tab_list %>%
+ filter(str_detect(Dataset.ID, "soe_v")) %>%
+ get_erddap(id = NULL)
+
+ #Save and clean updated IDs for use in rest of report
+ save(erddap_datasets, file = file.path(data.dir, "ERDDAP_datasets.Rdata"))
+
+ # Exclude stock assessment status data, which have unique structure
+ erddap_datasets <- erddap_datasets %>%
+ dplyr::filter(!str_detect(Dataset.ID, "assess"))
+
+ #Create SOE parent data set, filter out NAs. This queries based on
+ #data set IDs that were collected above
+ SOE.data.erd <- sprintf(
+ "http://comet.nefsc.noaa.gov/erddap/tabledap/%s.csv",
+ erddap_datasets$Dataset.ID
+ ) %>%
+ purrr::map(function(x) {
+ readr::read_csv(url(x))
+ }) %>%
+ do.call(rbind, .) %>%
+ mutate(Value = as.numeric(Value)) %>%
+ dplyr::filter(!is.na(Value))
+
+ #Convert to data.table
+ SOE.data <- as.data.table(SOE.data.erd)
+
+ #Save data
+ save(SOE.data, file = file.path(data.dir, "SOE_data_erddap.Rdata"))
+}
+#```
diff --git a/R/stored_scripts/hms_landings_plotting.R b/R/stored_scripts/hms_landings_plotting.R
index 49e16a65..7cc97228 100644
--- a/R/stored_scripts/hms_landings_plotting.R
+++ b/R/stored_scripts/hms_landings_plotting.R
@@ -1,57 +1,71 @@
#```{r , fig.cap = " HMS landings from 2016-2018 broken out by group (sharks, tunas or swordfish.", fig.align="center", eval=T, echo=F}
-apex<-ecodata::hms_landings %>%
- dplyr::filter(stringr::str_detect(Var, "Weight")) %>%
+apex <- ecodata::hms_landings %>%
+ dplyr::filter(stringr::str_detect(Var, "Weight")) %>%
tidyr::separate(., Var, "Var", "_")
-apex$sp.group <- ifelse(grepl("Shark", apex$Var, ignore.case = T), "shark",
- ifelse(grepl("TUNA", apex$Var, ignore.case = T), "tuna", "swordfish"))
-
-apex<-apex %>%
- dplyr::group_by(sp.group, Region, Time) %>%
- dplyr::summarise(Value = sum(Value)) %>%
- dplyr::mutate(Units = c("metric tons"),
- feeding.guild = factor(c("Apex Predator")),
- Value = (Value/2024.6)) %>%
- dplyr::rename(EPU = Region,
- Var = sp.group) %>%
+apex$sp.group <- ifelse(
+ grepl("Shark", apex$Var, ignore.case = T),
+ "shark",
+ ifelse(grepl("TUNA", apex$Var, ignore.case = T), "tuna", "swordfish")
+)
+
+apex <- apex %>%
+ dplyr::group_by(sp.group, Region, Time) %>%
+ dplyr::summarise(Value = sum(Value)) %>%
+ dplyr::mutate(
+ Units = c("metric tons"),
+ feeding.guild = factor(c("Apex Predator")),
+ Value = (Value / 2024.6)
+ ) %>%
+ dplyr::rename(EPU = Region, Var = sp.group) %>%
dplyr::mutate(grouping = factor(c("total")))
#Define constants for figure plot
-series.col <- c("indianred","black")
+series.col <- c("indianred", "black")
##Plot
-apex %>%
- dplyr::filter(EPU == "MA") %>%
- dplyr::group_by(Var) %>%
- dplyr::mutate(hline = mean(Value)) %>%
+apex %>%
+ dplyr::filter(EPU == "MA") %>%
+ dplyr::group_by(Var) %>%
+ dplyr::mutate(hline = mean(Value)) %>%
ggplot(aes(x = Time, y = Value, color = Var)) +
-
+
#Add time series
geom_line(size = lwd) +
geom_point(size = pcex) +
- stat_summary(fun.y = sum, color = "black", geom = "line")+
+ stat_summary(fun.y = sum, color = "black", geom = "line") +
#scale_color_manual(values = series.col, aesthetics = "color")+
#guides(color = FALSE) +
- geom_hline(aes(yintercept = hline,
- color = Var,
- size = Var),
- size = hline.size,
- alpha = hline.alpha,
- linetype = hline.lty)+
+ geom_hline(
+ aes(yintercept = hline, color = Var, size = Var),
+ size = hline.size,
+ alpha = hline.alpha,
+ linetype = hline.lty
+ ) +
#Highlight last ten years
- annotate("rect", fill = shade.fill, alpha = shade.alpha,
- xmin = x.shade.min , xmax = x.shade.max,
- ymin = -Inf, ymax = Inf) +
+ annotate(
+ "rect",
+ fill = shade.fill,
+ alpha = shade.alpha,
+ xmin = x.shade.min,
+ xmax = x.shade.max,
+ ymin = -Inf,
+ ymax = Inf
+ ) +
#Axis and theme
- scale_y_continuous(labels = function(l){trans = l / 1000})+
+ scale_y_continuous(labels = function(l) {
+ trans <- l / 1000
+ }) +
scale_x_continuous(breaks = seq(1985, 2015, by = 5), limits = c(1985, 2018)) +
theme_facet() +
- theme(strip.text=element_text(hjust=0),
- legend.position = c(0.4, 0.7),
- legend.direction = "horizontal",
- legend.title = element_blank())+
+ theme(
+ strip.text = element_text(hjust = 0),
+ legend.position = c(0.4, 0.7),
+ legend.direction = "horizontal",
+ legend.title = element_blank()
+ ) +
ylab("")
#```
diff --git a/R/stored_scripts/hp_indicator_plotting.R b/R/stored_scripts/hp_indicator_plotting.R
index 6d157376..cd549a8b 100644
--- a/R/stored_scripts/hp_indicator_plotting.R
+++ b/R/stored_scripts/hp_indicator_plotting.R
@@ -1,40 +1,69 @@
-### Harbor Porpoise Plotting
-
-#```{r harbor-porpoise, fig.cap="Harbor porpoise bycatch estimated shown with
-#Potential Biological Removal (red) and confidence intervals (orange).",
-#echo = T, message=F, warning=F, fig.pos='H', fig.height=4}
-
-# Relative working directories
-data.dir <- here::here('data')
-r.dir <- here::here('R')
-
-# Load data
-load(file.path(data.dir,"SOE_data_erddap.Rdata"))
-
-# Source plotting functions
-source(file.path(r.dir,"BasePlot_source.R"))
-
-
-opar <- par(mar = c(4, 6, 2, 6))
-
-soe.plot(SOE.data, 'Time', "Harbor porpoise bycatch estimates",
- rel.y.num = 1.2, end.start = 2007, full.trend = F, point.cex = 1,
- ymax = F, y.upper = 2500, mean_line = F, x.label = 'Year',
- y.label = 'Bycatch, n', rel.y.text = 1)
-
-legend(2000, 2250, legend = "Potential Biological Removal",
- col = adjustcolor("red", .5), lwd = 3,
- bty = "n", cex = 0.9)
-
-#credible intervals and PBI
-lw_CI <- SOE.data[Var == 'Harbor porpoise bycatch 2.5 CI',
- list(Time, Value)]
-up_CI <- SOE.data[Var == 'Harbor porpoise bycatch 97.5 CI',
- list(Time, Value)]
-pbi <- SOE.data[Var == 'Harbor porpoise potential biological removal',
- list(Time, Value)]
-
-points(pbi, type = "l", lty = 1, col = adjustcolor("red", .5), lwd = 3)
-points(lw_CI, type = "l", lty = 2, col = adjustcolor("darkorange", .9), lwd = 2.5)
-points(up_CI, type = "l", lty = 2, col = adjustcolor("darkorange", .9), lwd = 2.5)
-#```
\ No newline at end of file
+### Harbor Porpoise Plotting
+
+#```{r harbor-porpoise, fig.cap="Harbor porpoise bycatch estimated shown with
+#Potential Biological Removal (red) and confidence intervals (orange).",
+#echo = T, message=F, warning=F, fig.pos='H', fig.height=4}
+
+# Relative working directories
+data.dir <- here::here('data')
+r.dir <- here::here('R')
+
+# Load data
+load(file.path(data.dir, "SOE_data_erddap.Rdata"))
+
+# Source plotting functions
+source(file.path(r.dir, "BasePlot_source.R"))
+
+
+opar <- par(mar = c(4, 6, 2, 6))
+
+soe.plot(
+ SOE.data,
+ 'Time',
+ "Harbor porpoise bycatch estimates",
+ rel.y.num = 1.2,
+ end.start = 2007,
+ full.trend = F,
+ point.cex = 1,
+ ymax = F,
+ y.upper = 2500,
+ mean_line = F,
+ x.label = 'Year',
+ y.label = 'Bycatch, n',
+ rel.y.text = 1
+)
+
+legend(
+ 2000,
+ 2250,
+ legend = "Potential Biological Removal",
+ col = adjustcolor("red", .5),
+ lwd = 3,
+ bty = "n",
+ cex = 0.9
+)
+
+#credible intervals and PBI
+lw_CI <- SOE.data[Var == 'Harbor porpoise bycatch 2.5 CI', list(Time, Value)]
+up_CI <- SOE.data[Var == 'Harbor porpoise bycatch 97.5 CI', list(Time, Value)]
+pbi <- SOE.data[
+ Var == 'Harbor porpoise potential biological removal',
+ list(Time, Value)
+]
+
+points(pbi, type = "l", lty = 1, col = adjustcolor("red", .5), lwd = 3)
+points(
+ lw_CI,
+ type = "l",
+ lty = 2,
+ col = adjustcolor("darkorange", .9),
+ lwd = 2.5
+)
+points(
+ up_CI,
+ type = "l",
+ lty = 2,
+ col = adjustcolor("darkorange", .9),
+ lwd = 2.5
+)
+#```
diff --git a/R/stored_scripts/ich_div_plotting.R b/R/stored_scripts/ich_div_plotting.R
index 27d8fc72..4f2cfeb8 100644
--- a/R/stored_scripts/ich_div_plotting.R
+++ b/R/stored_scripts/ich_div_plotting.R
@@ -1,26 +1,40 @@
-## Ich Div Plotting
-
-#```{r larval-diversity, fig.cap="Ichthyoplankton Shannon diversity in the spring (A) and fall (B) in the Northeast Large Marine Ecosystem.",echo = T, fig.show='hold', fig.align='default', warning = F, message = F,fig.pos='H'}
-# Relative working directories
-data.dir <- here::here('data')
-r.dir <- here::here('R')
-
-# Load data
-load(file.path(data.dir,"SOE_data_erddap.Rdata"))
-
-# Source plotting functions
-source(file.path(r.dir,"BasePlot_source.R"))
-
-
-opar <- par(mfrow = c(2, 1), mar = c(0, 0, 0, 0), oma = c(3.5, 5, 2, 4))
-
-soe.plot(SOE.data, "Time", "Spring_Ich_Shannon Diversity Index", stacked = "A",
- rel.y.num = 1.1, end.start = 2007, full.trend = F,
- cex.stacked = 1.5)
-soe.plot(SOE.data, "Time", "Fall_Ich_Shannon Diversity Index", stacked = "B",
- rel.y.num = 1.1, end.start = 2007, full.trend = F,
- cex.stacked = 1.5)
-
-soe.stacked.axis("Year", "Shannon Index", y.line = 2.5)
-
-#```
\ No newline at end of file
+## Ich Div Plotting
+
+#```{r larval-diversity, fig.cap="Ichthyoplankton Shannon diversity in the spring (A) and fall (B) in the Northeast Large Marine Ecosystem.",echo = T, fig.show='hold', fig.align='default', warning = F, message = F,fig.pos='H'}
+# Relative working directories
+data.dir <- here::here('data')
+r.dir <- here::here('R')
+
+# Load data
+load(file.path(data.dir, "SOE_data_erddap.Rdata"))
+
+# Source plotting functions
+source(file.path(r.dir, "BasePlot_source.R"))
+
+
+opar <- par(mfrow = c(2, 1), mar = c(0, 0, 0, 0), oma = c(3.5, 5, 2, 4))
+
+soe.plot(
+ SOE.data,
+ "Time",
+ "Spring_Ich_Shannon Diversity Index",
+ stacked = "A",
+ rel.y.num = 1.1,
+ end.start = 2007,
+ full.trend = F,
+ cex.stacked = 1.5
+)
+soe.plot(
+ SOE.data,
+ "Time",
+ "Fall_Ich_Shannon Diversity Index",
+ stacked = "B",
+ rel.y.num = 1.1,
+ end.start = 2007,
+ full.trend = F,
+ cex.stacked = 1.5
+)
+
+soe.stacked.axis("Year", "Shannon Index", y.line = 2.5)
+
+#```
diff --git a/R/stored_scripts/inshore_survey_analysis.R b/R/stored_scripts/inshore_survey_analysis.R
index da707dfa..efc4e90a 100644
--- a/R/stored_scripts/inshore_survey_analysis.R
+++ b/R/stored_scripts/inshore_survey_analysis.R
@@ -1,148 +1,184 @@
-# inshore survey analysis
-
-
-#```{r, eval = F, include = T, echo = T}
-#SOE Mass State data
-##SML
-
-#User parameters
-if(Sys.info()['sysname'] == "Windows"){
- data.dir <- 'L:\\EcoAP\\Data\\survey'
- out.dir <- 'L:\\EcoAP\\Data\\SOE'
- gis.dir <- 'L:\\Rworkspace\\GIS_files'
-}
-if(Sys.info()['sysname'] == "Linux"){
- data.dir <- '/home/slucey/slucey/EcoAP/Data/survey'
- out.dir <- '/home/slucey/slucey/EcoAP/Data/SOE'
- gis.dir <- '/home/slucey/slucey/Rworkspace/GIS_files'
-}
-
-#-------------------------------------------------------------------------------
-#Required packages
-library(data.table); library(rgdal); library(Survdat)
-
-#-------------------------------------------------------------------------------
-#User created functions
-
-
-#-------------------------------------------------------------------------------
-load(file.path(data.dir, 'Survdat_Mass.RData'))
-load(file.path(data.dir, 'SOE_species_list.RData'))
-
-#Grab strata
-strata <- readOGR(gis.dir, 'RA_STRATA_POLY_MC')
-
-#Generate area table
-strat.area <- getarea(strata, 'stratum')
-
-#Fix strata code to match data
-strat.area[, STRATUM := as.numeric(paste0(9, stratum, 0))]
-
-#Subset by season/ strata set
-fall <- survdat.mass[SEASON == 'FALL', ]
-spring <- survdat.mass[SEASON == 'SPRING', ]
-
-#Run stratification prep
-fall.prep <- stratprep(fall, strat.area, strat.col = 'STRATUM', area.col = 'Area')
-spring.prep <- stratprep(spring, strat.area, strat.col = 'STRATUM', area.col = 'Area')
-
-#Calculate mean weight/tow by aggregate groups
-#n tows
-n.tows.fall <- unique(fall.prep[, list(YEAR, EPU, ntows)])
-n.tow.spring <- unique(spring.prep[, list(YEAR, EPU, ntows)])
-
-#drop length data
-setkey(fall.prep, YEAR, EPU, STATION, STRATUM, SVSPP, CATCHSEX)
-fall.prep <- unique(fall.prep, by = key(fall.prep))
-fall.prep[, c('LENGTH', 'NUMLEN') := NULL]
-
-setkey(spring.prep, YEAR, EPU, STATION, STRATUM, SVSPP, CATCHSEX)
-spring.prep <- unique(spring.prep, by = key(spring.prep))
-spring.prep[, c('LENGTH', 'NUMLEN') := NULL]
-
-#Merge Sexed species
-setkey(fall.prep, YEAR, EPU, STATION, STRATUM, SVSPP)
-fall.prep <- fall.prep[, sum(BIOMASS, na.rm = T), by = key(fall.prep)]
-
-setkey(spring.prep, YEAR, EPU, STATION, STRATUM, SVSPP)
-spring.prep <- spring.prep[, sum(BIOMASS, na.rm = T), by = key(spring.prep)]
-
-#Sum biomass within an EPU
-fall.sum <- fall.prep[, sum(V1), by = c('YEAR', 'EPU', 'SVSPP')]
-spring.sum <- spring.prep[, sum(V1), by = c('YEAR', 'EPU', 'SVSPP')]
-
-#Merge sum with station count
-fall.sum <- merge(fall.sum, n.tows.fall, by = c('YEAR', 'EPU'))
-spring.sum <- merge(spring.sum, n.tows.fall, by = c('YEAR', 'EPU'))
-
-#Calculate mean weight per tow
-fall.sum[, kg.per.tow := V1 / ntows]
-fall.mean <- fall.sum[, list(YEAR, EPU, SVSPP, kg.per.tow)]
-
-spring.sum[, kg.per.tow := V1 / ntows]
-spring.mean <- spring.sum[, list(YEAR, EPU, SVSPP, kg.per.tow)]
-
-#Aggregate by EBFM codes
-fall <- merge(fall.mean, unique(species[, list(SVSPP, SOE.18, Fed.Managed)]),
- by = 'SVSPP', all.x = T)
-spring <- merge(spring.mean, unique(species[, list(SVSPP, SOE.18, Fed.Managed)]),
- by = 'SVSPP', all.x = T)
-
-#Fix NA group to other
-fall[ is.na(SOE.18), SOE.18 := 'Other']
-spring[is.na(SOE.18), SOE.18 := 'Other']
-
-#Sum by feeding guild and managed species
-fall.agg <- fall[, sum(kg.per.tow), by = c('YEAR', 'EPU', 'SOE.18', 'Fed.Managed')]
-spring.agg <- spring[, sum(kg.per.tow), by = c('YEAR', 'EPU', 'SOE.18', 'Fed.Managed')]
-
-#Total
-fall.agg[, Total := sum(V1), by = c('YEAR', 'EPU', 'SOE.18')]
-fall.agg[, Prop.managed := V1 / Total]
-
-spring.agg[, Total := sum(V1), by = c('YEAR', 'EPU', 'SOE.18')]
-spring.agg[, Prop.managed := V1 / Total]
-
-#Get in correct long format for SOE
-#By feeding guild
-fall.tot <- copy(fall.agg)
-fall.tot[, Var := paste(SOE.18, 'Fall Biomass Index')]
-setnames(fall.tot, c('YEAR', 'EPU', 'Total'), c('Time', 'Region', 'Value'))
-fall.tot[, c('SOE.18', 'V1', 'Prop.managed', 'Fed.Managed') := NULL]
-fall.tot[, Units := 'kg tow^-1']
-fall.tot[, Source := 'NEFSC bottom trawl survey (survdat)']
-setcolorder(fall.tot, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
-fall.tot <- unique(fall.tot)
-
-spring.tot <- copy(spring.agg)
-spring.tot[, Var := paste(SOE.18, 'Spring Biomass Index')]
-setnames(spring.tot, c('YEAR', 'EPU', 'Total'), c('Time', 'Region', 'Value'))
-spring.tot[, c('SOE.18', 'V1', 'Prop.managed', 'Fed.Managed') := NULL]
-spring.tot[, Units := 'kg tow^-1']
-spring.tot[, Source := 'NEFSC bottom trawl survey (survdat)']
-setcolorder(spring.tot, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
-spring.tot <- unique(spring.tot)
-
-#Proportion managed
-fall.prop <- copy(fall.agg)
-fall.prop[is.na(Fed.Managed), Fed.Managed := 'Non']
-fall.prop[, Var := paste(SOE.18, Fed.Managed, 'managed species - Fall Biomass Index')]
-setnames(fall.prop, c('YEAR', 'EPU', 'Prop.managed'), c('Time', 'Region', 'Value'))
-fall.prop[, c('SOE.18', 'V1', 'Total', 'Fed.Managed') := NULL]
-fall.prop[, Units := 'proportion']
-fall.prop[, Source := 'NEFSC bottom trawl survey (survdat)']
-setcolorder(fall.prop, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
-
-spring.prop <- copy(spring.agg)
-spring.prop[is.na(Fed.Managed), Fed.Managed := 'Non']
-spring.prop[, Var := paste(SOE.18, Fed.Managed, 'managed species - Spring Biomass Index')]
-setnames(spring.prop, c('YEAR', 'EPU', 'Prop.managed'), c('Time', 'Region', 'Value'))
-spring.prop[, c('SOE.18', 'V1', 'Total', 'Fed.Managed') := NULL]
-spring.prop[, Units := 'proportion']
-spring.prop[, Source := 'NEFSC bottom trawl survey (survdat)']
-setcolorder(spring.prop, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
-
-#Merge into one data set
-survey <- rbindlist(list(fall.tot, spring.tot, fall.prop, spring.prop))
-save(survey, file = file.path(out.dir, 'Aggregate_Survey_biomass_19.RData'))
-#```
\ No newline at end of file
+# inshore survey analysis
+
+#```{r, eval = F, include = T, echo = T}
+#SOE Mass State data
+##SML
+
+#User parameters
+if (Sys.info()['sysname'] == "Windows") {
+ data.dir <- 'L:\\EcoAP\\Data\\survey'
+ out.dir <- 'L:\\EcoAP\\Data\\SOE'
+ gis.dir <- 'L:\\Rworkspace\\GIS_files'
+}
+if (Sys.info()['sysname'] == "Linux") {
+ data.dir <- '/home/slucey/slucey/EcoAP/Data/survey'
+ out.dir <- '/home/slucey/slucey/EcoAP/Data/SOE'
+ gis.dir <- '/home/slucey/slucey/Rworkspace/GIS_files'
+}
+
+#-------------------------------------------------------------------------------
+#Required packages
+library(data.table)
+library(rgdal)
+library(Survdat)
+
+#-------------------------------------------------------------------------------
+#User created functions
+
+#-------------------------------------------------------------------------------
+load(file.path(data.dir, 'Survdat_Mass.RData'))
+load(file.path(data.dir, 'SOE_species_list.RData'))
+
+#Grab strata
+strata <- readOGR(gis.dir, 'RA_STRATA_POLY_MC')
+
+#Generate area table
+strat.area <- getarea(strata, 'stratum')
+
+#Fix strata code to match data
+strat.area[, STRATUM := as.numeric(paste0(9, stratum, 0))]
+
+#Subset by season/ strata set
+fall <- survdat.mass[SEASON == 'FALL', ]
+spring <- survdat.mass[SEASON == 'SPRING', ]
+
+#Run stratification prep
+fall.prep <- stratprep(
+ fall,
+ strat.area,
+ strat.col = 'STRATUM',
+ area.col = 'Area'
+)
+spring.prep <- stratprep(
+ spring,
+ strat.area,
+ strat.col = 'STRATUM',
+ area.col = 'Area'
+)
+
+#Calculate mean weight/tow by aggregate groups
+#n tows
+n.tows.fall <- unique(fall.prep[, list(YEAR, EPU, ntows)])
+n.tow.spring <- unique(spring.prep[, list(YEAR, EPU, ntows)])
+
+#drop length data
+setkey(fall.prep, YEAR, EPU, STATION, STRATUM, SVSPP, CATCHSEX)
+fall.prep <- unique(fall.prep, by = key(fall.prep))
+fall.prep[, c('LENGTH', 'NUMLEN') := NULL]
+
+setkey(spring.prep, YEAR, EPU, STATION, STRATUM, SVSPP, CATCHSEX)
+spring.prep <- unique(spring.prep, by = key(spring.prep))
+spring.prep[, c('LENGTH', 'NUMLEN') := NULL]
+
+#Merge Sexed species
+setkey(fall.prep, YEAR, EPU, STATION, STRATUM, SVSPP)
+fall.prep <- fall.prep[, sum(BIOMASS, na.rm = T), by = key(fall.prep)]
+
+setkey(spring.prep, YEAR, EPU, STATION, STRATUM, SVSPP)
+spring.prep <- spring.prep[, sum(BIOMASS, na.rm = T), by = key(spring.prep)]
+
+#Sum biomass within an EPU
+fall.sum <- fall.prep[, sum(V1), by = c('YEAR', 'EPU', 'SVSPP')]
+spring.sum <- spring.prep[, sum(V1), by = c('YEAR', 'EPU', 'SVSPP')]
+
+#Merge sum with station count
+fall.sum <- merge(fall.sum, n.tows.fall, by = c('YEAR', 'EPU'))
+spring.sum <- merge(spring.sum, n.tows.fall, by = c('YEAR', 'EPU'))
+
+#Calculate mean weight per tow
+fall.sum[, kg.per.tow := V1 / ntows]
+fall.mean <- fall.sum[, list(YEAR, EPU, SVSPP, kg.per.tow)]
+
+spring.sum[, kg.per.tow := V1 / ntows]
+spring.mean <- spring.sum[, list(YEAR, EPU, SVSPP, kg.per.tow)]
+
+#Aggregate by EBFM codes
+fall <- merge(
+ fall.mean,
+ unique(species[, list(SVSPP, SOE.18, Fed.Managed)]),
+ by = 'SVSPP',
+ all.x = T
+)
+spring <- merge(
+ spring.mean,
+ unique(species[, list(SVSPP, SOE.18, Fed.Managed)]),
+ by = 'SVSPP',
+ all.x = T
+)
+
+#Fix NA group to other
+fall[is.na(SOE.18), SOE.18 := 'Other']
+spring[is.na(SOE.18), SOE.18 := 'Other']
+
+#Sum by feeding guild and managed species
+fall.agg <- fall[,
+ sum(kg.per.tow),
+ by = c('YEAR', 'EPU', 'SOE.18', 'Fed.Managed')
+]
+spring.agg <- spring[,
+ sum(kg.per.tow),
+ by = c('YEAR', 'EPU', 'SOE.18', 'Fed.Managed')
+]
+
+#Total
+fall.agg[, Total := sum(V1), by = c('YEAR', 'EPU', 'SOE.18')]
+fall.agg[, Prop.managed := V1 / Total]
+
+spring.agg[, Total := sum(V1), by = c('YEAR', 'EPU', 'SOE.18')]
+spring.agg[, Prop.managed := V1 / Total]
+
+#Get in correct long format for SOE
+#By feeding guild
+fall.tot <- copy(fall.agg)
+fall.tot[, Var := paste(SOE.18, 'Fall Biomass Index')]
+setnames(fall.tot, c('YEAR', 'EPU', 'Total'), c('Time', 'Region', 'Value'))
+fall.tot[, c('SOE.18', 'V1', 'Prop.managed', 'Fed.Managed') := NULL]
+fall.tot[, Units := 'kg tow^-1']
+fall.tot[, Source := 'NEFSC bottom trawl survey (survdat)']
+setcolorder(fall.tot, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
+fall.tot <- unique(fall.tot)
+
+spring.tot <- copy(spring.agg)
+spring.tot[, Var := paste(SOE.18, 'Spring Biomass Index')]
+setnames(spring.tot, c('YEAR', 'EPU', 'Total'), c('Time', 'Region', 'Value'))
+spring.tot[, c('SOE.18', 'V1', 'Prop.managed', 'Fed.Managed') := NULL]
+spring.tot[, Units := 'kg tow^-1']
+spring.tot[, Source := 'NEFSC bottom trawl survey (survdat)']
+setcolorder(spring.tot, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
+spring.tot <- unique(spring.tot)
+
+#Proportion managed
+fall.prop <- copy(fall.agg)
+fall.prop[is.na(Fed.Managed), Fed.Managed := 'Non']
+fall.prop[,
+ Var := paste(SOE.18, Fed.Managed, 'managed species - Fall Biomass Index')
+]
+setnames(
+ fall.prop,
+ c('YEAR', 'EPU', 'Prop.managed'),
+ c('Time', 'Region', 'Value')
+)
+fall.prop[, c('SOE.18', 'V1', 'Total', 'Fed.Managed') := NULL]
+fall.prop[, Units := 'proportion']
+fall.prop[, Source := 'NEFSC bottom trawl survey (survdat)']
+setcolorder(fall.prop, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
+
+spring.prop <- copy(spring.agg)
+spring.prop[is.na(Fed.Managed), Fed.Managed := 'Non']
+spring.prop[,
+ Var := paste(SOE.18, Fed.Managed, 'managed species - Spring Biomass Index')
+]
+setnames(
+ spring.prop,
+ c('YEAR', 'EPU', 'Prop.managed'),
+ c('Time', 'Region', 'Value')
+)
+spring.prop[, c('SOE.18', 'V1', 'Total', 'Fed.Managed') := NULL]
+spring.prop[, Units := 'proportion']
+spring.prop[, Source := 'NEFSC bottom trawl survey (survdat)']
+setcolorder(spring.prop, c('Time', 'Value', 'Var', 'Units', 'Region', 'Source'))
+
+#Merge into one data set
+survey <- rbindlist(list(fall.tot, spring.tot, fall.prop, spring.prop))
+save(survey, file = file.path(out.dir, 'Aggregate_Survey_biomass_19.RData'))
+#```
diff --git a/R/stored_scripts/landings_extraction.R b/R/stored_scripts/landings_extraction.R
index dd67420f..040308dd 100644
--- a/R/stored_scripts/landings_extraction.R
+++ b/R/stored_scripts/landings_extraction.R
@@ -1,2129 +1,2711 @@
-# comm landings extraction
-
-
-
-#```{r comland, echo = T, eval = F}
-#Comland.r
-#Version now controlled by git - originally part of comcatch.r
-#Grab commercial landings data from US and Foreign countries (NAFO)
-#Need to fix menhaden data
-#SML
-
-#Requires the following files:
-# data.dir.2\\Comland_skates_hakes.R
-# data.dir\\Menhaden.csv
-# data.dir.3\\SS_NAFO_21A.csv
-# data.dir.3\\species.txt
-
-#User parameters
-if(Sys.info()['sysname']=="Windows"){
- data.dir <- "L:\\EcoAP\\Data\\Commercial"
- data.dir.2 <- "L:\\Rworkspace\\RCom"
- data.dir.3 <- "L:\\EcoAP\\Data\\NAFO"
- out.dir <- "L:\\EcoAP\\Data\\Commercial"
- memory.limit(4000)
- channel <- odbcDriverConnect()
-}
-
-if(Sys.info()['sysname']=="Linux"){
- data.dir <- "/home/slucey/slucey/EcoAP/Data/Commercial"
- data.dir.2 <- "/home/slucey/slucey/Rworkspace/RCom"
- data.dir.3 <- "/home/slucey/slucey/EcoAP/Data/NAFO"
- out.dir <- "/home/slucey/slucey/EcoAP/Data/Commercial"
- uid <- 'slucey'
- cat("Oracle Password: ")
- pwd <- scan(stdin(), character(), n = 1)
-}
-
-landed <- 'y' #use landed weight for scallops and clams instead of live weight
-foreign <- 'y' #Mark foreign landings and keep seperate
-adjust.ppi <- 'y' #Adjust value for inflation
-use.existing <- 'n' #use raw data from a previous run - saves time
-sum.by <- 'EPU' #Variable to sum landings by [EPU, stat.area]
-
-#Final year of query
-endyear <- 2016
-#If adjusting for inflation
-refyear <- 2016
-refmonth <- 1
-
-#-------------------------------------------------------------------------------
-#Required packages
-library(RODBC); library(data.table); library(rgdal)
-
-#-------------------------------------------------------------------------------
-#User created functions
-#Convert NA's to zeros
-na.zero <- function(x){
- for(i in 1:length(x[1, ])){
- if(length(which(is.na(x[, i]))) > 0){
- x[which(is.na(x[, i])), i] <- 0}
- }
- return(x)
-}
-
-#-------------------------------------------------------------------------------
-#Connect to database
-if(Sys.info()['sysname'] == "Windows")channel <- odbcDriverConnect()
-if(Sys.info()['sysname'] == "Linux") channel <- odbcConnect('sole', uid, pwd)
-
-if(use.existing == 'n'){
- #Landings
- tables <- c(paste0('WOLANDS', 64:81),
- paste0('WODETS', 82:93),
- paste0('CFDETS', 1994:endyear, 'AA'))
-
- #Generate one table
- comland <- c()
- for(i in 1:length(tables)){
- landings.qry <- paste("select year, month, negear, toncl1, nespp3, nespp4, area,
- spplivlb, spplndlb, sppvalue, utilcd
- from", tables[i])
-
- comland.yr <- as.data.table(sqlQuery(channel, landings.qry))
-
- setkey(comland.yr,
- YEAR,
- MONTH,
- NEGEAR,
- TONCL1,
- NESPP3,
- NESPP4,
- AREA,
- UTILCD)
-
- if(landed == 'y') comland.yr[NESPP3 %in% 743:800, SPPLIVLB := SPPLNDLB]
-
- #Sum landings and value
- #landings
- comland.yr[, V1 := sum(SPPLIVLB), by = key(comland.yr)]
- #value
- #Fix null values
- comland.yr[is.na(SPPVALUE), SPPVALUE := 0]
- comland.yr[, V2 := sum(SPPVALUE), by = key(comland.yr)]
-
- #Remove extra rows/columns
- comland.yr <- unique(comland.yr, by = key(comland.yr))
- comland.yr[, c('SPPLIVLB', 'SPPLNDLB', 'SPPVALUE') := NULL]
-
- #Rename summed columns
- setnames(comland.yr, c('V1', 'V2'), c('SPPLIVLB', 'SPPVALUE'))
-
- comland <- rbindlist(list(comland, comland.yr))
- }
-
- if(landed == 'n') save(comland, file = file.path(out.dir, "comland_raw_US.RData"))
- #Last run 8/31/16
- if(landed == 'y') save(comland, file = file.path(out.dir, "comland_raw_US_meatwt.RData"))
- #Last run 1/25/18
-}
-if(use.existing == 'y'){
- if(landed == 'n') load(file = file.path(out.dir, "comland_raw_US.RData"))
- if(landed == 'y') load(file = file.path(out.dir, "comland_raw_US_meatwt.RData"))
-}
-
-#-------------------------------------------------------------------------------
-#Convert from lbs to metric tons
-comland[, SPPLIVMT := SPPLIVLB * 0.00045359237]
-comland[, SPPLIVLB := NULL]
-
-#fix years
-comland[YEAR < 100, YEAR := YEAR + 1900L]
-
-if(adjust.ppi == 'y'){
- #Adjust SPPVALUE for inflation
- temp <- tempfile()
- download.file("http://download.bls.gov/pub/time.series/wp/wp.data.3.ProcessedFoods", temp)
- inflate <- as.data.table(read.delim(temp))
- unlink(temp)
-
- inflate[, series_id := gsub(" ", "", inflate[, series_id])]
- deflate <- inflate[series_id == "WPU0223", ]
- deflate[, MONTH := as.numeric(substr(period, 2, 3))]
- setnames(deflate, c('year', 'value'), c('YEAR', 'PPI'))
- deflate <- deflate[, list(YEAR, MONTH, PPI)]
-
- #Set yearly deflator to 0 instead of 13 to match unknown month designation
- deflate[MONTH == 13, MONTH := 0]
- deflate.base <- deflate[YEAR == refyear & MONTH == refmonth, PPI]
-
- comland <- merge(comland, deflate, by = c('YEAR', 'MONTH'), all.x = T)
- comland[, SPPVALUE := round((SPPVALUE * deflate.base) / PPI)]
-
- #Remove extra column
- comland[, PPI := NULL]
-}
-#Remove market categories of parts
-comland <- comland[!NESPP4 %in% c(119, 123, 125, 127, 812, 819, 828, 829, 1731, 2351,
- 2690, 2699, 3472, as.numeric(paste(348:359, 8, sep = '')),
- 3868, as.numeric(paste(469:471, 4, sep = '')),
- as.numeric(paste(480:499, 8, sep ='')), 5018, 5039,
- 5261, 5265), ]
-
-#Generate NESPP3 and MKTCAT in comland data
-comland[NESPP4 < 100, MKTCAT := as.numeric(substring(NESPP4, 2, 2))]
-comland[NESPP4 > 99 & NESPP4 < 1000, MKTCAT := as.numeric(substring(NESPP4, 3, 3))]
-comland[NESPP4 > 999, MKTCAT := as.numeric(substring(NESPP4, 4, 4))]
-
-#drop NESPP4
-comland[, NESPP4 := NULL]
-
-#Deal with Hakes and Skates------------------------------------------------------------------
-source(file.path(data.dir.2, 'Comland_skates_hakes.R'))
-
-#get little skates and winter skates from skates(ns) - use survey in half years
-#Generate Half year variable in comland
-comland.skates <- comland[NESPP3 == 365, ]
-comland.skates[MONTH %in% 1:6, Half := 1]
-comland.skates[MONTH %in% 7:12, Half := 2]
-
-setkey(skate.hake.us,
- YEAR,
- Half,
- AREA)
-
-comland.skates <- merge(comland.skates, skate.hake.us, by = key(skate.hake.us), all.x = T)
-
-comland.skates[, little := little.per * SPPLIVMT]
-comland.skates[, little.value := round(little.per * SPPVALUE)]
-comland.skates[is.na(little), little := 0]
-comland.skates[is.na(little.value), little.value := 0]
-
-comland.skates[, winter := winter.per * SPPLIVMT]
-comland.skates[, winter.value := round(winter.per * SPPVALUE)]
-comland.skates[is.na(winter), winter := 0]
-comland.skates[is.na(winter.value), winter.value := 0]
-
-comland.skates[, other.skate := SPPLIVMT - (little + winter)]
-comland.skates[, other.skate.value := SPPVALUE - (little.value + winter.value)]
-
-#Little (366), winter (367), skates(ns) (365)
-#put skates in comland format to merge back
-little <- comland.skates[, list(YEAR, Half, AREA, MONTH, NEGEAR,
- TONCL1, NESPP3, UTILCD, MKTCAT, little,
- little.value)]
-little[, NESPP3 := 366]
-setnames(little, c('little', 'little.value'), c('SPPLIVMT', 'SPPVALUE'))
-little <- little[SPPLIVMT > 0, ]
-
-winter <- comland.skates[, list(YEAR, Half, AREA, MONTH, NEGEAR,
- TONCL1, NESPP3, UTILCD, MKTCAT, winter,
- winter.value)]
-winter[, NESPP3 := 367]
-setnames(winter, c('winter', 'winter.value'), c('SPPLIVMT', 'SPPVALUE'))
-winter <- winter[SPPLIVMT > 0, ]
-
-other <- comland.skates[, list(YEAR, Half, AREA, MONTH, NEGEAR,
- TONCL1, NESPP3, UTILCD, MKTCAT, other.skate,
- other.skate.value)]
-other[, NESPP3 := 365]
-setnames(other, c('other.skate', 'other.skate.value'), c('SPPLIVMT', 'SPPVALUE'))
-other <- other[SPPLIVMT > 0, ]
-
-#merge all three and reformat for comland
-skates.add.back <- rbindlist(list(little, winter, other))
-
-skates.add.back[, Half := NULL]
-setcolorder(skates.add.back, names(comland))
-
-comland <- rbindlist(list(comland[NESPP3 != 365, ], skates.add.back))
-
-#get silver hake from mixed hakes - use survey in half years
-#Generate Half year variable in comland
-comland.hakes <- comland[NESPP3 == 507, ]
-comland.hakes[MONTH %in% 1:6, Half := 1]
-comland.hakes[MONTH %in% 7:12, Half := 2]
-
-comland.hakes <- merge(comland.hakes, skate.hake.us, by = key(skate.hake.us), all.x = T)
-
-comland.hakes[, silver := silver.per * SPPLIVMT]
-comland.hakes[, silver.value := round(silver.per * SPPVALUE)]
-comland.hakes[is.na(silver), silver := 0]
-comland.hakes[is.na(silver.value), silver.value := 0]
-
-comland.hakes[, off.hake := SPPLIVMT - silver]
-comland.hakes[, off.hake.value := SPPVALUE - silver.value]
-
-#Silver hake (509), mix hakes (507)
-#put hakes in comland format to merge back
-silver <- comland.hakes[, list(YEAR, Half, AREA, MONTH, NEGEAR,
- TONCL1, NESPP3, UTILCD, MKTCAT, silver,
- silver.value)]
-silver[, NESPP3 := 509]
-setnames(silver, c('silver', 'silver.value'), c('SPPLIVMT', 'SPPVALUE'))
-silver <- silver[SPPLIVMT > 0, ]
-
-offshore <- comland.hakes[, list(YEAR, Half, AREA, MONTH, NEGEAR,
- TONCL1, NESPP3, UTILCD, MKTCAT, off.hake,
- off.hake.value)]
-offshore[, NESPP3 := 507]
-setnames(offshore, c('off.hake', 'off.hake.value'), c('SPPLIVMT', 'SPPVALUE'))
-offshore <- offshore[SPPLIVMT > 0, ]
-
-#merge both and reformat for comland
-hakes.add.back <- rbindlist(list(silver, offshore))
-
-hakes.add.back[, Half := NULL]
-setcolorder(hakes.add.back, names(comland))
-
-comland <- rbindlist(list(comland[NESPP3 != 507, ], hakes.add.back))
-
-
-#Herring---------------------------------------------------------------------------------
-#Herring data is housed by the state of Maine.
-herr.qry <- "select year, month, stock_area, negear, gearname, keptmt, discmt
- from maine_herring_catch"
-
-herr.catch <- as.data.table(sqlQuery(channel, herr.qry))
-setkey(herr.catch, YEAR, MONTH, STOCK_AREA, NEGEAR)
-
-herring <- herr.catch[, list(sum(KEPTMT), sum(DISCMT)), by = key(herr.catch)]
-setnames(herring, c('STOCK_AREA', 'V1', 'V2'),
- c('AREA', 'SPPLIVMT', 'DISCMT'))
-
-#Using averages from comland to fill in categories
-herring[, MKTCAT := 5]
-herring[, TONCL1 := 2]
-herring[, UTILCD := 0]
-
-#compute price/utilization from CF tables
-herring.comland <- comland[NESPP3 == 168, ]
-#Price from comland
-herring.price <- herring.comland[, (sum(SPPVALUE) / sum(SPPLIVMT)), by = c('YEAR', 'MONTH')]
-setnames(herring.price, 'V1', 'price')
-herring <- merge(herring, herring.price, by = c('YEAR', 'MONTH'), all.x = T)
-#Use 1964 prices for < 1964
-herring[YEAR < 1964, price := mean(herring[YEAR == 1964, price])]
-#Calculate SPPVALUE from price
-herring[, SPPVALUE := round(price * SPPLIVMT)]
-
-#Utilization from comland
-herring.util <- herring.comland[, sum(SPPLIVMT), by = c('YEAR', 'MONTH', 'UTILCD')]
-setnames(herring.util, 'V1', 'SPPLIVMT')
-herring.util[, SPPLIVMT.ALL := sum(SPPLIVMT), by = c('YEAR', 'MONTH')]
-herring.util[, Prop := SPPLIVMT/SPPLIVMT.ALL]
-setorder(herring.util, YEAR, MONTH, Prop)
-herring.util[, cum.prop := cumsum(Prop), by = c('YEAR', 'MONTH')]
-
-#Apply proportions to Maine data set
-#Not pulled all the time - current through 2017
-herring[, Total := sum(SPPLIVMT), by = c('YEAR', 'MONTH')]
-herring[, Prop := SPPLIVMT / Total]
-setorder(herring, YEAR, MONTH, Prop)
-herring[, cum.prop := cumsum(Prop), by = c('YEAR', 'MONTH')]
-
-for(iyear in unique(herring.util[, YEAR])){
- for(imonth in unique(herring.util[YEAR == iyear, MONTH])){
- cum.prop.low <- 0
- for(iutil in herring.util[YEAR == iyear & MONTH == imonth, UTILCD]){
- cum.prop.high <- herring.util[YEAR == iyear & MONTH == imonth &
- UTILCD == iutil, cum.prop]
- herring[YEAR == iyear & MONTH == imonth & cum.prop <= cum.prop.high &
- cum.prop > cum.prop.low, UTILCD := iutil]
- cum.prop.low <- cum.prop.high
- }
- }
-}
-
-#fix column headings
-herring[, c('Total', 'Prop', 'cum.prop', 'price', 'DISCMT') := NULL]
-herring[, NESPP3 := 168]
-setcolorder(herring, names(comland))
-
-#remove herring from data pull and add in Maine numbers
-comland <- rbindlist(list(comland[NESPP3 != 168, ], herring))
-
-#Menhaden------------------------------------------------------------------------------------
-##fix menhaden records - data from Tom Miller/ Andre Bouchheister
-#menhaden <- as.data.table(read.csv(paste(data.dir, "Menhaden.csv", sep = '')))
-#menhaden.mab <- menhaden[, MA.Total + CB.Total, by = Year]
-##file metric is 1000s of lbs - convert to mt
-#menhaden.mab[, SPPLIVMT := (V1 * 1000) * 0.00045359237]
-#menhaden.mab[, V1 := NULL]
-#
-#menhaden.gom <- menhaden[, list(Year, NE.Total)]
-#menhaden.gom[, SPPLIVMT := (NE.Total * 1000) * 0.00045359237]
-#menhaden.gom[, NE.Total := NULL]
-
-#save(comland, file = paste(out.dir, "Comland_unkA.RData", sep = ''))
-
-#Deal with unknowns-------------------------------------------------------------------------
-comland[NEGEAR == 999, NEGEAR := 0]
-comland[is.na(TONCL1), TONCL1 := 0]
-comland[is.na(AREA), AREA := as.factor(0)]
-comland[AREA == 999, AREA := as.factor(0)]
-comland[is.na(MKTCAT), MKTCAT := 0]
-comland[is.na(UTILCD), UTILCD := 0]
-
-#1 - drop unknown species/landings
-comland <- comland[NESPP3 != 0 & SPPLIVMT != 0, ]
-
-#Sumarry tables
-#missing area
-#known.area <- comland[AREA != 0, sum(SPPLIVMT), by = NESPP3]
-#unknown.area <- comland[AREA == 0, sum(SPPLIVMT), by = NESPP3]
-#setnames(known.area, "V1", "AREA.MT.known")
-#setnames(unknown.area, "V1", "AREA.MT.unknown")
-#missing.table <- merge(known.area, unknown.area, by = 'NESPP3', all = T)
-#
-#missing.table[is.na(AREA.MT.known), AREA.MT.known := 0]
-#missing.table[is.na(AREA.MT.unknown), AREA.MT.unknown := 0]
-#missing.table[, AREA.Ratio := AREA.MT.unknown / AREA.MT.known]
-#
-##missing month
-#known.month <- comland[MONTH != 0, sum(SPPLIVMT), by = NESPP3]
-#unknown.month <- comland[MONTH == 0, sum(SPPLIVMT), by = NESPP3]
-#setnames(known.month, "V1", "MONTH.MT.known")
-#setnames(unknown.month, "V1", "MONTH.MT.unknown")
-#missing.table <- merge(missing.table, known.month, by = 'NESPP3', all = T)
-#missing.table <- merge(missing.table, unknown.month, by = 'NESPP3', all = T)
-#
-#missing.table[is.na(MONTH.MT.known), MONTH.MT.known := 0]
-#missing.table[is.na(MONTH.MT.unknown), MONTH.MT.unknown := 0]
-#missing.table[, MONTH.Ratio := MONTH.MT.unknown / MONTH.MT.known]
-#
-##missing gear
-#known.gear <- comland[NEGEAR != 0, sum(SPPLIVMT), by = NESPP3]
-#unknown.gear <- comland[NEGEAR == 0, sum(SPPLIVMT), by = NESPP3]
-#setnames(known.gear, "V1", "GEAR.MT.known")
-#setnames(unknown.gear, "V1", "GEAR.MT.unknown")
-#missing.table <- merge(missing.table, known.gear, by = 'NESPP3', all = T)
-#missing.table <- merge(missing.table, unknown.gear, by = 'NESPP3', all = T)
-#
-#missing.table[is.na(GEAR.MT.known), GEAR.MT.known := 0]
-#missing.table[is.na(GEAR.MT.unknown), GEAR.MT.unknown := 0]
-#missing.table[, GEAR.Ratio := GEAR.MT.unknown / GEAR.MT.known]
-#
-##missing tonnage class
-#known.tc <- comland[TONCL1 != 0, sum(SPPLIVMT), by = NESPP3]
-#unknown.tc <- comland[TONCL1 == 0, sum(SPPLIVMT), by = NESPP3]
-#setnames(known.tc, "V1", "TC.MT.known")
-#setnames(unknown.tc, "V1", "TC.MT.unknown")
-#missing.table <- merge(missing.table, known.tc, by = 'NESPP3', all = T)
-#missing.table <- merge(missing.table, unknown.tc, by = 'NESPP3', all = T)
-#
-#missing.table[is.na(TC.MT.known), TC.MT.known := 0]
-#missing.table[is.na(TC.MT.unknown), TC.MT.unknown := 0]
-#missing.table[, TC.Ratio := TC.MT.unknown / TC.MT.known]
-#
-#write.csv(missing.table, paste(out.dir, "\\Missing_table.csv", sep = ''), row.names = F)
-#
-
-#2 - aggregate by quarter year, half year, major gear, and small/large TC
-comland[MONTH %in% 1:3, QY := 1]
-comland[MONTH %in% 4:6, QY := 2]
-comland[MONTH %in% 7:9, QY := 3]
-comland[MONTH %in% 10:12, QY := 4]
-comland[MONTH == 0, QY := 0]
-
-comland[MONTH %in% 1:6, HY := 1]
-comland[MONTH %in% 7:12, HY := 2]
-comland[MONTH == 0, HY := 0]
-
-otter <- 50:59
-dredge.sc <- 131:132
-pot <- c(189:190, 200:219, 300, 301)
-longline <- c(10, 40)
-seine <- c(70:79, 120:129, 360)
-gillnet <- c(100:119, 500, 510, 520)
-midwater <- c(170, 370)
-dredge.o <- c(281, 282, 380:400)
-
-comland[NEGEAR %in% otter, GEAR := 'otter']
-comland[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc']
-comland[NEGEAR %in% pot, GEAR := 'pot']
-comland[NEGEAR %in% longline, GEAR := 'longline']
-comland[NEGEAR %in% seine, GEAR := 'seine']
-comland[NEGEAR %in% gillnet, GEAR := 'gillnet']
-comland[NEGEAR %in% midwater, GEAR := 'midwater']
-comland[NEGEAR %in% dredge.o, GEAR := 'dredge.o']
-comland[NEGEAR == 0, GEAR := 'unknown']
-comland[is.na(GEAR), GEAR := 'other']
-comland[, GEAR := as.factor(GEAR)]
-
-comland[TONCL1 %in% 1:3, SIZE := 'small']
-comland[TONCL1 > 3, SIZE := 'large']
-comland[TONCL1 == 0, SIZE := 'unknown']
-comland[, SIZE := as.factor(SIZE)]
-
-setkey(comland,
- YEAR,
- QY,
- HY,
- GEAR,
- SIZE,
- AREA,
- NESPP3,
- UTILCD)
-
-comland.agg <- comland[, list(sum(SPPLIVMT), sum(SPPVALUE)), by = key(comland)]
-
-setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-#3 - Use proportions of known catch to assign unknown catch
-#3.A QY/HY------------------------------------------------------------------------------
-unk.month <- comland.agg[QY == 0, ]
-k.month <- comland.agg[QY != 0, ]
-
-#3.A.1 - All match
-match.key <- c('YEAR', 'NESPP3', 'GEAR', 'SIZE', 'AREA')
-
-unk.month.all <- unk.month[GEAR != 'unknown']
-unk.month.all <- unk.month.all[SIZE != 'unknown', ]
-unk.month.all <- unk.month.all[AREA != 0, ]
-
-k.month.all <- k.month[GEAR != 'unknown', ]
-k.month.all <- k.month.all[SIZE != 'unknown', ]
-k.month.all <- k.month.all[AREA != 0, ]
-
-setkeyv(unk.month.all, match.key)
-setkeyv(k.month.all, match.key)
-
-month.all <- k.month.all[unk.month.all]
-
-#No match - need to match with larger aggregation
-no.match <- month.all[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop SIZE
-setkey(no.match, YEAR, NESPP3, AREA, GEAR)
-setkeyv(k.month.all, key(no.match))
-month.all.2 <- k.month.all[no.match]
-no.match.2 <- month.all.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop GEAR
-setkey(no.match.2, YEAR, NESPP3, AREA)
-setkeyv(k.month.all, key(no.match.2))
-month.all.3 <- k.month.all[no.match.2]
-no.match.3 <- month.all.3[is.na(SPPLIVMT), ]
-no.match.3[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop AREA
-setkey(no.match.3, YEAR, NESPP3)
-setkeyv(k.month.all, key(no.match.3))
-month.all.4 <- k.month.all[no.match.3]
-no.match.4 <- month.all.4[is.na(SPPLIVMT), ]
-no.match.4[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.4, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to first QY/HY
-no.match.4[, c('QY', 'HY') := 1]
-
-#Merge all together and proportion catch to known months
-month.all <- month.all [!is.na(SPPLIVMT), ]
-month.all.2 <- month.all.2[!is.na(SPPLIVMT), ]
-month.all.2[, SIZE := i.SIZE]
-month.all.2[, i.SIZE := NULL]
-setcolorder(month.all.2, names(month.all))
-month.all.3 <- month.all.3[!is.na(SPPLIVMT), ]
-month.all.3[, GEAR := i.GEAR]
-month.all.3[, SIZE := i.SIZE]
-month.all.3[, i.GEAR := NULL]
-month.all.3[, i.SIZE := NULL]
-setcolorder(month.all.3, names(month.all))
-month.all.4 <- month.all.4[!is.na(SPPLIVMT), ]
-month.all.4[, AREA := i.AREA]
-month.all.4[, GEAR := i.GEAR]
-month.all.4[, SIZE := i.SIZE]
-month.all.4[, i.AREA := NULL]
-month.all.4[, i.GEAR := NULL]
-month.all.4[, i.SIZE := NULL]
-setcolorder(month.all.4, names(month.all))
-
-month.all <- rbindlist(list(month.all, month.all.2, month.all.3, month.all.4))
-
-month.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.all[, unk := i.SPPLIVMT * prop]
-month.all[, unk2 := i.SPPVALUE * prop]
-month.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY',
- 'i.QY', 'i.UTILCD', 'prop') := NULL]
-setnames(month.all, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setcolorder(no.match.4, names(month.all))
-month.solved <- rbindlist(list(month.all, no.match.4))
-rm(list = c(ls(pattern = 'month.all'), ls(pattern = 'no.match')))
-
-#3.A.2 - GEAR/SIZE
-match.key <- c('YEAR', 'NESPP3', 'GEAR', 'SIZE')
-
-unk.month.g.s <- unk.month[GEAR != 'unknown']
-unk.month.g.s <- unk.month.g.s[SIZE != 'unknown', ]
-unk.month.g.s <- unk.month.g.s[AREA == 0, ]
-unk.month.g.s <- unk.month.g.s[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(unk.month.g.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-k.month.g.s <- k.month[GEAR != 'unknown', ]
-k.month.g.s <- k.month.g.s[SIZE != 'unknown', ]
-k.month.g.s <- k.month.g.s[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(k.month.g.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.month.g.s, match.key)
-setkeyv(k.month.g.s, match.key)
-
-month.g.s <- k.month.g.s[unk.month.g.s]
-
-#No match - need to match with larger aggregation
-no.match <- month.g.s[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop SIZE
-setkey(no.match, YEAR, NESPP3, GEAR)
-setkeyv(k.month.g.s, key(no.match))
-month.g.s.2 <- k.month.g.s[no.match]
-no.match.2 <- month.g.s.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop GEAR
-setkey(no.match.2, YEAR, NESPP3)
-setkeyv(k.month.g.s, key(no.match.2))
-month.g.s.3 <- k.month.g.s[no.match.2]
-no.match.3 <- month.g.s.3[is.na(SPPLIVMT), ]
-no.match.3[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to first QY/HY
-no.match.3[, c('QY', 'HY') := 1]
-no.match.3[, AREA := 0]
-
-#Merge all together and proportion catch to known months
-month.g.s <- month.g.s [!is.na(SPPLIVMT), ]
-month.g.s.2 <- month.g.s.2[!is.na(SPPLIVMT), ]
-if(nrow(month.g.s.2) > 0){
- month.g.s.2[, SIZE := i.SIZE]
- month.g.s.2[, i.SIZE := NULL]
- setcolorder(month.g.s.2, names(month.g.s))
- month.g.s <- rbindlist(list(month.g.s, month.g.s.2))
-}
-month.g.s.3 <- month.g.s.3[!is.na(SPPLIVMT), ]
-if(nrow(month.g.s.3) > 0){
- month.g.s.3[, GEAR := i.GEAR]
- month.g.s.3[, SIZE := i.SIZE]
- month.g.s.3[, i.GEAR := NULL]
- month.g.s.3[, i.SIZE := NULL]
- setcolorder(month.g.s.3, names(month.g.s))
- month.g.s <- rbindlist(list(month.g.s, month.g.s.3))
-}
-
-month.g.s[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.g.s[, unk := i.SPPLIVMT * prop]
-month.g.s[, unk2 := i.SPPVALUE * prop]
-month.g.s[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY',
- 'i.QY', 'i.UTILCD', 'prop') := NULL]
-setnames(month.g.s, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
-month.g.s[, AREA := 0]
-
-setcolorder(month.g.s, names(month.solved))
-setcolorder(no.match.3, names(month.solved))
-month.solved <- rbindlist(list(month.solved, month.g.s, no.match.3))
-rm(list = c(ls(pattern = 'month.g.s'), ls(pattern = 'no.match')))
-
-#3.A.3 - AREA/GEAR
-match.key <- c('YEAR', 'NESPP3', 'GEAR', 'AREA')
-
-unk.month.a.g <- unk.month[GEAR != 'unknown']
-unk.month.a.g <- unk.month.a.g[SIZE == 'unknown', ]
-unk.month.a.g <- unk.month.a.g[AREA != 0, ]
-unk.month.a.g <- unk.month.a.g[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(unk.month.a.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-k.month.a.g <- k.month[GEAR != 'unknown', ]
-k.month.a.g <- k.month.a.g[AREA != 0, ]
-k.month.a.g <- k.month.a.g[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(k.month.a.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.month.a.g, match.key)
-setkeyv(k.month.a.g, match.key)
-
-month.a.g <- k.month.a.g[unk.month.a.g]
-
-#No match - need to match with larger aggregation
-no.match <- month.a.g[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop GEAR
-setkey(no.match, YEAR, NESPP3, AREA)
-setkeyv(k.month.a.g, key(no.match))
-month.a.g.2 <- k.month.a.g[no.match]
-no.match.2 <- month.a.g.2[is.na(SPPLIVMT), ]
-no.match.2[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop AREA
-setkey(no.match.2, YEAR, NESPP3)
-setkeyv(k.month.a.g, key(no.match.2))
-month.a.g.3 <- k.month.a.g[no.match.2]
-no.match.3 <- month.a.g.3[is.na(SPPLIVMT), ]
-no.match.3[, c('AREA', 'GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.AREA', 'i.GEAR', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to first QY/HY
-no.match.3[, c('QY', 'HY') := 1]
-no.match.3[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-
-#Merge all together and proportion catch to known months
-month.a.g <- month.a.g [!is.na(SPPLIVMT), ]
-month.a.g.2 <- month.a.g.2[!is.na(SPPLIVMT), ]
-if(nrow(month.a.g.2) > 0){
- month.a.g.2[, GEAR := i.GEAR]
- month.a.g.2[, i.GEAR := NULL]
- setcolorder(month.a.g.2, names(month.a.g))
- month.a.g <- rbindlist(list(month.a.g, month.a.g.2))
-}
-month.a.g.3 <- month.a.g.3[!is.na(SPPLIVMT), ]
-if(nrow(month.a.g.3) > 0){
- month.a.g.3[, AREA := i.AREA]
- month.a.g.3[, GEAR := i.GEAR]
- month.a.g.3[, i.AREA := NULL]
- month.a.g.3[, i.GEAR := NULL]
- setcolorder(month.a.g.3, names(month.a.g))
- month.a.g <- rbindlist(list(month.a.g, month.a.g.3))
-}
-
-month.a.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.a.g[, unk := i.SPPLIVMT * prop]
-month.a.g[, unk2 := i.SPPVALUE * prop]
-month.a.g[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY',
- 'i.QY', 'i.UTILCD', 'prop') := NULL]
-setnames(month.a.g, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
-month.a.g[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-
-setcolorder(month.a.g, names(month.solved))
-setcolorder(no.match.3, names(month.solved))
-month.solved <- rbindlist(list(month.solved, month.a.g, no.match.3))
-rm(list = c(ls(pattern = 'month.a.g'), ls(pattern = 'no.match')))
-
-#3.A.4 - AREA/TC
-match.key <- c('YEAR', 'NESPP3', 'SIZE', 'AREA')
-
-unk.month.a.s <- unk.month[GEAR == 'unknown']
-unk.month.a.s <- unk.month.a.s[SIZE != 'unknown', ]
-unk.month.a.s <- unk.month.a.s[AREA != 0, ]
-unk.month.a.s <- unk.month.a.s[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(unk.month.a.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-k.month.a.s <- k.month[SIZE != 'unknown', ]
-k.month.a.s <- k.month.a.s[AREA != 0, ]
-k.month.a.s <- k.month.a.s[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(k.month.a.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.month.a.s, match.key)
-setkeyv(k.month.a.s, match.key)
-
-month.a.s <- k.month.a.s[unk.month.a.s]
-
-#No match - need to match with larger aggregation
-no.match <- month.a.s[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop SIZE
-setkey(no.match, YEAR, NESPP3, AREA)
-setkeyv(k.month.a.s, key(no.match))
-month.a.s.2 <- k.month.a.s[no.match]
-no.match.2 <- month.a.s.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop AREA
-setkey(no.match.2, YEAR, NESPP3)
-setkeyv(k.month.a.s, key(no.match.2))
-month.a.s.3 <- k.month.a.s[no.match.2]
-no.match.3 <- month.a.s.3[is.na(SPPLIVMT), ]
-no.match.3[, c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to first QY/HY
-no.match.3[, c('QY', 'HY') := 1]
-no.match.3[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-
-#Merge all together and proportion catch to known months
-month.a.s <- month.a.s [!is.na(SPPLIVMT), ]
-month.a.s.2 <- month.a.s.2[!is.na(SPPLIVMT), ]
-if(nrow(month.a.s.2) > 0){
- month.a.s.2[, SIZE := i.SIZE]
- month.a.s.2[, i.SIZE := NULL]
- setcolorder(month.a.s.2, names(month.a.s))
- month.a.s <- rbindlist(list(month.a.s, month.a.s.2))
-}
-month.a.s.3 <- month.a.s.3[!is.na(SPPLIVMT), ]
-if(nrow(month.a.s.3) > 0){
- month.a.s.3[, AREA := i.AREA]
- month.a.s.3[, SIZE := i.SIZE]
- month.a.s.3[, i.AREA := NULL]
- month.a.s.3[, i.SIZE := NULL]
- setcolorder(month.a.s.3, names(month.a.s))
- month.a.s <- rbindlist(list(month.a.s, month.a.s.3))
-}
-
-month.a.s[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.a.s[, unk := i.SPPLIVMT * prop]
-month.a.s[, unk2 := i.SPPVALUE * prop]
-month.a.s[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY',
- 'i.QY', 'i.UTILCD', 'prop') := NULL]
-setnames(month.a.s, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
-month.a.s[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-
-setcolorder(month.a.s, names(month.solved))
-setcolorder(no.match.3, names(month.solved))
-month.solved <- rbindlist(list(month.solved, month.a.s, no.match.3))
-rm(list = c(ls(pattern = 'month.a.s'), ls(pattern = 'no.match')))
-
-#3.A.5 - SIZE
-match.key <- c('YEAR', 'NESPP3', 'SIZE')
-
-unk.month.si <- unk.month[GEAR == 'unknown']
-unk.month.si <- unk.month.si[SIZE != 'unknown', ]
-unk.month.si <- unk.month.si[AREA == 0, ]
-unk.month.si <- unk.month.si[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(unk.month.si, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-k.month.si <- k.month[SIZE != 'unknown', ]
-k.month.si <- k.month.si[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(k.month.si, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.month.si, match.key)
-setkeyv(k.month.si, match.key)
-
-month.si <- k.month.si[unk.month.si]
-
-#No match - need to match with larger aggregation
-no.match <- month.si[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop SIZE
-setkey(no.match, YEAR, NESPP3)
-setkeyv(k.month.si, key(no.match))
-month.si.2 <- k.month.si[no.match]
-no.match.2 <- month.si.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to first QY/HY
-no.match.2[, c('QY', 'HY') := 1]
-no.match.2[, AREA := 0]
-no.match.2[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-
-#Merge all together and proportion catch to known months
-month.si <- month.si [!is.na(SPPLIVMT), ]
-month.si.2 <- month.si.2[!is.na(SPPLIVMT), ]
-if(nrow(month.si.2) > 0){
- month.si.2[, SIZE := i.SIZE]
- month.si.2[, i.SIZE := NULL]
- setcolorder(month.si.2, names(month.si))
- month.si <- rbindlist(list(month.si, month.si.2))
-}
-
-month.si[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.si[, unk := i.SPPLIVMT * prop]
-month.si[, unk2 := i.SPPVALUE * prop]
-month.si[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', 'i.QY',
- 'i.UTILCD', 'prop') := NULL]
-setnames(month.si, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
-month.si[, AREA := 0]
-month.si[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-
-setcolorder(month.si, names(month.solved))
-setcolorder(no.match.2, names(month.solved))
-month.solved <- rbindlist(list(month.solved, month.si, no.match.2))
-rm(list = c(ls(pattern = 'month.si'), ls(pattern = 'no.match')))
-
-#3.A.6 - GEAR
-match.key <- c('YEAR', 'NESPP3', 'GEAR')
-
-unk.month.g <- unk.month[GEAR != 'unknown']
-unk.month.g <- unk.month.g[SIZE == 'unknown', ]
-unk.month.g <- unk.month.g[AREA == 0, ]
-unk.month.g <- unk.month.g[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(unk.month.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-k.month.g <- k.month[GEAR != 'unknown', ]
-k.month.g <- k.month.g[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(k.month.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.month.g, match.key)
-setkeyv(k.month.g, match.key)
-
-month.g <- k.month.g[unk.month.g]
-
-#No match - need to match with larger aggregation
-no.match <- month.g[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop GEAR
-setkey(no.match, YEAR, NESPP3)
-setkeyv(k.month.g, key(no.match))
-month.g.2 <- k.month.g[no.match]
-no.match.2 <- month.g.2[is.na(SPPLIVMT), ]
-no.match.2[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to first QY/HY
-no.match.2[, c('QY', 'HY') := 1]
-no.match.2[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-no.match.2[, AREA := 0]
-
-#Merge all together and proportion catch to known months
-month.g <- month.g [!is.na(SPPLIVMT), ]
-month.g.2 <- month.g.2[!is.na(SPPLIVMT), ]
-if(nrow(month.g.2) > 0){
- month.g.2[, GEAR := i.GEAR]
- month.g.2[, i.GEAR := NULL]
- setcolorder(month.g.2, names(month.g))
- month.g <- rbindlist(list(month.g, month.g.2))
-}
-
-month.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.g[, unk := i.SPPLIVMT * prop]
-month.g[, unk2 := i.SPPVALUE * prop]
-month.g[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', 'i.QY',
- 'i.UTILCD', 'prop') := NULL]
-setnames(month.g, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
-month.g[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-month.g[, AREA := 0]
-
-setcolorder(month.g, names(month.solved))
-setcolorder(no.match.2, names(month.solved))
-month.solved <- rbindlist(list(month.solved, month.g, no.match.2))
-rm(list = c(ls(pattern = 'month.g'), ls(pattern = 'no.match')))
-
-#3.A.7 - AREA
-match.key <- c('YEAR', 'NESPP3', 'AREA')
-
-unk.month.a <- unk.month[GEAR == 'unknown']
-unk.month.a <- unk.month.a[SIZE == 'unknown', ]
-unk.month.a <- unk.month.a[AREA != 0, ]
-unk.month.a <- unk.month.a[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(unk.month.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-k.month.a <- k.month[AREA != 0, ]
-k.month.a <- k.month.a[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(k.month.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.month.a, match.key)
-setkeyv(k.month.a, match.key)
-
-month.a <- k.month.a[unk.month.a]
-
-#No match - need to match with larger aggregation
-no.match <- month.a[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop AREA
-setkey(no.match, YEAR, NESPP3)
-setkeyv(k.month.a, key(no.match))
-month.a.2 <- k.month.a[no.match]
-no.match.2 <- month.a.2[is.na(SPPLIVMT), ]
-no.match.2[, c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.AREA', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to first QY/HY
-no.match.2[, c('QY', 'HY') := 1]
-no.match.2[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-no.match.2[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-
-#Merge all together and proportion catch to known months
-month.a <- month.a [!is.na(SPPLIVMT), ]
-month.a.2 <- month.a.2[!is.na(SPPLIVMT), ]
-if(nrow(month.a.2) > 0){
- month.a.2[, AREA := i.AREA]
- month.a.2[, i.AREA := NULL]
- setcolorder(month.a.2, names(month.a))
- month.a <- rbindlist(list(month.a, month.a.2))
-}
-
-month.a[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.a[, unk := i.SPPLIVMT * prop]
-month.a[, unk2 := i.SPPVALUE * prop]
-month.a[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY',
- 'i.QY', 'i.UTILCD', 'prop') := NULL]
-setnames(month.a, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-month.a[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-month.a[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-
-setcolorder(month.a, names(month.solved))
-setcolorder(no.match.2, names(month.solved))
-month.solved <- rbindlist(list(month.solved, month.a, no.match.2))
-rm(list = c(ls(pattern = 'month.a'), ls(pattern = 'no.match')))
-
-#3.A.8 - Species only - no other match
-match.key <- c('YEAR', 'NESPP3')
-
-unk.month.sp <- unk.month[GEAR == 'unknown']
-unk.month.sp <- unk.month.sp[SIZE == 'unknown', ]
-unk.month.sp <- unk.month.sp[AREA == 0, ]
-unk.month.sp <- unk.month.sp[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(unk.month.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-k.month.sp <- k.month[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'QY', 'HY', 'UTILCD')]
-setnames(k.month.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.month.sp, match.key)
-setkeyv(k.month.sp, match.key)
-
-month.sp <- k.month.sp[unk.month.sp]
-
-#No match - assign to first QY/HY
-no.match <- month.sp[is.na(SPPLIVMT), ]
-no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-no.match[, c('QY', 'HY') := 1]
-no.match[, AREA := 0]
-no.match[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-no.match[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-
-#proportion catch to known months
-month.sp <- month.sp [!is.na(SPPLIVMT), ]
-
-month.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-month.sp[, unk := i.SPPLIVMT * prop]
-month.sp[, unk2 := i.SPPVALUE * prop]
-month.sp[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.HY', 'i.QY',
- 'i.UTILCD', 'prop') := NULL]
-setnames(month.sp, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-month.sp[, AREA := 0]
-month.sp[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
-month.sp[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
-
-setcolorder(month.sp, names(month.solved))
-setcolorder(no.match, names(month.solved))
-month.solved <- rbindlist(list(month.solved, month.sp, no.match))
-rm(list = c(ls(pattern = 'month.sp'), ls(pattern = 'no.match')))
-
-#Merge back month.solved
-setcolorder(month.solved, names(comland.agg))
-comland.agg <- rbindlist(list(k.month, month.solved))
-setkey(comland.agg,
- YEAR,
- QY,
- HY,
- SIZE,
- GEAR,
- AREA,
- NESPP3,
- UTILCD)
-comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = key(comland.agg)]
-setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-#3.B SIZE------------------------------------------------------------------------------
-unk.size <- comland.agg[SIZE == 'unknown', ]
-k.size <- comland.agg[SIZE != 'unknown', ]
-
-#3.B.1 - All match
-match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'GEAR', 'AREA')
-
-unk.size.all <- unk.size[GEAR != 'unknown']
-unk.size.all <- unk.size.all[AREA != 0, ]
-
-k.size.all <- k.size[GEAR != 'unknown', ]
-k.size.all <- k.size.all[AREA != 0, ]
-
-setkeyv(unk.size.all, match.key)
-setkeyv(k.size.all, match.key)
-
-size.all <- k.size.all[unk.size.all]
-
-#No match - need to match with larger aggregation
-no.match <- size.all[is.na(SPPLIVMT), ]
-no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop QY
-setkey(no.match, YEAR, NESPP3, HY, GEAR, AREA)
-setkeyv(k.size.all, key(no.match))
-size.all.2 <- k.size.all[no.match]
-no.match.2 <- size.all.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop HY
-setkey(no.match.2, YEAR, NESPP3, GEAR, AREA)
-setkeyv(k.size.all, key(no.match.2))
-size.all.3 <- k.size.all[no.match.2]
-no.match.3 <- size.all.3[is.na(SPPLIVMT), ]
-no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop GEAR
-setkey(no.match.3, YEAR, NESPP3, AREA)
-setkeyv(k.size.all, key(no.match.3))
-size.all.4 <- k.size.all[no.match.3]
-no.match.4 <- size.all.4[is.na(SPPLIVMT), ]
-no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop AREA
-setkey(no.match.4, YEAR, NESPP3)
-setkeyv(k.size.all, key(no.match.4))
-size.all.5 <- k.size.all[no.match.4]
-no.match.5 <- size.all.5[is.na(SPPLIVMT), ]
-no.match.5[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.5, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'GEAR', 'SIZE', 'QY', 'HY',
- 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to SIZE to small
-no.match.5[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
-```
-
-```{r, echo = T, eval = F}
-#Merge all together and proportion catch to known sizes
-size.all <- size.all [!is.na(SPPLIVMT), ]
-size.all.2 <- size.all.2[!is.na(SPPLIVMT), ]
-size.all.2[, QY := i.QY]
-size.all.2[, i.QY := NULL]
-setcolorder(size.all.2, names(size.all))
-size.all.3 <- size.all.3[!is.na(SPPLIVMT), ]
-size.all.3[, QY := i.QY]
-size.all.3[, HY := i.HY]
-size.all.3[, i.QY := NULL]
-size.all.3[, i.HY := NULL]
-setcolorder(size.all.3, names(size.all))
-size.all.4 <- size.all.4[!is.na(SPPLIVMT), ]
-size.all.4[, QY := i.QY]
-size.all.4[, HY := i.HY]
-size.all.4[, GEAR := i.GEAR]
-size.all.4[, i.QY := NULL]
-size.all.4[, i.HY := NULL]
-size.all.4[, i.GEAR := NULL]
-setcolorder(size.all.4, names(size.all))
-size.all.5 <- size.all.5[!is.na(SPPLIVMT), ]
-size.all.5[, QY := i.QY]
-size.all.5[, HY := i.HY]
-size.all.5[, GEAR := i.GEAR]
-size.all.5[, AREA := i.AREA]
-size.all.5[, i.QY := NULL]
-size.all.5[, i.HY := NULL]
-size.all.5[, i.GEAR := NULL]
-size.all.5[, i.AREA := NULL]
-setcolorder(size.all.5, names(size.all))
-
-size.all <- rbindlist(list(size.all, size.all.2, size.all.3,
- size.all.4, size.all.5))
-
-size.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-size.all[, unk := i.SPPLIVMT * prop]
-size.all[, unk2 := i.SPPVALUE * prop]
-size.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE',
- 'i.UTILCD', 'prop') := NULL]
-setnames(size.all, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setcolorder(no.match.5, names(size.all))
-size.solved <- rbindlist(list(size.all, no.match.5))
-rm(list = c(ls(pattern = 'size.all'), ls(pattern = 'no.match')))
-
-#3.B.2 - GEAR
-match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'GEAR')
-
-unk.size.g <- unk.size[GEAR != 'unknown']
-unk.size.g <- unk.size.g[AREA == 0, ]
-unk.size.g[, AREA := NULL]
-
-k.size.g <- k.size[GEAR != 'unknown', ]
-k.size.g <- k.size.g[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'SIZE', 'UTILCD')]
-setnames(k.size.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.size.g, match.key)
-setkeyv(k.size.g, match.key)
-
-size.g <- k.size.g[unk.size.g]
-
-#No match - need to match with larger aggregation
-no.match <- size.g[is.na(SPPLIVMT), ]
-no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop QY
-setkey(no.match, YEAR, NESPP3, HY, GEAR)
-setkeyv(k.size.g, key(no.match))
-size.g.2 <- k.size.g[no.match]
-no.match.2 <- size.g.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop HY
-setkey(no.match.2, YEAR, NESPP3, GEAR)
-setkeyv(k.size.g, key(no.match.2))
-size.g.3 <- k.size.g[no.match.2]
-no.match.3 <- size.g.3[is.na(SPPLIVMT), ]
-no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Drop GEAR
-setkey(no.match.3, YEAR, NESPP3)
-setkeyv(k.size.g, key(no.match.3))
-size.g.4 <- k.size.g[no.match.3]
-no.match.4 <- size.g.4[is.na(SPPLIVMT), ]
-no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY',
- 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to SIZE to small
-no.match.4[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
-no.match.4[, AREA := 0]
-
-#Merge all together and proportion catch to known sizes
-size.g <- size.g [!is.na(SPPLIVMT), ]
-size.g.2 <- size.g.2[!is.na(SPPLIVMT), ]
-size.g.2[, QY := i.QY]
-size.g.2[, i.QY := NULL]
-setcolorder(size.g.2, names(size.g))
-size.g.3 <- size.g.3[!is.na(SPPLIVMT), ]
-size.g.3[, QY := i.QY]
-size.g.3[, HY := i.HY]
-size.g.3[, i.QY := NULL]
-size.g.3[, i.HY := NULL]
-setcolorder(size.g.3, names(size.g))
-size.g.4 <- size.g.4[!is.na(SPPLIVMT), ]
-size.g.4[, QY := i.QY]
-size.g.4[, HY := i.HY]
-size.g.4[, GEAR := i.GEAR]
-size.g.4[, i.QY := NULL]
-size.g.4[, i.HY := NULL]
-size.g.4[, i.GEAR := NULL]
-setcolorder(size.g.4, names(size.g))
-
-size.g <- rbindlist(list(size.g, size.g.2, size.g.3, size.g.4))
-
-size.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-size.g[, unk := i.SPPLIVMT * prop]
-size.g[, unk2 := i.SPPVALUE * prop]
-size.g[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE',
- 'i.UTILCD', 'prop') := NULL]
-setnames(size.g, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-size.g[, AREA := 0]
-
-setcolorder(size.g, names(size.solved))
-setcolorder(no.match.4, names(size.g))
-size.solved <- rbindlist(list(size.solved, size.g, no.match.4))
-rm(list = c(ls(pattern = 'size.g'), ls(pattern = 'no.match')))
-
-#3.B.3 - AREA
-match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'AREA')
-
-unk.size.a <- unk.size[GEAR == 'unknown']
-unk.size.a <- unk.size.a[AREA != 0, ]
-unk.size.a[, GEAR := NULL]
-
-k.size.a <- k.size[AREA != 0, ]
-k.size.a <- k.size.a[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'SIZE', 'UTILCD')]
-setnames(k.size.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.size.a, match.key)
-setkeyv(k.size.a, match.key)
-
-size.a <- k.size.a[unk.size.a]
-
-#No match - need to match with larger aggregation
-no.match <- size.a[is.na(SPPLIVMT), ]
-no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop QY
-setkey(no.match, YEAR, NESPP3, HY, AREA)
-setkeyv(k.size.a, key(no.match))
-size.a.2 <- k.size.a[no.match]
-no.match.2 <- size.a.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop HY
-setkey(no.match.2, YEAR, NESPP3, AREA)
-setkeyv(k.size.a, key(no.match.2))
-size.a.3 <- k.size.a[no.match.2]
-no.match.3 <- size.a.3[is.na(SPPLIVMT), ]
-no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Drop AREA
-setkey(no.match.3, YEAR, NESPP3)
-setkeyv(k.size.a, key(no.match.3))
-size.a.4 <- k.size.a[no.match.3]
-no.match.4 <- size.a.4[is.na(SPPLIVMT), ]
-no.match.4[, c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.4, c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to SIZE to small
-no.match.4[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
-no.match.4[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
-
-#Merge all together and proportion catch to known sizes
-size.a <- size.a [!is.na(SPPLIVMT), ]
-size.a.2 <- size.a.2[!is.na(SPPLIVMT), ]
-size.a.2[, QY := i.QY]
-size.a.2[, i.QY := NULL]
-setcolorder(size.a.2, names(size.a))
-size.a.3 <- size.a.3[!is.na(SPPLIVMT), ]
-size.a.3[, QY := i.QY]
-size.a.3[, HY := i.HY]
-size.a.3[, i.QY := NULL]
-size.a.3[, i.HY := NULL]
-setcolorder(size.a.3, names(size.a))
-size.a.4 <- size.a.4[!is.na(SPPLIVMT), ]
-size.a.4[, QY := i.QY]
-size.a.4[, HY := i.HY]
-size.a.4[, AREA := i.AREA]
-size.a.4[, i.QY := NULL]
-size.a.4[, i.HY := NULL]
-size.a.4[, i.AREA := NULL]
-setcolorder(size.a.4, names(size.a))
-
-size.a <- rbindlist(list(size.a, size.a.2, size.a.3, size.a.4))
-
-size.a[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-size.a[, unk := i.SPPLIVMT * prop]
-size.a[, unk2 := i.SPPVALUE * prop]
-size.a[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE',
- 'i.UTILCD', 'prop') := NULL]
-setnames(size.a, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-size.a[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
-
-setcolorder(size.a, names(size.solved))
-setcolorder(no.match.4, names(size.a))
-size.solved <- rbindlist(list(size.solved, size.a, no.match.4))
-rm(list = c(ls(pattern = 'size.a'), ls(pattern = 'no.match')))
-
-#3.B.4 - Species only - no other match
-match.key <- c('YEAR', 'NESPP3', 'QY', 'HY')
-
-unk.size.sp <- unk.size[GEAR == 'unknown']
-unk.size.sp <- unk.size.sp[SIZE == 'unknown', ]
-unk.size.sp <- unk.size.sp[AREA == 0, ]
-unk.size.sp[, c('GEAR', 'AREA') := NULL]
-
-k.size.sp <- k.size[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'SIZE', 'UTILCD')]
-setnames(k.size.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.size.sp, match.key)
-setkeyv(k.size.sp, match.key)
-
-size.sp <- k.size.sp[unk.size.sp]
-
-#No match - need to match with larger aggregation
-no.match <- size.sp[is.na(SPPLIVMT), ]
-no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop QY
-setkey(no.match, YEAR, NESPP3, HY)
-setkeyv(k.size.sp, key(no.match))
-size.sp.2 <- k.size.sp[no.match]
-no.match.2 <- size.sp.2[is.na(SPPLIVMT), ]
-no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop HY
-setkey(no.match.2, YEAR, NESPP3)
-setkeyv(k.size.sp, key(no.match.2))
-size.sp.3 <- k.size.sp[no.match.2]
-no.match.3 <- size.sp.3[is.na(SPPLIVMT), ]
-no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to SIZE to small
-no.match.3[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
-no.match.3[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
-no.match.3[, AREA := 0]
-
-#Merge together and proportion catch to known sizes
-size.sp <- size.sp [!is.na(SPPLIVMT), ]
-size.sp.2 <- size.sp.2[!is.na(SPPLIVMT), ]
-size.sp.2[, QY := i.QY]
-size.sp.2[, i.QY := NULL]
-setcolorder(size.sp.2, names(size.sp))
-size.sp.3 <- size.sp.3[!is.na(SPPLIVMT), ]
-size.sp.3[, QY := i.QY]
-size.sp.3[, HY := i.HY]
-size.sp.3[, i.QY := NULL]
-size.sp.3[, i.HY := NULL]
-setcolorder(size.sp.3, names(size.sp))
-
-size.sp <- rbindlist(list(size.sp, size.sp.2, size.sp.3))
-
-size.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-size.sp[, unk := i.SPPLIVMT * prop]
-size.sp[, unk2 := i.SPPVALUE * prop]
-size.sp[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.SIZE',
- 'i.UTILCD', 'prop') := NULL]
-setnames(size.sp, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-size.sp[, AREA := 0]
-size.sp[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
-
-setcolorder(size.sp, names(size.solved))
-setcolorder(no.match.3, names(size.solved))
-size.solved <- rbindlist(list(size.solved, size.sp, no.match.3))
-rm(list = c(ls(pattern = 'size.sp'), ls(pattern = 'no.match')))
-
-#Merge back size.solved
-setcolorder(size.solved, names(comland.agg))
-comland.agg <- rbindlist(list(k.size, size.solved))
-setkey(comland.agg,
- YEAR,
- QY,
- HY,
- SIZE,
- GEAR,
- AREA,
- NESPP3,
- UTILCD)
-comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = key(comland.agg)]
-setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-#3.C GEAR------------------------------------------------------------------------------
-unk.gear <- comland.agg[GEAR == 'unknown', ]
-k.gear <- comland.agg[GEAR != 'unknown', ]
-
-#3.C.1 - All match
-match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE', 'AREA')
-
-unk.gear.all <- unk.gear[AREA != 0, ]
-
-k.gear.all <- k.gear[AREA != 0, ]
-
-setkeyv(unk.gear.all, match.key)
-setkeyv(k.gear.all, match.key)
-
-gear.all <- k.gear.all[unk.gear.all]
-
-#No match - need to match with larger aggregation
-no.match <- gear.all[is.na(SPPLIVMT), ]
-no.match[, c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.GEAR', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop QY
-setkey(no.match, YEAR, NESPP3, HY, SIZE, AREA)
-setkeyv(k.gear.all, key(no.match))
-gear.all.2 <- k.gear.all[no.match]
-no.match.2 <- gear.all.2[is.na(SPPLIVMT), ]
-no.match.2[, c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop HY
-setkey(no.match.2, YEAR, NESPP3, SIZE, AREA)
-setkeyv(k.gear.all, key(no.match.2))
-gear.all.3 <- k.gear.all[no.match.2]
-no.match.3 <- gear.all.3[is.na(SPPLIVMT), ]
-no.match.3[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop SIZE
-setkey(no.match.3, YEAR, NESPP3, AREA)
-setkeyv(k.gear.all, key(no.match.3))
-gear.all.4 <- k.gear.all[no.match.3]
-no.match.4 <- gear.all.4[is.na(SPPLIVMT), ]
-no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Drop AREA
-setkey(no.match.4, YEAR, NESPP3)
-setkeyv(k.gear.all, key(no.match.4))
-gear.all.5 <- k.gear.all[no.match.4]
-no.match.5 <- gear.all.5[is.na(SPPLIVMT), ]
-no.match.5[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.5, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to GEAR to other
-no.match.5[, GEAR := factor('other', levels = levels(k.gear[, GEAR]))]
-
-#Merge all together and proportion catch to known gears
-gear.all <- gear.all [!is.na(SPPLIVMT), ]
-gear.all.2 <- gear.all.2[!is.na(SPPLIVMT), ]
-gear.all.2[, QY := i.QY]
-gear.all.2[, i.QY := NULL]
-setcolorder(gear.all.2, names(gear.all))
-gear.all.3 <- gear.all.3[!is.na(SPPLIVMT), ]
-gear.all.3[, QY := i.QY]
-gear.all.3[, HY := i.HY]
-gear.all.3[, i.QY := NULL]
-gear.all.3[, i.HY := NULL]
-setcolorder(gear.all.3, names(gear.all))
-gear.all.4 <- gear.all.4[!is.na(SPPLIVMT), ]
-gear.all.4[, QY := i.QY]
-gear.all.4[, HY := i.HY]
-gear.all.4[, SIZE := i.SIZE]
-gear.all.4[, i.QY := NULL]
-gear.all.4[, i.HY := NULL]
-gear.all.4[, i.SIZE := NULL]
-setcolorder(gear.all.4, names(gear.all))
-gear.all.5 <- gear.all.5[!is.na(SPPLIVMT), ]
-gear.all.5[, QY := i.QY]
-gear.all.5[, HY := i.HY]
-gear.all.5[, SIZE := i.SIZE]
-gear.all.5[, AREA := i.AREA]
-gear.all.5[, i.QY := NULL]
-gear.all.5[, i.HY := NULL]
-gear.all.5[, i.SIZE := NULL]
-gear.all.5[, i.AREA := NULL]
-setcolorder(gear.all.5, names(gear.all))
-
-gear.all <- rbindlist(list(gear.all, gear.all.2, gear.all.3,
- gear.all.4, gear.all.5))
-
-gear.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-gear.all[, unk := i.SPPLIVMT * prop]
-gear.all[, unk2 := i.SPPVALUE * prop]
-gear.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.GEAR',
- 'i.UTILCD', 'prop') := NULL]
-setnames(gear.all, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setcolorder(no.match.5, names(gear.all))
-gear.solved <- rbindlist(list(gear.all, no.match.5))
-rm(list = c(ls(pattern = 'gear.all'), ls(pattern = 'no.match')))
-
-#3.C.2 - Species only - no other match
-match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE')
-
-unk.gear.sp <- unk.gear[AREA == 0, ]
-unk.gear.sp[, 'AREA' := NULL]
-
-k.gear.sp <- k.gear[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(match.key, 'GEAR', 'UTILCD')]
-setnames(k.gear.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setkeyv(unk.gear.sp, match.key)
-setkeyv(k.gear.sp, match.key)
-
-gear.sp <- k.gear.sp[unk.gear.sp]
-
-#No match - need to match with larger aggregation
-no.match <- gear.sp[is.na(SPPLIVMT), ]
-no.match[, c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.GEAR', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop QY
-setkey(no.match, YEAR, NESPP3, HY, SIZE)
-setkeyv(k.gear.sp, key(no.match))
-gear.sp.2 <- k.gear.sp[no.match]
-no.match.2 <- gear.sp.2[is.na(SPPLIVMT), ]
-no.match.2[, c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.GEAR', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop HY
-setkey(no.match.2, YEAR, NESPP3, SIZE)
-setkeyv(k.gear.sp, key(no.match.2))
-gear.sp.3 <- k.gear.sp[no.match.2]
-no.match.3 <- gear.sp.3[is.na(SPPLIVMT), ]
-no.match.3[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop SIZE
-setkey(no.match.3, YEAR, NESPP3)
-setkeyv(k.gear.sp, key(no.match.3))
-gear.sp.4 <- k.gear.sp[no.match.3]
-no.match.4 <- gear.sp.4[is.na(SPPLIVMT), ]
-no.match.4[, c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.4, c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Still no match - assign to GEAR to other
-no.match.4[, GEAR := factor('other', levels = levels(k.gear[, GEAR]))]
-no.match.4[, AREA := 0]
-
-#Merge all together and proportion catch to known gears
-gear.sp <- gear.sp [!is.na(SPPLIVMT), ]
-gear.sp.2 <- gear.sp.2[!is.na(SPPLIVMT), ]
-gear.sp.2[, QY := i.QY]
-gear.sp.2[, i.QY := NULL]
-setcolorder(gear.sp.2, names(gear.sp))
-gear.sp.3 <- gear.sp.3[!is.na(SPPLIVMT), ]
-gear.sp.3[, QY := i.QY]
-gear.sp.3[, HY := i.HY]
-gear.sp.3[, i.QY := NULL]
-gear.sp.3[, i.HY := NULL]
-setcolorder(gear.sp.3, names(gear.sp))
-gear.sp.4 <- gear.sp.4[!is.na(SPPLIVMT), ]
-gear.sp.4[, QY := i.QY]
-gear.sp.4[, HY := i.HY]
-gear.sp.4[, SIZE := i.SIZE]
-gear.sp.4[, i.QY := NULL]
-gear.sp.4[, i.HY := NULL]
-gear.sp.4[, i.SIZE := NULL]
-setcolorder(gear.sp.4, names(gear.sp))
-
-gear.sp <- rbindlist(list(gear.sp, gear.sp.2, gear.sp.3, gear.sp.4))
-
-gear.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-gear.sp[, unk := i.SPPLIVMT * prop]
-gear.sp[, unk2 := i.SPPVALUE * prop]
-gear.sp[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.GEAR',
- 'i.UTILCD', 'prop') := NULL]
-setnames(gear.sp, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-gear.sp[, AREA := 0]
-
-setcolorder(gear.sp, names(gear.solved))
-setcolorder(no.match.4, names(gear.solved))
-gear.solved <- rbindlist(list(gear.solved, gear.sp, no.match.4))
-rm(list = c(ls(pattern = 'gear.sp'), ls(pattern = 'no.match')))
-
-#Merge back gear.solved
-setcolorder(gear.solved, names(comland.agg))
-comland.agg <- rbindlist(list(k.gear, gear.solved))
-setkey(comland.agg,
- YEAR,
- QY,
- HY,
- SIZE,
- GEAR,
- AREA,
- NESPP3,
- UTILCD)
-comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = key(comland.agg)]
-setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-#3.D AREA------------------------------------------------------------------------------
-unk.area <- comland.agg[AREA == 0, ]
-k.area <- comland.agg[AREA != 0, ]
-
-#3.C.1 - All match
-match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE', 'GEAR')
-
-unk.area.all <- unk.area
-
-k.area.all <- k.area
-
-setkeyv(unk.area.all, match.key)
-setkeyv(k.area.all, match.key)
-
-area.all <- k.area.all[unk.area.all]
-
-#No match - need to match with larger aggregation
-no.match <- area.all[is.na(SPPLIVMT), ]
-no.match[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop QY
-setkey(no.match, YEAR, NESPP3, HY, SIZE, GEAR)
-setkeyv(k.area.all, key(no.match))
-area.all.2 <- k.area.all[no.match]
-no.match.2 <- area.all.2[is.na(SPPLIVMT), ]
-no.match.2[, c('AREA', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.2, c('i.AREA', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT',
- 'i.SPPVALUE'),
- c('AREA', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop HY
-setkey(no.match.2, YEAR, NESPP3, SIZE, GEAR)
-setkeyv(k.area.all, key(no.match.2))
-area.all.3 <- k.area.all[no.match.2]
-no.match.3 <- area.all.3[is.na(SPPLIVMT), ]
-no.match.3[, c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.3, c('i.AREA', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT',
- 'i.SPPVALUE'),
- c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#Drop SIZE
-setkey(no.match.3, YEAR, NESPP3, GEAR)
-setkeyv(k.area.all, key(no.match.3))
-area.all.4 <- k.area.all[no.match.3]
-no.match.4 <- area.all.4[is.na(SPPLIVMT), ]
-no.match.4[, c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.4, c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD',
- 'SPPLIVMT', 'SPPVALUE'))
-#Drop GEAR
-setkey(no.match.4, YEAR, NESPP3)
-setkeyv(k.area.all, key(no.match.4))
-area.all.5 <- k.area.all[no.match.4]
-no.match.5 <- area.all.5[is.na(SPPLIVMT), ]
-no.match.5[, c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT',
- 'SPPVALUE') := NULL]
-setnames(no.match.5, c('i.AREA', 'i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD',
- 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT',
- 'SPPVALUE'))
-#Still no match - use 3 or 5 year window then drop year
-years <- unique(no.match.5[, YEAR], by = key(no.match.5))
-no.match.6 <- c()
-area.all.6 <- c()
-for(i in 1:length(years)){
- #3 year window
- k.area.3y <- comland.agg[AREA != 0 & YEAR %in% (years[i] - 1):(years[i] + 1), ]
- setkey(k.area.3y, NESPP3, AREA)
- k.area.3y <- k.area.3y[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(key(k.area.3y), 'UTILCD')]
- setnames(k.area.3y, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
- unk.area.3y <- no.match.5[YEAR == years[i], ]
-
- setkey(unk.area.3y, NESPP3)
- setkey(k.area.3y, NESPP3)
- area.3y <- k.area.3y[unk.area.3y]
-
- no.match.3y <- area.3y[is.na(SPPLIVMT), ]
- no.match.3y[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
- setnames(no.match.3y, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
- no.match.6 <- rbindlist(list(no.match.6, no.match.3y))
- area.all.6 <- rbindlist(list(area.all.6, area.3y))
-}
-
-years <- unique(no.match.6[, YEAR], by = key(no.match.6))
-no.match.7 <- c()
-area.all.7 <- c()
-for(i in 1:length(years)){
- #5 year window
- k.area.5y <- comland.agg[AREA != 0 & YEAR %in% (years[i] - 2):(years[i] + 2), ]
- setkey(k.area.5y, NESPP3, AREA)
- k.area.5y <- k.area.5y[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c(key(k.area.5y), 'UTILCD')]
- setnames(k.area.5y, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
- unk.area.5y <- no.match.6[YEAR == years[i], ]
-
- setkey(unk.area.5y, NESPP3)
- setkey(k.area.5y, NESPP3)
- area.5y <- k.area.5y[unk.area.5y]
-
- no.match.5y <- area.5y[is.na(SPPLIVMT), ]
- no.match.5y[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
- setnames(no.match.5y, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-
- no.match.7 <- rbindlist(list(no.match.7, no.match.5y))
- area.all.7 <- rbindlist(list(area.all.7, area.5y))
-}
-#Drop year
-setkey(no.match.7, NESPP3)
-k.area.all <- k.area.all[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = c('NESPP3', 'AREA', 'UTILCD')]
-setnames(k.area.all, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-setkey(k.area.all, NESPP3)
-
-area.all.8 <- k.area.all[no.match.7]
-no.match.8 <- area.all.8[is.na(SPPLIVMT), ]
-no.match.8[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
-setnames(no.match.8, c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
- c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE'))
-#If still no match - leave as unknown
-
-
-#Merge all together and proportion catch to known areas
-area.all <- area.all [!is.na(SPPLIVMT), ]
-area.all.2 <- area.all.2[!is.na(SPPLIVMT), ]
-area.all.2[, QY := i.QY]
-area.all.2[, i.QY := NULL]
-setcolorder(area.all.2, names(area.all))
-area.all.3 <- area.all.3[!is.na(SPPLIVMT), ]
-area.all.3[, QY := i.QY]
-area.all.3[, HY := i.HY]
-area.all.3[, i.QY := NULL]
-area.all.3[, i.HY := NULL]
-setcolorder(area.all.3, names(area.all))
-area.all.4 <- area.all.4[!is.na(SPPLIVMT), ]
-area.all.4[, QY := i.QY]
-area.all.4[, HY := i.HY]
-area.all.4[, SIZE := i.SIZE]
-area.all.4[, i.QY := NULL]
-area.all.4[, i.HY := NULL]
-area.all.4[, i.SIZE := NULL]
-setcolorder(area.all.4, names(area.all))
-area.all.5 <- area.all.5[!is.na(SPPLIVMT), ]
-area.all.5[, QY := i.QY]
-area.all.5[, HY := i.HY]
-area.all.5[, SIZE := i.SIZE]
-area.all.5[, GEAR := i.GEAR]
-area.all.5[, i.QY := NULL]
-area.all.5[, i.HY := NULL]
-area.all.5[, i.SIZE := NULL]
-area.all.5[, i.GEAR := NULL]
-setcolorder(area.all.5, names(area.all))
-area.all.6 <- area.all.6[!is.na(SPPLIVMT), ]
-setcolorder(area.all.6, names(area.all))
-area.all.7 <- area.all.7[!is.na(SPPLIVMT), ]
-setcolorder(area.all.7, names(area.all))
-area.all.8 <- area.all.8[!is.na(SPPLIVMT), ]
-setcolorder(area.all.8, names(area.all))
-
-area.all <- rbindlist(list(area.all, area.all.2, area.all.3, area.all.4,
- area.all.5, area.all.6, area.all.7, area.all.8))
-
-area.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
-area.all[, unk := i.SPPLIVMT * prop]
-area.all[, unk2 := i.SPPVALUE * prop]
-area.all[, c('SPPLIVMT', 'SPPVALUE', 'i.SPPLIVMT', 'i.SPPVALUE', 'i.AREA',
- 'i.UTILCD', 'prop') := NULL]
-setnames(area.all, c('unk','unk2'), c('SPPLIVMT', 'SPPVALUE'))
-
-setcolorder(no.match.8, names(area.all))
-area.solved <- rbindlist(list(area.all, no.match.8))
-rm(list = c(ls(pattern = 'area.all'), ls(pattern = 'no.match')))
-
-#Merge back area.solved
-setcolorder(area.solved, names(comland.agg))
-comland.agg <- rbindlist(list(k.area, area.solved))
-setkey(comland.agg,
- YEAR,
- QY,
- HY,
- SIZE,
- GEAR,
- AREA,
- NESPP3,
- UTILCD)
-comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)),
- by = key(comland.agg)]
-setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
-#-------------------------------------------------------------------------------
-if(sum.by == 'EPU'){
- #Assign EPU based on statarea
- gom<-c(500, 510, 512:515)
- gb<-c(521:526, 551, 552, 561, 562)
- mab<-c(537, 539, 600, 612:616, 621, 622, 625, 626, 631, 632)
- ss<-c(463:467, 511)
-
- comland.agg[AREA %in% gom, EPU := 'GOM']
- comland.agg[AREA %in% gb, EPU := 'GB']
- comland.agg[AREA %in% mab, EPU := 'MAB']
- comland.agg[AREA %in% ss, EPU := 'SS']
- comland.agg[is.na(EPU), EPU := 'OTHER']
- comland.agg[, EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))]
-
- setkey(comland.agg,
- YEAR,
- NESPP3,
- QY,
- GEAR,
- SIZE,
- EPU,
- UTILCD)
-
- comland.agg <- comland.agg[, list(sum(SPPLIVMT), sum(SPPVALUE)), by = key(comland.agg)]
-
- setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
-
- #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
- temp <- tempfile()
- download.file(
- "https://www.nafo.int/Portals/0/Stats/nafo-21b-60-69.zip?ver=2016-08-03-063915-850",
- temp)
- nafo.60 <- as.data.table(read.csv(unz(temp, "NAFO21B-60-69.txt")))
- unlink(temp)
- download.file(
- "https://www.nafo.int/Portals/0/Stats/nafo-21b-70-79.zip?ver=2016-08-03-063915-850",
- temp)
- nafo.70 <- as.data.table(read.csv(unz(temp, "NAFO21B-70-79.txt")))
- unlink(temp)
- download.file(
- "https://www.nafo.int/Portals/0/Stats/nafo-21b-80-89.zip?ver=2016-08-03-063915-850",
- temp)
- nafo.80 <- as.data.table(read.csv(unz(temp, "NAFO21B-80-89.txt")))
- unlink(temp)
- download.file(
- "https://www.nafo.int/Portals/0/Stats/nafo-21b-90-99.zip?ver=2016-08-03-063915-850",
- temp)
- nafo.90 <- as.data.table(read.csv(unz(temp, "NAFO21B-90-99.txt")))
- unlink(temp)
- download.file(
- "https://www.nafo.int/Portals/0/Stats/nafo-21b-2000-09.zip?ver=2016-08-03-063915-850",
- temp)
- nafo.00 <- as.data.table(read.csv(unz(temp, "NAFO21B-2000-09.txt")))
- unlink(temp)
- download.file(
- "https://www.nafo.int/Portals/0/Stats/nafo-21b-2010-15.zip?ver=2017-06-01-164323-460",
- temp)
- nafo.10 <- as.data.table(read.csv(unz(temp, "nafo-21b-2010-15/NAFO21B-2010-15.csv")))
- unlink(temp)
-
- #2010 + data have different column headers
- setnames(nafo.10,
- c('Gear', 'AreaCode', 'SpeciesEffort'),
- c('GearCode', 'Divcode', 'Code'))
-
- nafo <- rbindlist(list(nafo.60, nafo.70, nafo.80, nafo.90, nafo.00, nafo.10))
-
- #Remove US landings (Country code 22), extra divisions (use only 47, 51:56, 61:63),
- #and effort codes (1:3)
- nafo <- nafo[Country != 22 & Divcode %in% c(47, 51:56, 61:63) & Code > 3, ]
-
- #Deal with unknown monthly catch?????
-
- #Get nafo code in a similar format to comland
- nafoland <- nafo[, list(Year, GearCode, Tonnage, Divcode, Code, Catches)]
- nafoland[, MONTH := 0]
- 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, Code, get(month[i]))]
- nafoland.month[, MONTH := i]
- setnames(nafoland.month,
- names(nafoland.month)[6],
- 'SPPLIVMT')
- nafoland <- rbindlist(list(nafoland, nafoland.month))
- }
-
- nafoland <- nafoland[SPPLIVMT != 0,]
-
- nafoland[, EPU := factor(NA, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))]
- nafoland[Divcode == 47, EPU := 'SS']
- nafoland[Divcode == 51, EPU := 'GOM']
- nafoland[Divcode %in% c(52, 54:56), EPU := 'GB']
- nafoland[Divcode %in% c(53, 61:63), EPU := 'MAB']
- nafoland[is.na(EPU), EPU := 'OTHER']
-
- nafoland[, Divcode := NULL]
-
- ##Fix missing Scotian Shelf data from 21B
- SS.nafo <- as.data.table(read.csv(file.path(data.dir.3, "SS_NAFO_21A.csv"), skip = 8))
-
- #Add NAFOSPP code to SS.nafo
- nafo.spp <- as.data.table(read.csv(file.path(data.dir.3, 'species.txt')))
- setnames(nafo.spp, "Abbreviation", "Species_ASFIS")
- nafo.spp <- nafo.spp[, list(Code, Species_ASFIS)]
-
- SS.nafo <- merge(SS.nafo, nafo.spp, by = 'Species_ASFIS', all.x = T)
-
- #Only grab missing data
- SS.nafo <- SS.nafo[Year %in% c(2003, 2008, 2009), ]
-
- setkey(SS.nafo,
- Year,
- Code)
-
- SS.land <- SS.nafo[, sum(Catch...000.Kg.), by = key(SS.nafo)]
-
- setnames(SS.land, "V1", "SPPLIVMT")
-
- #Add GearCode, Tonnage, Month, and EPU
- SS.land[, GearCode := 99]
- SS.land[, Tonnage := 0]
- SS.land[, MONTH := 0]
- SS.land[, EPU := 'SS']
-
- setcolorder(SS.land, names(nafoland))
-
- nafoland <- rbindlist(list(nafoland, SS.land))
-
- #Rectify NAFO codes with US codes
- #Species
- setnames(nafoland,
- c('Year', 'GearCode', 'Tonnage', 'Code'),
- c('YEAR', 'NAFOGEAR', 'TONCL1', 'NAFOSPP'))
-
- spp <- as.data.table(sqlQuery(channel, "select NAFOSPP, NESPP3 from CFSPP"))
-
- #Fix missing NAFO codes
- missing.spp <- data.table(NAFOSPP = c(110, 141, 189, 480, 484, 487, 488, 489),
- NESPP3 = c(240, 509, 512, 366, 368, 367, 370, 369))
- spp <- rbindlist(list(spp, missing.spp))
-
- setkey(spp, NAFOSPP)
- spp <- unique(spp, by = key(spp))
-
- #Fix many to one relationships
- spp[NAFOSPP == 199, NESPP3 := 524]
- spp[NAFOSPP == 299, NESPP3 := 525]
- spp[NAFOSPP == 469, NESPP3 := 359]
- spp[NAFOSPP == 499, NESPP3 := 526]
- spp[NAFOSPP == 529, NESPP3 := 764]
- spp[NAFOSPP == 699, NESPP3 := 899]
-
- nafoland <- merge(nafoland, spp, by = 'NAFOSPP', all.x = T)
-
- #fix codes
- nafoland[NAFOSPP == 309, NESPP3 := 150L]
- nafoland[NAFOSPP == 462, NESPP3 := 481L]
- nafoland[NAFOSPP == 464, NESPP3 := 355L]
- nafoland[NAFOSPP == 468, NESPP3 := 493L]
- nafoland[NAFOSPP == 704, NESPP3 := 817L]
-
- #remove species without a match
- nafoland <- nafoland[!is.na(NESPP3), ]
-
- #Remove herring catch - already included from Maine Data earlier
- nafoland <- nafoland[NESPP3 != 168, ]
-
- #Gearcodes
- gear <- as.data.table(sqlQuery(channel, "select NEGEAR, NAFOGEAR from Gear"))
- gear <- unique(gear, by = 'NAFOGEAR')
-
- nafoland <- merge(nafoland, gear, by = 'NAFOGEAR', all.x = T)
-
- #fix codes
- nafoland[NAFOGEAR == 8, NEGEAR := 50L]
- nafoland[NAFOGEAR == 9, NEGEAR := 370L]
- nafoland[NAFOGEAR == 19, NEGEAR := 58L]
- nafoland[NAFOGEAR == 49, NEGEAR := 60L]
- nafoland[NAFOGEAR == 56, NEGEAR := 21L]
-
- #Tonnage
- nafoland[TONCL1 == 7, TONCL1 := 6L]
-
- #Drop NAFO codes
- nafoland[, c('NAFOGEAR', 'NAFOSPP') := NULL]
-
- #Fix skates
- #get little skates and winter skates from skates(ns) - use survey in half years
- #Generate Half year variable in comland
- nafoland.skates <- nafoland[NESPP3 == 365, ]
- nafoland.skates[MONTH %in% 1:6, Half := 1]
- nafoland.skates[MONTH %in% 7:12, Half := 2]
-
- setkey(skate.hake.nafo,
- YEAR,
- Half,
- EPU)
-
- nafoland.skates <- merge(nafoland.skates, skate.hake.nafo, by = key(skate.hake.nafo), all.x = T)
-
- nafoland.skates[NESPP3 == 365, little := little.per * SPPLIVMT]
- nafoland.skates[is.na(little), little := 0]
-
- nafoland.skates[NESPP3 == 365, winter := winter.per * SPPLIVMT]
- nafoland.skates[is.na(winter), winter := 0]
-
- nafoland.skates[NESPP3 == 365, other.skate := SPPLIVMT - (little + winter)]
-
- #Little (366), winter (367), skates(ns) (365)
- #put skates in nafoland format to merge back
- little <- nafoland.skates[, list(YEAR, Half, EPU, TONCL1, MONTH,
- NESPP3, NEGEAR, little)]
- little[, NESPP3 := 366L]
- setnames(little, "little", "SPPLIVMT")
- little <- little[SPPLIVMT > 0, ]
-
- winter <- nafoland.skates[, list(YEAR, Half, EPU, TONCL1, MONTH,
- NESPP3, NEGEAR, winter)]
- winter[, NESPP3 := 367L]
- setnames(winter, "winter", "SPPLIVMT")
- winter <- winter[SPPLIVMT > 0, ]
-
- other <- nafoland.skates[, list(YEAR, Half, EPU, TONCL1, MONTH,
- NESPP3, NEGEAR, other.skate)]
- other[, NESPP3 := 365L]
- setnames(other, "other.skate", "SPPLIVMT")
- other <- other[SPPLIVMT > 0, ]
-
- #merge all three and reformat for nafoland
- skates.add.back <- rbindlist(list(little, winter, other))
-
- skates.add.back[, Half := NULL]
- setcolorder(skates.add.back, names(nafoland))
-
- nafoland <- rbindlist(list(nafoland[NESPP3 != 365, ], skates.add.back))
-
- #aggregate nafo landings
- #2 - aggregate by quarter year, half year, major gear, and small/large TC
- 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]
-
- nafoland[NEGEAR %in% otter, GEAR := 'otter']
- nafoland[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc']
- nafoland[NEGEAR %in% pot, GEAR := 'pot']
- nafoland[NEGEAR %in% longline, GEAR := 'longline']
- nafoland[NEGEAR %in% seine, GEAR := 'seine']
- nafoland[NEGEAR %in% gillnet, GEAR := 'gillnet']
- nafoland[NEGEAR %in% midwater, GEAR := 'midwater']
- nafoland[NEGEAR %in% dredge.o, GEAR := 'dredge.o']
- nafoland[NEGEAR == 99, GEAR := 'unknown']
- nafoland[is.na(GEAR), GEAR := 'other']
- nafoland[, GEAR := as.factor(GEAR)]
-
- nafoland[TONCL1 %in% 1:3, SIZE := 'small']
- nafoland[TONCL1 > 3, SIZE := 'large']
- nafoland[TONCL1 == 0, SIZE := 'unknown']
- nafoland[, SIZE := as.factor(SIZE)]
-
- setkey(nafoland,
- YEAR,
- QY,
- GEAR,
- SIZE,
- EPU,
- NESPP3)
-
- nafoland.agg <- nafoland[, sum(SPPLIVMT), by = key(nafoland)]
-
- setnames(nafoland.agg, "V1", "SPPLIVMT")
-
- #Create dummy variable for value
- nafoland.agg[, SPPVALUE := 0]
- nafoland.agg[, UTILCD := 0]
-
- #Merge comland and nafoland
- setcolorder(nafoland.agg, names(comland.agg))
-
- if(foreign == 'y'){
- comland.agg[, US := T]
- nafoland.agg[, US := F]
- }
-
- comland.nafo <- rbindlist(list(comland.agg, nafoland.agg))
-
- #Remove Menhaden data
- #save(comland.nafo, file = paste(out.dir, "comland_Menhaden.RData", sep = ''))
- comland <- comland.nafo[NESPP3 != 221, ]
-}
-
-if(sum.by == 'stat.area') comland <- comland.agg
-
-#Output file
-if(landed == 'n') file.landed <- '' else file.landed <- '_meatwt'
-if(adjust.ppi == 'n') file.adjust <- '' else file.adjust <- '_deflated'
-if(sum.by == 'EPU') file.by <- '' else file.by <- '_stat_areas'
-file.name <- paste0('comland', file.landed, file.adjust, file.by, '.RData')
-
-save(comland, file = file.path(out.dir, file.name))
-#```
\ No newline at end of file
+# comm landings extraction
+
+#```{r comland, echo = T, eval = F}
+#Comland.r
+#Version now controlled by git - originally part of comcatch.r
+#Grab commercial landings data from US and Foreign countries (NAFO)
+#Need to fix menhaden data
+#SML
+
+#Requires the following files:
+# data.dir.2\\Comland_skates_hakes.R
+# data.dir\\Menhaden.csv
+# data.dir.3\\SS_NAFO_21A.csv
+# data.dir.3\\species.txt
+
+#User parameters
+if (Sys.info()['sysname'] == "Windows") {
+ data.dir <- "L:\\EcoAP\\Data\\Commercial"
+ data.dir.2 <- "L:\\Rworkspace\\RCom"
+ data.dir.3 <- "L:\\EcoAP\\Data\\NAFO"
+ out.dir <- "L:\\EcoAP\\Data\\Commercial"
+ memory.limit(4000)
+ channel <- odbcDriverConnect()
+}
+
+if (Sys.info()['sysname'] == "Linux") {
+ data.dir <- "/home/slucey/slucey/EcoAP/Data/Commercial"
+ data.dir.2 <- "/home/slucey/slucey/Rworkspace/RCom"
+ data.dir.3 <- "/home/slucey/slucey/EcoAP/Data/NAFO"
+ out.dir <- "/home/slucey/slucey/EcoAP/Data/Commercial"
+ uid <- 'slucey'
+ cat("Oracle Password: ")
+ pwd <- scan(stdin(), character(), n = 1)
+}
+
+landed <- 'y' #use landed weight for scallops and clams instead of live weight
+foreign <- 'y' #Mark foreign landings and keep seperate
+adjust.ppi <- 'y' #Adjust value for inflation
+use.existing <- 'n' #use raw data from a previous run - saves time
+sum.by <- 'EPU' #Variable to sum landings by [EPU, stat.area]
+
+#Final year of query
+endyear <- 2016
+#If adjusting for inflation
+refyear <- 2016
+refmonth <- 1
+
+#-------------------------------------------------------------------------------
+#Required packages
+library(RODBC)
+library(data.table)
+library(rgdal)
+
+#-------------------------------------------------------------------------------
+#User created functions
+#Convert NA's to zeros
+na.zero <- function(x) {
+ for (i in 1:length(x[1, ])) {
+ if (length(which(is.na(x[, i]))) > 0) {
+ x[which(is.na(x[, i])), i] <- 0
+ }
+ }
+ return(x)
+}
+
+#-------------------------------------------------------------------------------
+#Connect to database
+if (Sys.info()['sysname'] == "Windows") {
+ channel <- odbcDriverConnect()
+}
+if (Sys.info()['sysname'] == "Linux") {
+ channel <- odbcConnect('sole', uid, pwd)
+}
+
+if (use.existing == 'n') {
+ #Landings
+ tables <- c(
+ paste0('WOLANDS', 64:81),
+ paste0('WODETS', 82:93),
+ paste0('CFDETS', 1994:endyear, 'AA')
+ )
+
+ #Generate one table
+ comland <- c()
+ for (i in 1:length(tables)) {
+ landings.qry <- paste(
+ "select year, month, negear, toncl1, nespp3, nespp4, area,
+ spplivlb, spplndlb, sppvalue, utilcd
+ from",
+ tables[i]
+ )
+
+ comland.yr <- as.data.table(sqlQuery(channel, landings.qry))
+
+ setkey(
+ comland.yr,
+ YEAR,
+ MONTH,
+ NEGEAR,
+ TONCL1,
+ NESPP3,
+ NESPP4,
+ AREA,
+ UTILCD
+ )
+
+ if (landed == 'y') {
+ comland.yr[NESPP3 %in% 743:800, SPPLIVLB := SPPLNDLB]
+ }
+
+ #Sum landings and value
+ #landings
+ comland.yr[, V1 := sum(SPPLIVLB), by = key(comland.yr)]
+ #value
+ #Fix null values
+ comland.yr[is.na(SPPVALUE), SPPVALUE := 0]
+ comland.yr[, V2 := sum(SPPVALUE), by = key(comland.yr)]
+
+ #Remove extra rows/columns
+ comland.yr <- unique(comland.yr, by = key(comland.yr))
+ comland.yr[, c('SPPLIVLB', 'SPPLNDLB', 'SPPVALUE') := NULL]
+
+ #Rename summed columns
+ setnames(comland.yr, c('V1', 'V2'), c('SPPLIVLB', 'SPPVALUE'))
+
+ comland <- rbindlist(list(comland, comland.yr))
+ }
+
+ if (landed == 'n') {
+ save(comland, file = file.path(out.dir, "comland_raw_US.RData"))
+ }
+ #Last run 8/31/16
+ if (landed == 'y') {
+ save(comland, file = file.path(out.dir, "comland_raw_US_meatwt.RData"))
+ }
+ #Last run 1/25/18
+}
+if (use.existing == 'y') {
+ if (landed == 'n') {
+ load(file = file.path(out.dir, "comland_raw_US.RData"))
+ }
+ if (landed == 'y') {
+ load(file = file.path(out.dir, "comland_raw_US_meatwt.RData"))
+ }
+}
+
+#-------------------------------------------------------------------------------
+#Convert from lbs to metric tons
+comland[, SPPLIVMT := SPPLIVLB * 0.00045359237]
+comland[, SPPLIVLB := NULL]
+
+#fix years
+comland[YEAR < 100, YEAR := YEAR + 1900L]
+
+if (adjust.ppi == 'y') {
+ #Adjust SPPVALUE for inflation
+ temp <- tempfile()
+ download.file(
+ "http://download.bls.gov/pub/time.series/wp/wp.data.3.ProcessedFoods",
+ temp
+ )
+ inflate <- as.data.table(read.delim(temp))
+ unlink(temp)
+
+ inflate[, series_id := gsub(" ", "", inflate[, series_id])]
+ deflate <- inflate[series_id == "WPU0223", ]
+ deflate[, MONTH := as.numeric(substr(period, 2, 3))]
+ setnames(deflate, c('year', 'value'), c('YEAR', 'PPI'))
+ deflate <- deflate[, list(YEAR, MONTH, PPI)]
+
+ #Set yearly deflator to 0 instead of 13 to match unknown month designation
+ deflate[MONTH == 13, MONTH := 0]
+ deflate.base <- deflate[YEAR == refyear & MONTH == refmonth, PPI]
+
+ comland <- merge(comland, deflate, by = c('YEAR', 'MONTH'), all.x = T)
+ comland[, SPPVALUE := round((SPPVALUE * deflate.base) / PPI)]
+
+ #Remove extra column
+ comland[, PPI := NULL]
+}
+#Remove market categories of parts
+comland <- comland[
+ !NESPP4 %in%
+ c(
+ 119,
+ 123,
+ 125,
+ 127,
+ 812,
+ 819,
+ 828,
+ 829,
+ 1731,
+ 2351,
+ 2690,
+ 2699,
+ 3472,
+ as.numeric(paste(348:359, 8, sep = '')),
+ 3868,
+ as.numeric(paste(469:471, 4, sep = '')),
+ as.numeric(paste(480:499, 8, sep = '')),
+ 5018,
+ 5039,
+ 5261,
+ 5265
+ ),
+]
+
+#Generate NESPP3 and MKTCAT in comland data
+comland[NESPP4 < 100, MKTCAT := as.numeric(substring(NESPP4, 2, 2))]
+comland[
+ NESPP4 > 99 & NESPP4 < 1000,
+ MKTCAT := as.numeric(substring(NESPP4, 3, 3))
+]
+comland[NESPP4 > 999, MKTCAT := as.numeric(substring(NESPP4, 4, 4))]
+
+#drop NESPP4
+comland[, NESPP4 := NULL]
+
+#Deal with Hakes and Skates------------------------------------------------------------------
+source(file.path(data.dir.2, 'Comland_skates_hakes.R'))
+
+#get little skates and winter skates from skates(ns) - use survey in half years
+#Generate Half year variable in comland
+comland.skates <- comland[NESPP3 == 365, ]
+comland.skates[MONTH %in% 1:6, Half := 1]
+comland.skates[MONTH %in% 7:12, Half := 2]
+
+setkey(skate.hake.us, YEAR, Half, AREA)
+
+comland.skates <- merge(
+ comland.skates,
+ skate.hake.us,
+ by = key(skate.hake.us),
+ all.x = T
+)
+
+comland.skates[, little := little.per * SPPLIVMT]
+comland.skates[, little.value := round(little.per * SPPVALUE)]
+comland.skates[is.na(little), little := 0]
+comland.skates[is.na(little.value), little.value := 0]
+
+comland.skates[, winter := winter.per * SPPLIVMT]
+comland.skates[, winter.value := round(winter.per * SPPVALUE)]
+comland.skates[is.na(winter), winter := 0]
+comland.skates[is.na(winter.value), winter.value := 0]
+
+comland.skates[, other.skate := SPPLIVMT - (little + winter)]
+comland.skates[, other.skate.value := SPPVALUE - (little.value + winter.value)]
+
+#Little (366), winter (367), skates(ns) (365)
+#put skates in comland format to merge back
+little <- comland.skates[, list(
+ YEAR,
+ Half,
+ AREA,
+ MONTH,
+ NEGEAR,
+ TONCL1,
+ NESPP3,
+ UTILCD,
+ MKTCAT,
+ little,
+ little.value
+)]
+little[, NESPP3 := 366]
+setnames(little, c('little', 'little.value'), c('SPPLIVMT', 'SPPVALUE'))
+little <- little[SPPLIVMT > 0, ]
+
+winter <- comland.skates[, list(
+ YEAR,
+ Half,
+ AREA,
+ MONTH,
+ NEGEAR,
+ TONCL1,
+ NESPP3,
+ UTILCD,
+ MKTCAT,
+ winter,
+ winter.value
+)]
+winter[, NESPP3 := 367]
+setnames(winter, c('winter', 'winter.value'), c('SPPLIVMT', 'SPPVALUE'))
+winter <- winter[SPPLIVMT > 0, ]
+
+other <- comland.skates[, list(
+ YEAR,
+ Half,
+ AREA,
+ MONTH,
+ NEGEAR,
+ TONCL1,
+ NESPP3,
+ UTILCD,
+ MKTCAT,
+ other.skate,
+ other.skate.value
+)]
+other[, NESPP3 := 365]
+setnames(
+ other,
+ c('other.skate', 'other.skate.value'),
+ c('SPPLIVMT', 'SPPVALUE')
+)
+other <- other[SPPLIVMT > 0, ]
+
+#merge all three and reformat for comland
+skates.add.back <- rbindlist(list(little, winter, other))
+
+skates.add.back[, Half := NULL]
+setcolorder(skates.add.back, names(comland))
+
+comland <- rbindlist(list(comland[NESPP3 != 365, ], skates.add.back))
+
+#get silver hake from mixed hakes - use survey in half years
+#Generate Half year variable in comland
+comland.hakes <- comland[NESPP3 == 507, ]
+comland.hakes[MONTH %in% 1:6, Half := 1]
+comland.hakes[MONTH %in% 7:12, Half := 2]
+
+comland.hakes <- merge(
+ comland.hakes,
+ skate.hake.us,
+ by = key(skate.hake.us),
+ all.x = T
+)
+
+comland.hakes[, silver := silver.per * SPPLIVMT]
+comland.hakes[, silver.value := round(silver.per * SPPVALUE)]
+comland.hakes[is.na(silver), silver := 0]
+comland.hakes[is.na(silver.value), silver.value := 0]
+
+comland.hakes[, off.hake := SPPLIVMT - silver]
+comland.hakes[, off.hake.value := SPPVALUE - silver.value]
+
+#Silver hake (509), mix hakes (507)
+#put hakes in comland format to merge back
+silver <- comland.hakes[, list(
+ YEAR,
+ Half,
+ AREA,
+ MONTH,
+ NEGEAR,
+ TONCL1,
+ NESPP3,
+ UTILCD,
+ MKTCAT,
+ silver,
+ silver.value
+)]
+silver[, NESPP3 := 509]
+setnames(silver, c('silver', 'silver.value'), c('SPPLIVMT', 'SPPVALUE'))
+silver <- silver[SPPLIVMT > 0, ]
+
+offshore <- comland.hakes[, list(
+ YEAR,
+ Half,
+ AREA,
+ MONTH,
+ NEGEAR,
+ TONCL1,
+ NESPP3,
+ UTILCD,
+ MKTCAT,
+ off.hake,
+ off.hake.value
+)]
+offshore[, NESPP3 := 507]
+setnames(offshore, c('off.hake', 'off.hake.value'), c('SPPLIVMT', 'SPPVALUE'))
+offshore <- offshore[SPPLIVMT > 0, ]
+
+#merge both and reformat for comland
+hakes.add.back <- rbindlist(list(silver, offshore))
+
+hakes.add.back[, Half := NULL]
+setcolorder(hakes.add.back, names(comland))
+
+comland <- rbindlist(list(comland[NESPP3 != 507, ], hakes.add.back))
+
+
+#Herring---------------------------------------------------------------------------------
+#Herring data is housed by the state of Maine.
+herr.qry <- "select year, month, stock_area, negear, gearname, keptmt, discmt
+ from maine_herring_catch"
+
+herr.catch <- as.data.table(sqlQuery(channel, herr.qry))
+setkey(herr.catch, YEAR, MONTH, STOCK_AREA, NEGEAR)
+
+herring <- herr.catch[, list(sum(KEPTMT), sum(DISCMT)), by = key(herr.catch)]
+setnames(herring, c('STOCK_AREA', 'V1', 'V2'), c('AREA', 'SPPLIVMT', 'DISCMT'))
+
+#Using averages from comland to fill in categories
+herring[, MKTCAT := 5]
+herring[, TONCL1 := 2]
+herring[, UTILCD := 0]
+
+#compute price/utilization from CF tables
+herring.comland <- comland[NESPP3 == 168, ]
+#Price from comland
+herring.price <- herring.comland[,
+ (sum(SPPVALUE) / sum(SPPLIVMT)),
+ by = c('YEAR', 'MONTH')
+]
+setnames(herring.price, 'V1', 'price')
+herring <- merge(herring, herring.price, by = c('YEAR', 'MONTH'), all.x = T)
+#Use 1964 prices for < 1964
+herring[YEAR < 1964, price := mean(herring[YEAR == 1964, price])]
+#Calculate SPPVALUE from price
+herring[, SPPVALUE := round(price * SPPLIVMT)]
+
+#Utilization from comland
+herring.util <- herring.comland[,
+ sum(SPPLIVMT),
+ by = c('YEAR', 'MONTH', 'UTILCD')
+]
+setnames(herring.util, 'V1', 'SPPLIVMT')
+herring.util[, SPPLIVMT.ALL := sum(SPPLIVMT), by = c('YEAR', 'MONTH')]
+herring.util[, Prop := SPPLIVMT / SPPLIVMT.ALL]
+setorder(herring.util, YEAR, MONTH, Prop)
+herring.util[, cum.prop := cumsum(Prop), by = c('YEAR', 'MONTH')]
+
+#Apply proportions to Maine data set
+#Not pulled all the time - current through 2017
+herring[, Total := sum(SPPLIVMT), by = c('YEAR', 'MONTH')]
+herring[, Prop := SPPLIVMT / Total]
+setorder(herring, YEAR, MONTH, Prop)
+herring[, cum.prop := cumsum(Prop), by = c('YEAR', 'MONTH')]
+
+for (iyear in unique(herring.util[, YEAR])) {
+ for (imonth in unique(herring.util[YEAR == iyear, MONTH])) {
+ cum.prop.low <- 0
+ for (iutil in herring.util[YEAR == iyear & MONTH == imonth, UTILCD]) {
+ cum.prop.high <- herring.util[
+ YEAR == iyear & MONTH == imonth & UTILCD == iutil,
+ cum.prop
+ ]
+ herring[
+ YEAR == iyear &
+ MONTH == imonth &
+ cum.prop <= cum.prop.high &
+ cum.prop > cum.prop.low,
+ UTILCD := iutil
+ ]
+ cum.prop.low <- cum.prop.high
+ }
+ }
+}
+
+#fix column headings
+herring[, c('Total', 'Prop', 'cum.prop', 'price', 'DISCMT') := NULL]
+herring[, NESPP3 := 168]
+setcolorder(herring, names(comland))
+
+#remove herring from data pull and add in Maine numbers
+comland <- rbindlist(list(comland[NESPP3 != 168, ], herring))
+
+#Menhaden------------------------------------------------------------------------------------
+##fix menhaden records - data from Tom Miller/ Andre Bouchheister
+#menhaden <- as.data.table(read.csv(paste(data.dir, "Menhaden.csv", sep = '')))
+#menhaden.mab <- menhaden[, MA.Total + CB.Total, by = Year]
+##file metric is 1000s of lbs - convert to mt
+#menhaden.mab[, SPPLIVMT := (V1 * 1000) * 0.00045359237]
+#menhaden.mab[, V1 := NULL]
+#
+#menhaden.gom <- menhaden[, list(Year, NE.Total)]
+#menhaden.gom[, SPPLIVMT := (NE.Total * 1000) * 0.00045359237]
+#menhaden.gom[, NE.Total := NULL]
+
+#save(comland, file = paste(out.dir, "Comland_unkA.RData", sep = ''))
+
+#Deal with unknowns-------------------------------------------------------------------------
+comland[NEGEAR == 999, NEGEAR := 0]
+comland[is.na(TONCL1), TONCL1 := 0]
+comland[is.na(AREA), AREA := as.factor(0)]
+comland[AREA == 999, AREA := as.factor(0)]
+comland[is.na(MKTCAT), MKTCAT := 0]
+comland[is.na(UTILCD), UTILCD := 0]
+
+#1 - drop unknown species/landings
+comland <- comland[NESPP3 != 0 & SPPLIVMT != 0, ]
+
+#Sumarry tables
+#missing area
+#known.area <- comland[AREA != 0, sum(SPPLIVMT), by = NESPP3]
+#unknown.area <- comland[AREA == 0, sum(SPPLIVMT), by = NESPP3]
+#setnames(known.area, "V1", "AREA.MT.known")
+#setnames(unknown.area, "V1", "AREA.MT.unknown")
+#missing.table <- merge(known.area, unknown.area, by = 'NESPP3', all = T)
+#
+#missing.table[is.na(AREA.MT.known), AREA.MT.known := 0]
+#missing.table[is.na(AREA.MT.unknown), AREA.MT.unknown := 0]
+#missing.table[, AREA.Ratio := AREA.MT.unknown / AREA.MT.known]
+#
+##missing month
+#known.month <- comland[MONTH != 0, sum(SPPLIVMT), by = NESPP3]
+#unknown.month <- comland[MONTH == 0, sum(SPPLIVMT), by = NESPP3]
+#setnames(known.month, "V1", "MONTH.MT.known")
+#setnames(unknown.month, "V1", "MONTH.MT.unknown")
+#missing.table <- merge(missing.table, known.month, by = 'NESPP3', all = T)
+#missing.table <- merge(missing.table, unknown.month, by = 'NESPP3', all = T)
+#
+#missing.table[is.na(MONTH.MT.known), MONTH.MT.known := 0]
+#missing.table[is.na(MONTH.MT.unknown), MONTH.MT.unknown := 0]
+#missing.table[, MONTH.Ratio := MONTH.MT.unknown / MONTH.MT.known]
+#
+##missing gear
+#known.gear <- comland[NEGEAR != 0, sum(SPPLIVMT), by = NESPP3]
+#unknown.gear <- comland[NEGEAR == 0, sum(SPPLIVMT), by = NESPP3]
+#setnames(known.gear, "V1", "GEAR.MT.known")
+#setnames(unknown.gear, "V1", "GEAR.MT.unknown")
+#missing.table <- merge(missing.table, known.gear, by = 'NESPP3', all = T)
+#missing.table <- merge(missing.table, unknown.gear, by = 'NESPP3', all = T)
+#
+#missing.table[is.na(GEAR.MT.known), GEAR.MT.known := 0]
+#missing.table[is.na(GEAR.MT.unknown), GEAR.MT.unknown := 0]
+#missing.table[, GEAR.Ratio := GEAR.MT.unknown / GEAR.MT.known]
+#
+##missing tonnage class
+#known.tc <- comland[TONCL1 != 0, sum(SPPLIVMT), by = NESPP3]
+#unknown.tc <- comland[TONCL1 == 0, sum(SPPLIVMT), by = NESPP3]
+#setnames(known.tc, "V1", "TC.MT.known")
+#setnames(unknown.tc, "V1", "TC.MT.unknown")
+#missing.table <- merge(missing.table, known.tc, by = 'NESPP3', all = T)
+#missing.table <- merge(missing.table, unknown.tc, by = 'NESPP3', all = T)
+#
+#missing.table[is.na(TC.MT.known), TC.MT.known := 0]
+#missing.table[is.na(TC.MT.unknown), TC.MT.unknown := 0]
+#missing.table[, TC.Ratio := TC.MT.unknown / TC.MT.known]
+#
+#write.csv(missing.table, paste(out.dir, "\\Missing_table.csv", sep = ''), row.names = F)
+#
+
+#2 - aggregate by quarter year, half year, major gear, and small/large TC
+comland[MONTH %in% 1:3, QY := 1]
+comland[MONTH %in% 4:6, QY := 2]
+comland[MONTH %in% 7:9, QY := 3]
+comland[MONTH %in% 10:12, QY := 4]
+comland[MONTH == 0, QY := 0]
+
+comland[MONTH %in% 1:6, HY := 1]
+comland[MONTH %in% 7:12, HY := 2]
+comland[MONTH == 0, HY := 0]
+
+otter <- 50:59
+dredge.sc <- 131:132
+pot <- c(189:190, 200:219, 300, 301)
+longline <- c(10, 40)
+seine <- c(70:79, 120:129, 360)
+gillnet <- c(100:119, 500, 510, 520)
+midwater <- c(170, 370)
+dredge.o <- c(281, 282, 380:400)
+
+comland[NEGEAR %in% otter, GEAR := 'otter']
+comland[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc']
+comland[NEGEAR %in% pot, GEAR := 'pot']
+comland[NEGEAR %in% longline, GEAR := 'longline']
+comland[NEGEAR %in% seine, GEAR := 'seine']
+comland[NEGEAR %in% gillnet, GEAR := 'gillnet']
+comland[NEGEAR %in% midwater, GEAR := 'midwater']
+comland[NEGEAR %in% dredge.o, GEAR := 'dredge.o']
+comland[NEGEAR == 0, GEAR := 'unknown']
+comland[is.na(GEAR), GEAR := 'other']
+comland[, GEAR := as.factor(GEAR)]
+
+comland[TONCL1 %in% 1:3, SIZE := 'small']
+comland[TONCL1 > 3, SIZE := 'large']
+comland[TONCL1 == 0, SIZE := 'unknown']
+comland[, SIZE := as.factor(SIZE)]
+
+setkey(comland, YEAR, QY, HY, GEAR, SIZE, AREA, NESPP3, UTILCD)
+
+comland.agg <- comland[, list(sum(SPPLIVMT), sum(SPPVALUE)), by = key(comland)]
+
+setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+#3 - Use proportions of known catch to assign unknown catch
+#3.A QY/HY------------------------------------------------------------------------------
+unk.month <- comland.agg[QY == 0, ]
+k.month <- comland.agg[QY != 0, ]
+
+#3.A.1 - All match
+match.key <- c('YEAR', 'NESPP3', 'GEAR', 'SIZE', 'AREA')
+
+unk.month.all <- unk.month[GEAR != 'unknown']
+unk.month.all <- unk.month.all[SIZE != 'unknown', ]
+unk.month.all <- unk.month.all[AREA != 0, ]
+
+k.month.all <- k.month[GEAR != 'unknown', ]
+k.month.all <- k.month.all[SIZE != 'unknown', ]
+k.month.all <- k.month.all[AREA != 0, ]
+
+setkeyv(unk.month.all, match.key)
+setkeyv(k.month.all, match.key)
+
+month.all <- k.month.all[unk.month.all]
+
+#No match - need to match with larger aggregation
+no.match <- month.all[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop SIZE
+setkey(no.match, YEAR, NESPP3, AREA, GEAR)
+setkeyv(k.month.all, key(no.match))
+month.all.2 <- k.month.all[no.match]
+no.match.2 <- month.all.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop GEAR
+setkey(no.match.2, YEAR, NESPP3, AREA)
+setkeyv(k.month.all, key(no.match.2))
+month.all.3 <- k.month.all[no.match.2]
+no.match.3 <- month.all.3[is.na(SPPLIVMT), ]
+no.match.3[,
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.3,
+ c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop AREA
+setkey(no.match.3, YEAR, NESPP3)
+setkeyv(k.month.all, key(no.match.3))
+month.all.4 <- k.month.all[no.match.3]
+no.match.4 <- month.all.4[is.na(SPPLIVMT), ]
+no.match.4[,
+ c(
+ 'AREA',
+ 'GEAR',
+ 'SIZE',
+ 'QY',
+ 'HY',
+ 'UTILCD',
+ 'SPPLIVMT',
+ 'SPPVALUE'
+ ) := NULL
+]
+setnames(
+ no.match.4,
+ c(
+ 'i.AREA',
+ 'i.GEAR',
+ 'i.SIZE',
+ 'i.QY',
+ 'i.HY',
+ 'i.UTILCD',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE'
+ ),
+ c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to first QY/HY
+no.match.4[, c('QY', 'HY') := 1]
+
+#Merge all together and proportion catch to known months
+month.all <- month.all[!is.na(SPPLIVMT), ]
+month.all.2 <- month.all.2[!is.na(SPPLIVMT), ]
+month.all.2[, SIZE := i.SIZE]
+month.all.2[, i.SIZE := NULL]
+setcolorder(month.all.2, names(month.all))
+month.all.3 <- month.all.3[!is.na(SPPLIVMT), ]
+month.all.3[, GEAR := i.GEAR]
+month.all.3[, SIZE := i.SIZE]
+month.all.3[, i.GEAR := NULL]
+month.all.3[, i.SIZE := NULL]
+setcolorder(month.all.3, names(month.all))
+month.all.4 <- month.all.4[!is.na(SPPLIVMT), ]
+month.all.4[, AREA := i.AREA]
+month.all.4[, GEAR := i.GEAR]
+month.all.4[, SIZE := i.SIZE]
+month.all.4[, i.AREA := NULL]
+month.all.4[, i.GEAR := NULL]
+month.all.4[, i.SIZE := NULL]
+setcolorder(month.all.4, names(month.all))
+
+month.all <- rbindlist(list(month.all, month.all.2, month.all.3, month.all.4))
+
+month.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.all[, unk := i.SPPLIVMT * prop]
+month.all[, unk2 := i.SPPVALUE * prop]
+month.all[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.all, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setcolorder(no.match.4, names(month.all))
+month.solved <- rbindlist(list(month.all, no.match.4))
+rm(list = c(ls(pattern = 'month.all'), ls(pattern = 'no.match')))
+
+#3.A.2 - GEAR/SIZE
+match.key <- c('YEAR', 'NESPP3', 'GEAR', 'SIZE')
+
+unk.month.g.s <- unk.month[GEAR != 'unknown']
+unk.month.g.s <- unk.month.g.s[SIZE != 'unknown', ]
+unk.month.g.s <- unk.month.g.s[AREA == 0, ]
+unk.month.g.s <- unk.month.g.s[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(unk.month.g.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+k.month.g.s <- k.month[GEAR != 'unknown', ]
+k.month.g.s <- k.month.g.s[SIZE != 'unknown', ]
+k.month.g.s <- k.month.g.s[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(k.month.g.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.month.g.s, match.key)
+setkeyv(k.month.g.s, match.key)
+
+month.g.s <- k.month.g.s[unk.month.g.s]
+
+#No match - need to match with larger aggregation
+no.match <- month.g.s[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop SIZE
+setkey(no.match, YEAR, NESPP3, GEAR)
+setkeyv(k.month.g.s, key(no.match))
+month.g.s.2 <- k.month.g.s[no.match]
+no.match.2 <- month.g.s.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop GEAR
+setkey(no.match.2, YEAR, NESPP3)
+setkeyv(k.month.g.s, key(no.match.2))
+month.g.s.3 <- k.month.g.s[no.match.2]
+no.match.3 <- month.g.s.3[is.na(SPPLIVMT), ]
+no.match.3[,
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.3,
+ c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to first QY/HY
+no.match.3[, c('QY', 'HY') := 1]
+no.match.3[, AREA := 0]
+
+#Merge all together and proportion catch to known months
+month.g.s <- month.g.s[!is.na(SPPLIVMT), ]
+month.g.s.2 <- month.g.s.2[!is.na(SPPLIVMT), ]
+if (nrow(month.g.s.2) > 0) {
+ month.g.s.2[, SIZE := i.SIZE]
+ month.g.s.2[, i.SIZE := NULL]
+ setcolorder(month.g.s.2, names(month.g.s))
+ month.g.s <- rbindlist(list(month.g.s, month.g.s.2))
+}
+month.g.s.3 <- month.g.s.3[!is.na(SPPLIVMT), ]
+if (nrow(month.g.s.3) > 0) {
+ month.g.s.3[, GEAR := i.GEAR]
+ month.g.s.3[, SIZE := i.SIZE]
+ month.g.s.3[, i.GEAR := NULL]
+ month.g.s.3[, i.SIZE := NULL]
+ setcolorder(month.g.s.3, names(month.g.s))
+ month.g.s <- rbindlist(list(month.g.s, month.g.s.3))
+}
+
+month.g.s[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.g.s[, unk := i.SPPLIVMT * prop]
+month.g.s[, unk2 := i.SPPVALUE * prop]
+month.g.s[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.g.s, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+month.g.s[, AREA := 0]
+
+setcolorder(month.g.s, names(month.solved))
+setcolorder(no.match.3, names(month.solved))
+month.solved <- rbindlist(list(month.solved, month.g.s, no.match.3))
+rm(list = c(ls(pattern = 'month.g.s'), ls(pattern = 'no.match')))
+
+#3.A.3 - AREA/GEAR
+match.key <- c('YEAR', 'NESPP3', 'GEAR', 'AREA')
+
+unk.month.a.g <- unk.month[GEAR != 'unknown']
+unk.month.a.g <- unk.month.a.g[SIZE == 'unknown', ]
+unk.month.a.g <- unk.month.a.g[AREA != 0, ]
+unk.month.a.g <- unk.month.a.g[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(unk.month.a.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+k.month.a.g <- k.month[GEAR != 'unknown', ]
+k.month.a.g <- k.month.a.g[AREA != 0, ]
+k.month.a.g <- k.month.a.g[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(k.month.a.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.month.a.g, match.key)
+setkeyv(k.month.a.g, match.key)
+
+month.a.g <- k.month.a.g[unk.month.a.g]
+
+#No match - need to match with larger aggregation
+no.match <- month.a.g[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop GEAR
+setkey(no.match, YEAR, NESPP3, AREA)
+setkeyv(k.month.a.g, key(no.match))
+month.a.g.2 <- k.month.a.g[no.match]
+no.match.2 <- month.a.g.2[is.na(SPPLIVMT), ]
+no.match.2[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop AREA
+setkey(no.match.2, YEAR, NESPP3)
+setkeyv(k.month.a.g, key(no.match.2))
+month.a.g.3 <- k.month.a.g[no.match.2]
+no.match.3 <- month.a.g.3[is.na(SPPLIVMT), ]
+no.match.3[,
+ c('AREA', 'GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.3,
+ c('i.AREA', 'i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to first QY/HY
+no.match.3[, c('QY', 'HY') := 1]
+no.match.3[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+
+#Merge all together and proportion catch to known months
+month.a.g <- month.a.g[!is.na(SPPLIVMT), ]
+month.a.g.2 <- month.a.g.2[!is.na(SPPLIVMT), ]
+if (nrow(month.a.g.2) > 0) {
+ month.a.g.2[, GEAR := i.GEAR]
+ month.a.g.2[, i.GEAR := NULL]
+ setcolorder(month.a.g.2, names(month.a.g))
+ month.a.g <- rbindlist(list(month.a.g, month.a.g.2))
+}
+month.a.g.3 <- month.a.g.3[!is.na(SPPLIVMT), ]
+if (nrow(month.a.g.3) > 0) {
+ month.a.g.3[, AREA := i.AREA]
+ month.a.g.3[, GEAR := i.GEAR]
+ month.a.g.3[, i.AREA := NULL]
+ month.a.g.3[, i.GEAR := NULL]
+ setcolorder(month.a.g.3, names(month.a.g))
+ month.a.g <- rbindlist(list(month.a.g, month.a.g.3))
+}
+
+month.a.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.a.g[, unk := i.SPPLIVMT * prop]
+month.a.g[, unk2 := i.SPPVALUE * prop]
+month.a.g[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.a.g, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+month.a.g[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+
+setcolorder(month.a.g, names(month.solved))
+setcolorder(no.match.3, names(month.solved))
+month.solved <- rbindlist(list(month.solved, month.a.g, no.match.3))
+rm(list = c(ls(pattern = 'month.a.g'), ls(pattern = 'no.match')))
+
+#3.A.4 - AREA/TC
+match.key <- c('YEAR', 'NESPP3', 'SIZE', 'AREA')
+
+unk.month.a.s <- unk.month[GEAR == 'unknown']
+unk.month.a.s <- unk.month.a.s[SIZE != 'unknown', ]
+unk.month.a.s <- unk.month.a.s[AREA != 0, ]
+unk.month.a.s <- unk.month.a.s[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(unk.month.a.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+k.month.a.s <- k.month[SIZE != 'unknown', ]
+k.month.a.s <- k.month.a.s[AREA != 0, ]
+k.month.a.s <- k.month.a.s[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(k.month.a.s, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.month.a.s, match.key)
+setkeyv(k.month.a.s, match.key)
+
+month.a.s <- k.month.a.s[unk.month.a.s]
+
+#No match - need to match with larger aggregation
+no.match <- month.a.s[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop SIZE
+setkey(no.match, YEAR, NESPP3, AREA)
+setkeyv(k.month.a.s, key(no.match))
+month.a.s.2 <- k.month.a.s[no.match]
+no.match.2 <- month.a.s.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop AREA
+setkey(no.match.2, YEAR, NESPP3)
+setkeyv(k.month.a.s, key(no.match.2))
+month.a.s.3 <- k.month.a.s[no.match.2]
+no.match.3 <- month.a.s.3[is.na(SPPLIVMT), ]
+no.match.3[,
+ c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.3,
+ c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to first QY/HY
+no.match.3[, c('QY', 'HY') := 1]
+no.match.3[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+
+#Merge all together and proportion catch to known months
+month.a.s <- month.a.s[!is.na(SPPLIVMT), ]
+month.a.s.2 <- month.a.s.2[!is.na(SPPLIVMT), ]
+if (nrow(month.a.s.2) > 0) {
+ month.a.s.2[, SIZE := i.SIZE]
+ month.a.s.2[, i.SIZE := NULL]
+ setcolorder(month.a.s.2, names(month.a.s))
+ month.a.s <- rbindlist(list(month.a.s, month.a.s.2))
+}
+month.a.s.3 <- month.a.s.3[!is.na(SPPLIVMT), ]
+if (nrow(month.a.s.3) > 0) {
+ month.a.s.3[, AREA := i.AREA]
+ month.a.s.3[, SIZE := i.SIZE]
+ month.a.s.3[, i.AREA := NULL]
+ month.a.s.3[, i.SIZE := NULL]
+ setcolorder(month.a.s.3, names(month.a.s))
+ month.a.s <- rbindlist(list(month.a.s, month.a.s.3))
+}
+
+month.a.s[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.a.s[, unk := i.SPPLIVMT * prop]
+month.a.s[, unk2 := i.SPPVALUE * prop]
+month.a.s[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.a.s, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+month.a.s[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+
+setcolorder(month.a.s, names(month.solved))
+setcolorder(no.match.3, names(month.solved))
+month.solved <- rbindlist(list(month.solved, month.a.s, no.match.3))
+rm(list = c(ls(pattern = 'month.a.s'), ls(pattern = 'no.match')))
+
+#3.A.5 - SIZE
+match.key <- c('YEAR', 'NESPP3', 'SIZE')
+
+unk.month.si <- unk.month[GEAR == 'unknown']
+unk.month.si <- unk.month.si[SIZE != 'unknown', ]
+unk.month.si <- unk.month.si[AREA == 0, ]
+unk.month.si <- unk.month.si[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(unk.month.si, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+k.month.si <- k.month[SIZE != 'unknown', ]
+k.month.si <- k.month.si[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(k.month.si, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.month.si, match.key)
+setkeyv(k.month.si, match.key)
+
+month.si <- k.month.si[unk.month.si]
+
+#No match - need to match with larger aggregation
+no.match <- month.si[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop SIZE
+setkey(no.match, YEAR, NESPP3)
+setkeyv(k.month.si, key(no.match))
+month.si.2 <- k.month.si[no.match]
+no.match.2 <- month.si.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to first QY/HY
+no.match.2[, c('QY', 'HY') := 1]
+no.match.2[, AREA := 0]
+no.match.2[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+
+#Merge all together and proportion catch to known months
+month.si <- month.si[!is.na(SPPLIVMT), ]
+month.si.2 <- month.si.2[!is.na(SPPLIVMT), ]
+if (nrow(month.si.2) > 0) {
+ month.si.2[, SIZE := i.SIZE]
+ month.si.2[, i.SIZE := NULL]
+ setcolorder(month.si.2, names(month.si))
+ month.si <- rbindlist(list(month.si, month.si.2))
+}
+
+month.si[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.si[, unk := i.SPPLIVMT * prop]
+month.si[, unk2 := i.SPPVALUE * prop]
+month.si[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.si, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+month.si[, AREA := 0]
+month.si[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+
+setcolorder(month.si, names(month.solved))
+setcolorder(no.match.2, names(month.solved))
+month.solved <- rbindlist(list(month.solved, month.si, no.match.2))
+rm(list = c(ls(pattern = 'month.si'), ls(pattern = 'no.match')))
+
+#3.A.6 - GEAR
+match.key <- c('YEAR', 'NESPP3', 'GEAR')
+
+unk.month.g <- unk.month[GEAR != 'unknown']
+unk.month.g <- unk.month.g[SIZE == 'unknown', ]
+unk.month.g <- unk.month.g[AREA == 0, ]
+unk.month.g <- unk.month.g[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(unk.month.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+k.month.g <- k.month[GEAR != 'unknown', ]
+k.month.g <- k.month.g[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(k.month.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.month.g, match.key)
+setkeyv(k.month.g, match.key)
+
+month.g <- k.month.g[unk.month.g]
+
+#No match - need to match with larger aggregation
+no.match <- month.g[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop GEAR
+setkey(no.match, YEAR, NESPP3)
+setkeyv(k.month.g, key(no.match))
+month.g.2 <- k.month.g[no.match]
+no.match.2 <- month.g.2[is.na(SPPLIVMT), ]
+no.match.2[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to first QY/HY
+no.match.2[, c('QY', 'HY') := 1]
+no.match.2[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+no.match.2[, AREA := 0]
+
+#Merge all together and proportion catch to known months
+month.g <- month.g[!is.na(SPPLIVMT), ]
+month.g.2 <- month.g.2[!is.na(SPPLIVMT), ]
+if (nrow(month.g.2) > 0) {
+ month.g.2[, GEAR := i.GEAR]
+ month.g.2[, i.GEAR := NULL]
+ setcolorder(month.g.2, names(month.g))
+ month.g <- rbindlist(list(month.g, month.g.2))
+}
+
+month.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.g[, unk := i.SPPLIVMT * prop]
+month.g[, unk2 := i.SPPVALUE * prop]
+month.g[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.g, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+month.g[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+month.g[, AREA := 0]
+
+setcolorder(month.g, names(month.solved))
+setcolorder(no.match.2, names(month.solved))
+month.solved <- rbindlist(list(month.solved, month.g, no.match.2))
+rm(list = c(ls(pattern = 'month.g'), ls(pattern = 'no.match')))
+
+#3.A.7 - AREA
+match.key <- c('YEAR', 'NESPP3', 'AREA')
+
+unk.month.a <- unk.month[GEAR == 'unknown']
+unk.month.a <- unk.month.a[SIZE == 'unknown', ]
+unk.month.a <- unk.month.a[AREA != 0, ]
+unk.month.a <- unk.month.a[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(unk.month.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+k.month.a <- k.month[AREA != 0, ]
+k.month.a <- k.month.a[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(k.month.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.month.a, match.key)
+setkeyv(k.month.a, match.key)
+
+month.a <- k.month.a[unk.month.a]
+
+#No match - need to match with larger aggregation
+no.match <- month.a[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop AREA
+setkey(no.match, YEAR, NESPP3)
+setkeyv(k.month.a, key(no.match))
+month.a.2 <- k.month.a[no.match]
+no.match.2 <- month.a.2[is.na(SPPLIVMT), ]
+no.match.2[, c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.AREA', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to first QY/HY
+no.match.2[, c('QY', 'HY') := 1]
+no.match.2[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+no.match.2[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+
+#Merge all together and proportion catch to known months
+month.a <- month.a[!is.na(SPPLIVMT), ]
+month.a.2 <- month.a.2[!is.na(SPPLIVMT), ]
+if (nrow(month.a.2) > 0) {
+ month.a.2[, AREA := i.AREA]
+ month.a.2[, i.AREA := NULL]
+ setcolorder(month.a.2, names(month.a))
+ month.a <- rbindlist(list(month.a, month.a.2))
+}
+
+month.a[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.a[, unk := i.SPPLIVMT * prop]
+month.a[, unk2 := i.SPPVALUE * prop]
+month.a[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.a, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+month.a[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+month.a[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+
+setcolorder(month.a, names(month.solved))
+setcolorder(no.match.2, names(month.solved))
+month.solved <- rbindlist(list(month.solved, month.a, no.match.2))
+rm(list = c(ls(pattern = 'month.a'), ls(pattern = 'no.match')))
+
+#3.A.8 - Species only - no other match
+match.key <- c('YEAR', 'NESPP3')
+
+unk.month.sp <- unk.month[GEAR == 'unknown']
+unk.month.sp <- unk.month.sp[SIZE == 'unknown', ]
+unk.month.sp <- unk.month.sp[AREA == 0, ]
+unk.month.sp <- unk.month.sp[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(unk.month.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+k.month.sp <- k.month[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'QY', 'HY', 'UTILCD')
+]
+setnames(k.month.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.month.sp, match.key)
+setkeyv(k.month.sp, match.key)
+
+month.sp <- k.month.sp[unk.month.sp]
+
+#No match - assign to first QY/HY
+no.match <- month.sp[is.na(SPPLIVMT), ]
+no.match[, c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+no.match[, c('QY', 'HY') := 1]
+no.match[, AREA := 0]
+no.match[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+no.match[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+
+#proportion catch to known months
+month.sp <- month.sp[!is.na(SPPLIVMT), ]
+
+month.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+month.sp[, unk := i.SPPLIVMT * prop]
+month.sp[, unk2 := i.SPPVALUE * prop]
+month.sp[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.HY',
+ 'i.QY',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(month.sp, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+month.sp[, AREA := 0]
+month.sp[, GEAR := factor('unknown', levels = levels(k.month[, GEAR]))]
+month.sp[, SIZE := factor('unknown', levels = c('large', 'small', 'unknown'))]
+
+setcolorder(month.sp, names(month.solved))
+setcolorder(no.match, names(month.solved))
+month.solved <- rbindlist(list(month.solved, month.sp, no.match))
+rm(list = c(ls(pattern = 'month.sp'), ls(pattern = 'no.match')))
+
+#Merge back month.solved
+setcolorder(month.solved, names(comland.agg))
+comland.agg <- rbindlist(list(k.month, month.solved))
+setkey(comland.agg, YEAR, QY, HY, SIZE, GEAR, AREA, NESPP3, UTILCD)
+comland.agg <- comland.agg[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = key(comland.agg)
+]
+setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+#3.B SIZE------------------------------------------------------------------------------
+unk.size <- comland.agg[SIZE == 'unknown', ]
+k.size <- comland.agg[SIZE != 'unknown', ]
+
+#3.B.1 - All match
+match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'GEAR', 'AREA')
+
+unk.size.all <- unk.size[GEAR != 'unknown']
+unk.size.all <- unk.size.all[AREA != 0, ]
+
+k.size.all <- k.size[GEAR != 'unknown', ]
+k.size.all <- k.size.all[AREA != 0, ]
+
+setkeyv(unk.size.all, match.key)
+setkeyv(k.size.all, match.key)
+
+size.all <- k.size.all[unk.size.all]
+
+#No match - need to match with larger aggregation
+no.match <- size.all[is.na(SPPLIVMT), ]
+no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop QY
+setkey(no.match, YEAR, NESPP3, HY, GEAR, AREA)
+setkeyv(k.size.all, key(no.match))
+size.all.2 <- k.size.all[no.match]
+no.match.2 <- size.all.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop HY
+setkey(no.match.2, YEAR, NESPP3, GEAR, AREA)
+setkeyv(k.size.all, key(no.match.2))
+size.all.3 <- k.size.all[no.match.2]
+no.match.3 <- size.all.3[is.na(SPPLIVMT), ]
+no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.3,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop GEAR
+setkey(no.match.3, YEAR, NESPP3, AREA)
+setkeyv(k.size.all, key(no.match.3))
+size.all.4 <- k.size.all[no.match.3]
+no.match.4 <- size.all.4[is.na(SPPLIVMT), ]
+no.match.4[,
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.4,
+ c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop AREA
+setkey(no.match.4, YEAR, NESPP3)
+setkeyv(k.size.all, key(no.match.4))
+size.all.5 <- k.size.all[no.match.4]
+no.match.5 <- size.all.5[is.na(SPPLIVMT), ]
+no.match.5[,
+ c(
+ 'AREA',
+ 'GEAR',
+ 'SIZE',
+ 'QY',
+ 'HY',
+ 'UTILCD',
+ 'SPPLIVMT',
+ 'SPPVALUE'
+ ) := NULL
+]
+setnames(
+ no.match.5,
+ c(
+ 'i.AREA',
+ 'i.GEAR',
+ 'i.SIZE',
+ 'i.QY',
+ 'i.HY',
+ 'i.UTILCD',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE'
+ ),
+ c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to SIZE to small
+no.match.5[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
+#```
+
+#```{r, echo = T, eval = F}
+#Merge all together and proportion catch to known sizes
+size.all <- size.all[!is.na(SPPLIVMT), ]
+size.all.2 <- size.all.2[!is.na(SPPLIVMT), ]
+size.all.2[, QY := i.QY]
+size.all.2[, i.QY := NULL]
+setcolorder(size.all.2, names(size.all))
+size.all.3 <- size.all.3[!is.na(SPPLIVMT), ]
+size.all.3[, QY := i.QY]
+size.all.3[, HY := i.HY]
+size.all.3[, i.QY := NULL]
+size.all.3[, i.HY := NULL]
+setcolorder(size.all.3, names(size.all))
+size.all.4 <- size.all.4[!is.na(SPPLIVMT), ]
+size.all.4[, QY := i.QY]
+size.all.4[, HY := i.HY]
+size.all.4[, GEAR := i.GEAR]
+size.all.4[, i.QY := NULL]
+size.all.4[, i.HY := NULL]
+size.all.4[, i.GEAR := NULL]
+setcolorder(size.all.4, names(size.all))
+size.all.5 <- size.all.5[!is.na(SPPLIVMT), ]
+size.all.5[, QY := i.QY]
+size.all.5[, HY := i.HY]
+size.all.5[, GEAR := i.GEAR]
+size.all.5[, AREA := i.AREA]
+size.all.5[, i.QY := NULL]
+size.all.5[, i.HY := NULL]
+size.all.5[, i.GEAR := NULL]
+size.all.5[, i.AREA := NULL]
+setcolorder(size.all.5, names(size.all))
+
+size.all <- rbindlist(list(
+ size.all,
+ size.all.2,
+ size.all.3,
+ size.all.4,
+ size.all.5
+))
+
+size.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+size.all[, unk := i.SPPLIVMT * prop]
+size.all[, unk2 := i.SPPVALUE * prop]
+size.all[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.SIZE',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(size.all, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setcolorder(no.match.5, names(size.all))
+size.solved <- rbindlist(list(size.all, no.match.5))
+rm(list = c(ls(pattern = 'size.all'), ls(pattern = 'no.match')))
+
+#3.B.2 - GEAR
+match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'GEAR')
+
+unk.size.g <- unk.size[GEAR != 'unknown']
+unk.size.g <- unk.size.g[AREA == 0, ]
+unk.size.g[, AREA := NULL]
+
+k.size.g <- k.size[GEAR != 'unknown', ]
+k.size.g <- k.size.g[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'SIZE', 'UTILCD')
+]
+setnames(k.size.g, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.size.g, match.key)
+setkeyv(k.size.g, match.key)
+
+size.g <- k.size.g[unk.size.g]
+
+#No match - need to match with larger aggregation
+no.match <- size.g[is.na(SPPLIVMT), ]
+no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop QY
+setkey(no.match, YEAR, NESPP3, HY, GEAR)
+setkeyv(k.size.g, key(no.match))
+size.g.2 <- k.size.g[no.match]
+no.match.2 <- size.g.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop HY
+setkey(no.match.2, YEAR, NESPP3, GEAR)
+setkeyv(k.size.g, key(no.match.2))
+size.g.3 <- k.size.g[no.match.2]
+no.match.3 <- size.g.3[is.na(SPPLIVMT), ]
+no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.3,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop GEAR
+setkey(no.match.3, YEAR, NESPP3)
+setkeyv(k.size.g, key(no.match.3))
+size.g.4 <- k.size.g[no.match.3]
+no.match.4 <- size.g.4[is.na(SPPLIVMT), ]
+no.match.4[,
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.4,
+ c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to SIZE to small
+no.match.4[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
+no.match.4[, AREA := 0]
+
+#Merge all together and proportion catch to known sizes
+size.g <- size.g[!is.na(SPPLIVMT), ]
+size.g.2 <- size.g.2[!is.na(SPPLIVMT), ]
+size.g.2[, QY := i.QY]
+size.g.2[, i.QY := NULL]
+setcolorder(size.g.2, names(size.g))
+size.g.3 <- size.g.3[!is.na(SPPLIVMT), ]
+size.g.3[, QY := i.QY]
+size.g.3[, HY := i.HY]
+size.g.3[, i.QY := NULL]
+size.g.3[, i.HY := NULL]
+setcolorder(size.g.3, names(size.g))
+size.g.4 <- size.g.4[!is.na(SPPLIVMT), ]
+size.g.4[, QY := i.QY]
+size.g.4[, HY := i.HY]
+size.g.4[, GEAR := i.GEAR]
+size.g.4[, i.QY := NULL]
+size.g.4[, i.HY := NULL]
+size.g.4[, i.GEAR := NULL]
+setcolorder(size.g.4, names(size.g))
+
+size.g <- rbindlist(list(size.g, size.g.2, size.g.3, size.g.4))
+
+size.g[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+size.g[, unk := i.SPPLIVMT * prop]
+size.g[, unk2 := i.SPPVALUE * prop]
+size.g[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.SIZE',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(size.g, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+size.g[, AREA := 0]
+
+setcolorder(size.g, names(size.solved))
+setcolorder(no.match.4, names(size.g))
+size.solved <- rbindlist(list(size.solved, size.g, no.match.4))
+rm(list = c(ls(pattern = 'size.g'), ls(pattern = 'no.match')))
+
+#3.B.3 - AREA
+match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'AREA')
+
+unk.size.a <- unk.size[GEAR == 'unknown']
+unk.size.a <- unk.size.a[AREA != 0, ]
+unk.size.a[, GEAR := NULL]
+
+k.size.a <- k.size[AREA != 0, ]
+k.size.a <- k.size.a[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'SIZE', 'UTILCD')
+]
+setnames(k.size.a, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.size.a, match.key)
+setkeyv(k.size.a, match.key)
+
+size.a <- k.size.a[unk.size.a]
+
+#No match - need to match with larger aggregation
+no.match <- size.a[is.na(SPPLIVMT), ]
+no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop QY
+setkey(no.match, YEAR, NESPP3, HY, AREA)
+setkeyv(k.size.a, key(no.match))
+size.a.2 <- k.size.a[no.match]
+no.match.2 <- size.a.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop HY
+setkey(no.match.2, YEAR, NESPP3, AREA)
+setkeyv(k.size.a, key(no.match.2))
+size.a.3 <- k.size.a[no.match.2]
+no.match.3 <- size.a.3[is.na(SPPLIVMT), ]
+no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.3,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop AREA
+setkey(no.match.3, YEAR, NESPP3)
+setkeyv(k.size.a, key(no.match.3))
+size.a.4 <- k.size.a[no.match.3]
+no.match.4 <- size.a.4[is.na(SPPLIVMT), ]
+no.match.4[,
+ c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.4,
+ c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to SIZE to small
+no.match.4[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
+no.match.4[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
+
+#Merge all together and proportion catch to known sizes
+size.a <- size.a[!is.na(SPPLIVMT), ]
+size.a.2 <- size.a.2[!is.na(SPPLIVMT), ]
+size.a.2[, QY := i.QY]
+size.a.2[, i.QY := NULL]
+setcolorder(size.a.2, names(size.a))
+size.a.3 <- size.a.3[!is.na(SPPLIVMT), ]
+size.a.3[, QY := i.QY]
+size.a.3[, HY := i.HY]
+size.a.3[, i.QY := NULL]
+size.a.3[, i.HY := NULL]
+setcolorder(size.a.3, names(size.a))
+size.a.4 <- size.a.4[!is.na(SPPLIVMT), ]
+size.a.4[, QY := i.QY]
+size.a.4[, HY := i.HY]
+size.a.4[, AREA := i.AREA]
+size.a.4[, i.QY := NULL]
+size.a.4[, i.HY := NULL]
+size.a.4[, i.AREA := NULL]
+setcolorder(size.a.4, names(size.a))
+
+size.a <- rbindlist(list(size.a, size.a.2, size.a.3, size.a.4))
+
+size.a[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+size.a[, unk := i.SPPLIVMT * prop]
+size.a[, unk2 := i.SPPVALUE * prop]
+size.a[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.SIZE',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(size.a, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+size.a[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
+
+setcolorder(size.a, names(size.solved))
+setcolorder(no.match.4, names(size.a))
+size.solved <- rbindlist(list(size.solved, size.a, no.match.4))
+rm(list = c(ls(pattern = 'size.a'), ls(pattern = 'no.match')))
+
+#3.B.4 - Species only - no other match
+match.key <- c('YEAR', 'NESPP3', 'QY', 'HY')
+
+unk.size.sp <- unk.size[GEAR == 'unknown']
+unk.size.sp <- unk.size.sp[SIZE == 'unknown', ]
+unk.size.sp <- unk.size.sp[AREA == 0, ]
+unk.size.sp[, c('GEAR', 'AREA') := NULL]
+
+k.size.sp <- k.size[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'SIZE', 'UTILCD')
+]
+setnames(k.size.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.size.sp, match.key)
+setkeyv(k.size.sp, match.key)
+
+size.sp <- k.size.sp[unk.size.sp]
+
+#No match - need to match with larger aggregation
+no.match <- size.sp[is.na(SPPLIVMT), ]
+no.match[, c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.SIZE', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop QY
+setkey(no.match, YEAR, NESPP3, HY)
+setkeyv(k.size.sp, key(no.match))
+size.sp.2 <- k.size.sp[no.match]
+no.match.2 <- size.sp.2[is.na(SPPLIVMT), ]
+no.match.2[, c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.SIZE', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop HY
+setkey(no.match.2, YEAR, NESPP3)
+setkeyv(k.size.sp, key(no.match.2))
+size.sp.3 <- k.size.sp[no.match.2]
+no.match.3 <- size.sp.3[is.na(SPPLIVMT), ]
+no.match.3[, c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.3,
+ c('i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to SIZE to small
+no.match.3[, SIZE := factor('small', levels = c('large', 'small', 'unknown'))]
+no.match.3[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
+no.match.3[, AREA := 0]
+
+#Merge together and proportion catch to known sizes
+size.sp <- size.sp[!is.na(SPPLIVMT), ]
+size.sp.2 <- size.sp.2[!is.na(SPPLIVMT), ]
+size.sp.2[, QY := i.QY]
+size.sp.2[, i.QY := NULL]
+setcolorder(size.sp.2, names(size.sp))
+size.sp.3 <- size.sp.3[!is.na(SPPLIVMT), ]
+size.sp.3[, QY := i.QY]
+size.sp.3[, HY := i.HY]
+size.sp.3[, i.QY := NULL]
+size.sp.3[, i.HY := NULL]
+setcolorder(size.sp.3, names(size.sp))
+
+size.sp <- rbindlist(list(size.sp, size.sp.2, size.sp.3))
+
+size.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+size.sp[, unk := i.SPPLIVMT * prop]
+size.sp[, unk2 := i.SPPVALUE * prop]
+size.sp[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.SIZE',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(size.sp, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+size.sp[, AREA := 0]
+size.sp[, GEAR := factor('unknown', levels = levels(k.size[, GEAR]))]
+
+setcolorder(size.sp, names(size.solved))
+setcolorder(no.match.3, names(size.solved))
+size.solved <- rbindlist(list(size.solved, size.sp, no.match.3))
+rm(list = c(ls(pattern = 'size.sp'), ls(pattern = 'no.match')))
+
+#Merge back size.solved
+setcolorder(size.solved, names(comland.agg))
+comland.agg <- rbindlist(list(k.size, size.solved))
+setkey(comland.agg, YEAR, QY, HY, SIZE, GEAR, AREA, NESPP3, UTILCD)
+comland.agg <- comland.agg[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = key(comland.agg)
+]
+setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+#3.C GEAR------------------------------------------------------------------------------
+unk.gear <- comland.agg[GEAR == 'unknown', ]
+k.gear <- comland.agg[GEAR != 'unknown', ]
+
+#3.C.1 - All match
+match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE', 'AREA')
+
+unk.gear.all <- unk.gear[AREA != 0, ]
+
+k.gear.all <- k.gear[AREA != 0, ]
+
+setkeyv(unk.gear.all, match.key)
+setkeyv(k.gear.all, match.key)
+
+gear.all <- k.gear.all[unk.gear.all]
+
+#No match - need to match with larger aggregation
+no.match <- gear.all[is.na(SPPLIVMT), ]
+no.match[, c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.GEAR', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop QY
+setkey(no.match, YEAR, NESPP3, HY, SIZE, AREA)
+setkeyv(k.gear.all, key(no.match))
+gear.all.2 <- k.gear.all[no.match]
+no.match.2 <- gear.all.2[is.na(SPPLIVMT), ]
+no.match.2[, c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.GEAR', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop HY
+setkey(no.match.2, YEAR, NESPP3, SIZE, AREA)
+setkeyv(k.gear.all, key(no.match.2))
+gear.all.3 <- k.gear.all[no.match.2]
+no.match.3 <- gear.all.3[is.na(SPPLIVMT), ]
+no.match.3[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.3,
+ c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop SIZE
+setkey(no.match.3, YEAR, NESPP3, AREA)
+setkeyv(k.gear.all, key(no.match.3))
+gear.all.4 <- k.gear.all[no.match.3]
+no.match.4 <- gear.all.4[is.na(SPPLIVMT), ]
+no.match.4[,
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.4,
+ c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop AREA
+setkey(no.match.4, YEAR, NESPP3)
+setkeyv(k.gear.all, key(no.match.4))
+gear.all.5 <- k.gear.all[no.match.4]
+no.match.5 <- gear.all.5[is.na(SPPLIVMT), ]
+no.match.5[,
+ c(
+ 'AREA',
+ 'GEAR',
+ 'SIZE',
+ 'QY',
+ 'HY',
+ 'UTILCD',
+ 'SPPLIVMT',
+ 'SPPVALUE'
+ ) := NULL
+]
+setnames(
+ no.match.5,
+ c(
+ 'i.AREA',
+ 'i.GEAR',
+ 'i.SIZE',
+ 'i.QY',
+ 'i.HY',
+ 'i.UTILCD',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE'
+ ),
+ c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to GEAR to other
+no.match.5[, GEAR := factor('other', levels = levels(k.gear[, GEAR]))]
+
+#Merge all together and proportion catch to known gears
+gear.all <- gear.all[!is.na(SPPLIVMT), ]
+gear.all.2 <- gear.all.2[!is.na(SPPLIVMT), ]
+gear.all.2[, QY := i.QY]
+gear.all.2[, i.QY := NULL]
+setcolorder(gear.all.2, names(gear.all))
+gear.all.3 <- gear.all.3[!is.na(SPPLIVMT), ]
+gear.all.3[, QY := i.QY]
+gear.all.3[, HY := i.HY]
+gear.all.3[, i.QY := NULL]
+gear.all.3[, i.HY := NULL]
+setcolorder(gear.all.3, names(gear.all))
+gear.all.4 <- gear.all.4[!is.na(SPPLIVMT), ]
+gear.all.4[, QY := i.QY]
+gear.all.4[, HY := i.HY]
+gear.all.4[, SIZE := i.SIZE]
+gear.all.4[, i.QY := NULL]
+gear.all.4[, i.HY := NULL]
+gear.all.4[, i.SIZE := NULL]
+setcolorder(gear.all.4, names(gear.all))
+gear.all.5 <- gear.all.5[!is.na(SPPLIVMT), ]
+gear.all.5[, QY := i.QY]
+gear.all.5[, HY := i.HY]
+gear.all.5[, SIZE := i.SIZE]
+gear.all.5[, AREA := i.AREA]
+gear.all.5[, i.QY := NULL]
+gear.all.5[, i.HY := NULL]
+gear.all.5[, i.SIZE := NULL]
+gear.all.5[, i.AREA := NULL]
+setcolorder(gear.all.5, names(gear.all))
+
+gear.all <- rbindlist(list(
+ gear.all,
+ gear.all.2,
+ gear.all.3,
+ gear.all.4,
+ gear.all.5
+))
+
+gear.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+gear.all[, unk := i.SPPLIVMT * prop]
+gear.all[, unk2 := i.SPPVALUE * prop]
+gear.all[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.GEAR',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(gear.all, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setcolorder(no.match.5, names(gear.all))
+gear.solved <- rbindlist(list(gear.all, no.match.5))
+rm(list = c(ls(pattern = 'gear.all'), ls(pattern = 'no.match')))
+
+#3.C.2 - Species only - no other match
+match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE')
+
+unk.gear.sp <- unk.gear[AREA == 0, ]
+unk.gear.sp[, 'AREA' := NULL]
+
+k.gear.sp <- k.gear[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(match.key, 'GEAR', 'UTILCD')
+]
+setnames(k.gear.sp, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setkeyv(unk.gear.sp, match.key)
+setkeyv(k.gear.sp, match.key)
+
+gear.sp <- k.gear.sp[unk.gear.sp]
+
+#No match - need to match with larger aggregation
+no.match <- gear.sp[is.na(SPPLIVMT), ]
+no.match[, c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.GEAR', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop QY
+setkey(no.match, YEAR, NESPP3, HY, SIZE)
+setkeyv(k.gear.sp, key(no.match))
+gear.sp.2 <- k.gear.sp[no.match]
+no.match.2 <- gear.sp.2[is.na(SPPLIVMT), ]
+no.match.2[, c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.GEAR', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop HY
+setkey(no.match.2, YEAR, NESPP3, SIZE)
+setkeyv(k.gear.sp, key(no.match.2))
+gear.sp.3 <- k.gear.sp[no.match.2]
+no.match.3 <- gear.sp.3[is.na(SPPLIVMT), ]
+no.match.3[, c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.3,
+ c('i.GEAR', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop SIZE
+setkey(no.match.3, YEAR, NESPP3)
+setkeyv(k.gear.sp, key(no.match.3))
+gear.sp.4 <- k.gear.sp[no.match.3]
+no.match.4 <- gear.sp.4[is.na(SPPLIVMT), ]
+no.match.4[,
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.4,
+ c('i.GEAR', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - assign to GEAR to other
+no.match.4[, GEAR := factor('other', levels = levels(k.gear[, GEAR]))]
+no.match.4[, AREA := 0]
+
+#Merge all together and proportion catch to known gears
+gear.sp <- gear.sp[!is.na(SPPLIVMT), ]
+gear.sp.2 <- gear.sp.2[!is.na(SPPLIVMT), ]
+gear.sp.2[, QY := i.QY]
+gear.sp.2[, i.QY := NULL]
+setcolorder(gear.sp.2, names(gear.sp))
+gear.sp.3 <- gear.sp.3[!is.na(SPPLIVMT), ]
+gear.sp.3[, QY := i.QY]
+gear.sp.3[, HY := i.HY]
+gear.sp.3[, i.QY := NULL]
+gear.sp.3[, i.HY := NULL]
+setcolorder(gear.sp.3, names(gear.sp))
+gear.sp.4 <- gear.sp.4[!is.na(SPPLIVMT), ]
+gear.sp.4[, QY := i.QY]
+gear.sp.4[, HY := i.HY]
+gear.sp.4[, SIZE := i.SIZE]
+gear.sp.4[, i.QY := NULL]
+gear.sp.4[, i.HY := NULL]
+gear.sp.4[, i.SIZE := NULL]
+setcolorder(gear.sp.4, names(gear.sp))
+
+gear.sp <- rbindlist(list(gear.sp, gear.sp.2, gear.sp.3, gear.sp.4))
+
+gear.sp[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+gear.sp[, unk := i.SPPLIVMT * prop]
+gear.sp[, unk2 := i.SPPVALUE * prop]
+gear.sp[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.GEAR',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(gear.sp, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+gear.sp[, AREA := 0]
+
+setcolorder(gear.sp, names(gear.solved))
+setcolorder(no.match.4, names(gear.solved))
+gear.solved <- rbindlist(list(gear.solved, gear.sp, no.match.4))
+rm(list = c(ls(pattern = 'gear.sp'), ls(pattern = 'no.match')))
+
+#Merge back gear.solved
+setcolorder(gear.solved, names(comland.agg))
+comland.agg <- rbindlist(list(k.gear, gear.solved))
+setkey(comland.agg, YEAR, QY, HY, SIZE, GEAR, AREA, NESPP3, UTILCD)
+comland.agg <- comland.agg[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = key(comland.agg)
+]
+setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+#3.D AREA------------------------------------------------------------------------------
+unk.area <- comland.agg[AREA == 0, ]
+k.area <- comland.agg[AREA != 0, ]
+
+#3.C.1 - All match
+match.key <- c('YEAR', 'NESPP3', 'QY', 'HY', 'SIZE', 'GEAR')
+
+unk.area.all <- unk.area
+
+k.area.all <- k.area
+
+setkeyv(unk.area.all, match.key)
+setkeyv(k.area.all, match.key)
+
+area.all <- k.area.all[unk.area.all]
+
+#No match - need to match with larger aggregation
+no.match <- area.all[is.na(SPPLIVMT), ]
+no.match[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match,
+ c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop QY
+setkey(no.match, YEAR, NESPP3, HY, SIZE, GEAR)
+setkeyv(k.area.all, key(no.match))
+area.all.2 <- k.area.all[no.match]
+no.match.2 <- area.all.2[is.na(SPPLIVMT), ]
+no.match.2[, c('AREA', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.2,
+ c('i.AREA', 'i.QY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'QY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop HY
+setkey(no.match.2, YEAR, NESPP3, SIZE, GEAR)
+setkeyv(k.area.all, key(no.match.2))
+area.all.3 <- k.area.all[no.match.2]
+no.match.3 <- area.all.3[is.na(SPPLIVMT), ]
+no.match.3[, c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.3,
+ c('i.AREA', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop SIZE
+setkey(no.match.3, YEAR, NESPP3, GEAR)
+setkeyv(k.area.all, key(no.match.3))
+area.all.4 <- k.area.all[no.match.3]
+no.match.4 <- area.all.4[is.na(SPPLIVMT), ]
+no.match.4[,
+ c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL
+]
+setnames(
+ no.match.4,
+ c('i.AREA', 'i.SIZE', 'i.QY', 'i.HY', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Drop GEAR
+setkey(no.match.4, YEAR, NESPP3)
+setkeyv(k.area.all, key(no.match.4))
+area.all.5 <- k.area.all[no.match.4]
+no.match.5 <- area.all.5[is.na(SPPLIVMT), ]
+no.match.5[,
+ c(
+ 'AREA',
+ 'GEAR',
+ 'SIZE',
+ 'QY',
+ 'HY',
+ 'UTILCD',
+ 'SPPLIVMT',
+ 'SPPVALUE'
+ ) := NULL
+]
+setnames(
+ no.match.5,
+ c(
+ 'i.AREA',
+ 'i.GEAR',
+ 'i.SIZE',
+ 'i.QY',
+ 'i.HY',
+ 'i.UTILCD',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE'
+ ),
+ c('AREA', 'GEAR', 'SIZE', 'QY', 'HY', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#Still no match - use 3 or 5 year window then drop year
+years <- unique(no.match.5[, YEAR], by = key(no.match.5))
+no.match.6 <- c()
+area.all.6 <- c()
+for (i in 1:length(years)) {
+ #3 year window
+ k.area.3y <- comland.agg[
+ AREA != 0 & YEAR %in% (years[i] - 1):(years[i] + 1),
+ ]
+ setkey(k.area.3y, NESPP3, AREA)
+ k.area.3y <- k.area.3y[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(key(k.area.3y), 'UTILCD')
+ ]
+ setnames(k.area.3y, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+ unk.area.3y <- no.match.5[YEAR == years[i], ]
+
+ setkey(unk.area.3y, NESPP3)
+ setkey(k.area.3y, NESPP3)
+ area.3y <- k.area.3y[unk.area.3y]
+
+ no.match.3y <- area.3y[is.na(SPPLIVMT), ]
+ no.match.3y[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+ setnames(
+ no.match.3y,
+ c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+ )
+ no.match.6 <- rbindlist(list(no.match.6, no.match.3y))
+ area.all.6 <- rbindlist(list(area.all.6, area.3y))
+}
+
+years <- unique(no.match.6[, YEAR], by = key(no.match.6))
+no.match.7 <- c()
+area.all.7 <- c()
+for (i in 1:length(years)) {
+ #5 year window
+ k.area.5y <- comland.agg[
+ AREA != 0 & YEAR %in% (years[i] - 2):(years[i] + 2),
+ ]
+ setkey(k.area.5y, NESPP3, AREA)
+ k.area.5y <- k.area.5y[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c(key(k.area.5y), 'UTILCD')
+ ]
+ setnames(k.area.5y, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+ unk.area.5y <- no.match.6[YEAR == years[i], ]
+
+ setkey(unk.area.5y, NESPP3)
+ setkey(k.area.5y, NESPP3)
+ area.5y <- k.area.5y[unk.area.5y]
+
+ no.match.5y <- area.5y[is.na(SPPLIVMT), ]
+ no.match.5y[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+ setnames(
+ no.match.5y,
+ c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+ )
+
+ no.match.7 <- rbindlist(list(no.match.7, no.match.5y))
+ area.all.7 <- rbindlist(list(area.all.7, area.5y))
+}
+#Drop year
+setkey(no.match.7, NESPP3)
+k.area.all <- k.area.all[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = c('NESPP3', 'AREA', 'UTILCD')
+]
+setnames(k.area.all, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+setkey(k.area.all, NESPP3)
+
+area.all.8 <- k.area.all[no.match.7]
+no.match.8 <- area.all.8[is.na(SPPLIVMT), ]
+no.match.8[, c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE') := NULL]
+setnames(
+ no.match.8,
+ c('i.AREA', 'i.UTILCD', 'i.SPPLIVMT', 'i.SPPVALUE'),
+ c('AREA', 'UTILCD', 'SPPLIVMT', 'SPPVALUE')
+)
+#If still no match - leave as unknown
+
+#Merge all together and proportion catch to known areas
+area.all <- area.all[!is.na(SPPLIVMT), ]
+area.all.2 <- area.all.2[!is.na(SPPLIVMT), ]
+area.all.2[, QY := i.QY]
+area.all.2[, i.QY := NULL]
+setcolorder(area.all.2, names(area.all))
+area.all.3 <- area.all.3[!is.na(SPPLIVMT), ]
+area.all.3[, QY := i.QY]
+area.all.3[, HY := i.HY]
+area.all.3[, i.QY := NULL]
+area.all.3[, i.HY := NULL]
+setcolorder(area.all.3, names(area.all))
+area.all.4 <- area.all.4[!is.na(SPPLIVMT), ]
+area.all.4[, QY := i.QY]
+area.all.4[, HY := i.HY]
+area.all.4[, SIZE := i.SIZE]
+area.all.4[, i.QY := NULL]
+area.all.4[, i.HY := NULL]
+area.all.4[, i.SIZE := NULL]
+setcolorder(area.all.4, names(area.all))
+area.all.5 <- area.all.5[!is.na(SPPLIVMT), ]
+area.all.5[, QY := i.QY]
+area.all.5[, HY := i.HY]
+area.all.5[, SIZE := i.SIZE]
+area.all.5[, GEAR := i.GEAR]
+area.all.5[, i.QY := NULL]
+area.all.5[, i.HY := NULL]
+area.all.5[, i.SIZE := NULL]
+area.all.5[, i.GEAR := NULL]
+setcolorder(area.all.5, names(area.all))
+area.all.6 <- area.all.6[!is.na(SPPLIVMT), ]
+setcolorder(area.all.6, names(area.all))
+area.all.7 <- area.all.7[!is.na(SPPLIVMT), ]
+setcolorder(area.all.7, names(area.all))
+area.all.8 <- area.all.8[!is.na(SPPLIVMT), ]
+setcolorder(area.all.8, names(area.all))
+
+area.all <- rbindlist(list(
+ area.all,
+ area.all.2,
+ area.all.3,
+ area.all.4,
+ area.all.5,
+ area.all.6,
+ area.all.7,
+ area.all.8
+))
+
+area.all[, prop := SPPLIVMT / sum(SPPLIVMT), by = match.key]
+area.all[, unk := i.SPPLIVMT * prop]
+area.all[, unk2 := i.SPPVALUE * prop]
+area.all[,
+ c(
+ 'SPPLIVMT',
+ 'SPPVALUE',
+ 'i.SPPLIVMT',
+ 'i.SPPVALUE',
+ 'i.AREA',
+ 'i.UTILCD',
+ 'prop'
+ ) := NULL
+]
+setnames(area.all, c('unk', 'unk2'), c('SPPLIVMT', 'SPPVALUE'))
+
+setcolorder(no.match.8, names(area.all))
+area.solved <- rbindlist(list(area.all, no.match.8))
+rm(list = c(ls(pattern = 'area.all'), ls(pattern = 'no.match')))
+
+#Merge back area.solved
+setcolorder(area.solved, names(comland.agg))
+comland.agg <- rbindlist(list(k.area, area.solved))
+setkey(comland.agg, YEAR, QY, HY, SIZE, GEAR, AREA, NESPP3, UTILCD)
+comland.agg <- comland.agg[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = key(comland.agg)
+]
+setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+#-------------------------------------------------------------------------------
+if (sum.by == 'EPU') {
+ #Assign EPU based on statarea
+ gom <- c(500, 510, 512:515)
+ gb <- c(521:526, 551, 552, 561, 562)
+ mab <- c(537, 539, 600, 612:616, 621, 622, 625, 626, 631, 632)
+ ss <- c(463:467, 511)
+
+ comland.agg[AREA %in% gom, EPU := 'GOM']
+ comland.agg[AREA %in% gb, EPU := 'GB']
+ comland.agg[AREA %in% mab, EPU := 'MAB']
+ comland.agg[AREA %in% ss, EPU := 'SS']
+ comland.agg[is.na(EPU), EPU := 'OTHER']
+ comland.agg[,
+ EPU := factor(EPU, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))
+ ]
+
+ setkey(comland.agg, YEAR, NESPP3, QY, GEAR, SIZE, EPU, UTILCD)
+
+ comland.agg <- comland.agg[,
+ list(sum(SPPLIVMT), sum(SPPVALUE)),
+ by = key(comland.agg)
+ ]
+
+ setnames(comland.agg, c('V1', 'V2'), c('SPPLIVMT', 'SPPVALUE'))
+
+ #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
+ temp <- tempfile()
+ download.file(
+ "https://www.nafo.int/Portals/0/Stats/nafo-21b-60-69.zip?ver=2016-08-03-063915-850",
+ temp
+ )
+ nafo.60 <- as.data.table(read.csv(unz(temp, "NAFO21B-60-69.txt")))
+ unlink(temp)
+ download.file(
+ "https://www.nafo.int/Portals/0/Stats/nafo-21b-70-79.zip?ver=2016-08-03-063915-850",
+ temp
+ )
+ nafo.70 <- as.data.table(read.csv(unz(temp, "NAFO21B-70-79.txt")))
+ unlink(temp)
+ download.file(
+ "https://www.nafo.int/Portals/0/Stats/nafo-21b-80-89.zip?ver=2016-08-03-063915-850",
+ temp
+ )
+ nafo.80 <- as.data.table(read.csv(unz(temp, "NAFO21B-80-89.txt")))
+ unlink(temp)
+ download.file(
+ "https://www.nafo.int/Portals/0/Stats/nafo-21b-90-99.zip?ver=2016-08-03-063915-850",
+ temp
+ )
+ nafo.90 <- as.data.table(read.csv(unz(temp, "NAFO21B-90-99.txt")))
+ unlink(temp)
+ download.file(
+ "https://www.nafo.int/Portals/0/Stats/nafo-21b-2000-09.zip?ver=2016-08-03-063915-850",
+ temp
+ )
+ nafo.00 <- as.data.table(read.csv(unz(temp, "NAFO21B-2000-09.txt")))
+ unlink(temp)
+ download.file(
+ "https://www.nafo.int/Portals/0/Stats/nafo-21b-2010-15.zip?ver=2017-06-01-164323-460",
+ temp
+ )
+ nafo.10 <- as.data.table(read.csv(unz(
+ temp,
+ "nafo-21b-2010-15/NAFO21B-2010-15.csv"
+ )))
+ unlink(temp)
+
+ #2010 + data have different column headers
+ setnames(
+ nafo.10,
+ c('Gear', 'AreaCode', 'SpeciesEffort'),
+ c('GearCode', 'Divcode', 'Code')
+ )
+
+ nafo <- rbindlist(list(nafo.60, nafo.70, nafo.80, nafo.90, nafo.00, nafo.10))
+
+ #Remove US landings (Country code 22), extra divisions (use only 47, 51:56, 61:63),
+ #and effort codes (1:3)
+ nafo <- nafo[Country != 22 & Divcode %in% c(47, 51:56, 61:63) & Code > 3, ]
+
+ #Deal with unknown monthly catch?????
+
+ #Get nafo code in a similar format to comland
+ nafoland <- nafo[, list(Year, GearCode, Tonnage, Divcode, Code, Catches)]
+ nafoland[, MONTH := 0]
+ 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,
+ Code,
+ get(month[i])
+ )]
+ nafoland.month[, MONTH := i]
+ setnames(nafoland.month, names(nafoland.month)[6], 'SPPLIVMT')
+ nafoland <- rbindlist(list(nafoland, nafoland.month))
+ }
+
+ nafoland <- nafoland[SPPLIVMT != 0, ]
+
+ nafoland[, EPU := factor(NA, levels = c('GOM', 'GB', 'MAB', 'SS', 'OTHER'))]
+ nafoland[Divcode == 47, EPU := 'SS']
+ nafoland[Divcode == 51, EPU := 'GOM']
+ nafoland[Divcode %in% c(52, 54:56), EPU := 'GB']
+ nafoland[Divcode %in% c(53, 61:63), EPU := 'MAB']
+ nafoland[is.na(EPU), EPU := 'OTHER']
+
+ nafoland[, Divcode := NULL]
+
+ ##Fix missing Scotian Shelf data from 21B
+ SS.nafo <- as.data.table(read.csv(
+ file.path(data.dir.3, "SS_NAFO_21A.csv"),
+ skip = 8
+ ))
+
+ #Add NAFOSPP code to SS.nafo
+ nafo.spp <- as.data.table(read.csv(file.path(data.dir.3, 'species.txt')))
+ setnames(nafo.spp, "Abbreviation", "Species_ASFIS")
+ nafo.spp <- nafo.spp[, list(Code, Species_ASFIS)]
+
+ SS.nafo <- merge(SS.nafo, nafo.spp, by = 'Species_ASFIS', all.x = T)
+
+ #Only grab missing data
+ SS.nafo <- SS.nafo[Year %in% c(2003, 2008, 2009), ]
+
+ setkey(SS.nafo, Year, Code)
+
+ SS.land <- SS.nafo[, sum(Catch...000.Kg.), by = key(SS.nafo)]
+
+ setnames(SS.land, "V1", "SPPLIVMT")
+
+ #Add GearCode, Tonnage, Month, and EPU
+ SS.land[, GearCode := 99]
+ SS.land[, Tonnage := 0]
+ SS.land[, MONTH := 0]
+ SS.land[, EPU := 'SS']
+
+ setcolorder(SS.land, names(nafoland))
+
+ nafoland <- rbindlist(list(nafoland, SS.land))
+
+ #Rectify NAFO codes with US codes
+ #Species
+ setnames(
+ nafoland,
+ c('Year', 'GearCode', 'Tonnage', 'Code'),
+ c('YEAR', 'NAFOGEAR', 'TONCL1', 'NAFOSPP')
+ )
+
+ spp <- as.data.table(sqlQuery(channel, "select NAFOSPP, NESPP3 from CFSPP"))
+
+ #Fix missing NAFO codes
+ missing.spp <- data.table(
+ NAFOSPP = c(110, 141, 189, 480, 484, 487, 488, 489),
+ NESPP3 = c(240, 509, 512, 366, 368, 367, 370, 369)
+ )
+ spp <- rbindlist(list(spp, missing.spp))
+
+ setkey(spp, NAFOSPP)
+ spp <- unique(spp, by = key(spp))
+
+ #Fix many to one relationships
+ spp[NAFOSPP == 199, NESPP3 := 524]
+ spp[NAFOSPP == 299, NESPP3 := 525]
+ spp[NAFOSPP == 469, NESPP3 := 359]
+ spp[NAFOSPP == 499, NESPP3 := 526]
+ spp[NAFOSPP == 529, NESPP3 := 764]
+ spp[NAFOSPP == 699, NESPP3 := 899]
+
+ nafoland <- merge(nafoland, spp, by = 'NAFOSPP', all.x = T)
+
+ #fix codes
+ nafoland[NAFOSPP == 309, NESPP3 := 150L]
+ nafoland[NAFOSPP == 462, NESPP3 := 481L]
+ nafoland[NAFOSPP == 464, NESPP3 := 355L]
+ nafoland[NAFOSPP == 468, NESPP3 := 493L]
+ nafoland[NAFOSPP == 704, NESPP3 := 817L]
+
+ #remove species without a match
+ nafoland <- nafoland[!is.na(NESPP3), ]
+
+ #Remove herring catch - already included from Maine Data earlier
+ nafoland <- nafoland[NESPP3 != 168, ]
+
+ #Gearcodes
+ gear <- as.data.table(sqlQuery(channel, "select NEGEAR, NAFOGEAR from Gear"))
+ gear <- unique(gear, by = 'NAFOGEAR')
+
+ nafoland <- merge(nafoland, gear, by = 'NAFOGEAR', all.x = T)
+
+ #fix codes
+ nafoland[NAFOGEAR == 8, NEGEAR := 50L]
+ nafoland[NAFOGEAR == 9, NEGEAR := 370L]
+ nafoland[NAFOGEAR == 19, NEGEAR := 58L]
+ nafoland[NAFOGEAR == 49, NEGEAR := 60L]
+ nafoland[NAFOGEAR == 56, NEGEAR := 21L]
+
+ #Tonnage
+ nafoland[TONCL1 == 7, TONCL1 := 6L]
+
+ #Drop NAFO codes
+ nafoland[, c('NAFOGEAR', 'NAFOSPP') := NULL]
+
+ #Fix skates
+ #get little skates and winter skates from skates(ns) - use survey in half years
+ #Generate Half year variable in comland
+ nafoland.skates <- nafoland[NESPP3 == 365, ]
+ nafoland.skates[MONTH %in% 1:6, Half := 1]
+ nafoland.skates[MONTH %in% 7:12, Half := 2]
+
+ setkey(skate.hake.nafo, YEAR, Half, EPU)
+
+ nafoland.skates <- merge(
+ nafoland.skates,
+ skate.hake.nafo,
+ by = key(skate.hake.nafo),
+ all.x = T
+ )
+
+ nafoland.skates[NESPP3 == 365, little := little.per * SPPLIVMT]
+ nafoland.skates[is.na(little), little := 0]
+
+ nafoland.skates[NESPP3 == 365, winter := winter.per * SPPLIVMT]
+ nafoland.skates[is.na(winter), winter := 0]
+
+ nafoland.skates[NESPP3 == 365, other.skate := SPPLIVMT - (little + winter)]
+
+ #Little (366), winter (367), skates(ns) (365)
+ #put skates in nafoland format to merge back
+ little <- nafoland.skates[, list(
+ YEAR,
+ Half,
+ EPU,
+ TONCL1,
+ MONTH,
+ NESPP3,
+ NEGEAR,
+ little
+ )]
+ little[, NESPP3 := 366L]
+ setnames(little, "little", "SPPLIVMT")
+ little <- little[SPPLIVMT > 0, ]
+
+ winter <- nafoland.skates[, list(
+ YEAR,
+ Half,
+ EPU,
+ TONCL1,
+ MONTH,
+ NESPP3,
+ NEGEAR,
+ winter
+ )]
+ winter[, NESPP3 := 367L]
+ setnames(winter, "winter", "SPPLIVMT")
+ winter <- winter[SPPLIVMT > 0, ]
+
+ other <- nafoland.skates[, list(
+ YEAR,
+ Half,
+ EPU,
+ TONCL1,
+ MONTH,
+ NESPP3,
+ NEGEAR,
+ other.skate
+ )]
+ other[, NESPP3 := 365L]
+ setnames(other, "other.skate", "SPPLIVMT")
+ other <- other[SPPLIVMT > 0, ]
+
+ #merge all three and reformat for nafoland
+ skates.add.back <- rbindlist(list(little, winter, other))
+
+ skates.add.back[, Half := NULL]
+ setcolorder(skates.add.back, names(nafoland))
+
+ nafoland <- rbindlist(list(nafoland[NESPP3 != 365, ], skates.add.back))
+
+ #aggregate nafo landings
+ #2 - aggregate by quarter year, half year, major gear, and small/large TC
+ 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]
+
+ nafoland[NEGEAR %in% otter, GEAR := 'otter']
+ nafoland[NEGEAR %in% dredge.sc, GEAR := 'dredge.sc']
+ nafoland[NEGEAR %in% pot, GEAR := 'pot']
+ nafoland[NEGEAR %in% longline, GEAR := 'longline']
+ nafoland[NEGEAR %in% seine, GEAR := 'seine']
+ nafoland[NEGEAR %in% gillnet, GEAR := 'gillnet']
+ nafoland[NEGEAR %in% midwater, GEAR := 'midwater']
+ nafoland[NEGEAR %in% dredge.o, GEAR := 'dredge.o']
+ nafoland[NEGEAR == 99, GEAR := 'unknown']
+ nafoland[is.na(GEAR), GEAR := 'other']
+ nafoland[, GEAR := as.factor(GEAR)]
+
+ nafoland[TONCL1 %in% 1:3, SIZE := 'small']
+ nafoland[TONCL1 > 3, SIZE := 'large']
+ nafoland[TONCL1 == 0, SIZE := 'unknown']
+ nafoland[, SIZE := as.factor(SIZE)]
+
+ setkey(nafoland, YEAR, QY, GEAR, SIZE, EPU, NESPP3)
+
+ nafoland.agg <- nafoland[, sum(SPPLIVMT), by = key(nafoland)]
+
+ setnames(nafoland.agg, "V1", "SPPLIVMT")
+
+ #Create dummy variable for value
+ nafoland.agg[, SPPVALUE := 0]
+ nafoland.agg[, UTILCD := 0]
+
+ #Merge comland and nafoland
+ setcolorder(nafoland.agg, names(comland.agg))
+
+ if (foreign == 'y') {
+ comland.agg[, US := T]
+ nafoland.agg[, US := F]
+ }
+
+ comland.nafo <- rbindlist(list(comland.agg, nafoland.agg))
+
+ #Remove Menhaden data
+ #save(comland.nafo, file = paste(out.dir, "comland_Menhaden.RData", sep = ''))
+ comland <- comland.nafo[NESPP3 != 221, ]
+}
+
+if (sum.by == 'stat.area') {
+ comland <- comland.agg
+}
+
+#Output file
+if (landed == 'n') {
+ file.landed <- ''
+} else {
+ file.landed <- '_meatwt'
+}
+if (adjust.ppi == 'n') {
+ file.adjust <- ''
+} else {
+ file.adjust <- '_deflated'
+}
+if (sum.by == 'EPU') {
+ file.by <- ''
+} else {
+ file.by <- '_stat_areas'
+}
+file.name <- paste0('comland', file.landed, file.adjust, file.by, '.RData')
+
+save(comland, file = file.path(out.dir, file.name))
+#```
diff --git a/R/stored_scripts/long-term-sst-extraction.R b/R/stored_scripts/long-term-sst-extraction.R
index 66075221..ffee673c 100644
--- a/R/stored_scripts/long-term-sst-extraction.R
+++ b/R/stored_scripts/long-term-sst-extraction.R
@@ -1,203 +1,206 @@
-
-
-## Long Term SST extraction
-
-#```{r, echo = T, eval = F}
-# Include R code here
-# all year
-years="ersst"
-
-# a year
-#years=".2016"
-
-# which data
-setwd("C:/2_ersst/datafiles_v4")
-setwd("C:/2_ersst/datafiles_v5")
-
-
-# NES standard bounded by 34-46N and 78-62W
-minlon= -78; maxlon= -62; minlat= 34; maxlat= 46
-dataoutfile="C:/2_ersst/nes_std_area_v5.csv"
-
-# DELETE ONLY FILE WILL APPEND AND DOUBLE DATA
-file.remove(dataoutfile)
-
-################################################## END SET
-
-# LABRODOR SEA
-#minlon= -66; #maxlon= -44; #minlat= 50; #maxlat= 70
-#dataoutfile="C:/2_ersst/lab_sea.csv"
-
-# New eel
-#minlon= -80; maxlon= -40; minlat= 20; maxlat= 40
-#dataoutfile="C:/2_ersst/new eel.csv"
-
-# G of Mex
-#minlon= -98; maxlon= -82; minlat= 18; maxlat= 30
-#dataoutfile="C:/2_ersst/gomex_area.csv"
-
-# USSE INCLUDING 28-36N and 80-76W not bounding
-#minlon= -80; #maxlon= -76; #minlat= 28; #maxlat= 36
-#dataoutfile="C:/2_ersst/usse_area.csv"
-
-# GSL standard bounded by 34-46N and 78-62W
-#minlon= -68; maxlon= -60; minlat= 46; maxlat= 48
-#dataoutfile="C:/2_ersst/gsl.csv"
-
-# PACIFIC area bounded by 10-30N and 166-146W
-#minlon= -166; #maxlon= -146; #minlat= 10; #maxlat= 30
-#dataoutfile="C:/1_analyses/ersst/pac_islands_area.csv"
-
-# Baltic area bounded by 52-66N and 14-28E
-#minlon= 14; #maxlon= 28; #minlat= 52; #maxlat= 66
-#dataoutfile="C:/2_ersst/baltic area.csv"
-
-# North Atlantic Area bounded by 30-70N and 80W-20E
-#minlon= -80; #maxlon= -2; #minlat= 30; #maxlat= 70
-#dataoutfile="C:/2_ersst/na area1.csv"
-# and ...
-#minlon= 0; #maxlon= 20; #minlat= 30; #maxlat= 70
-#dataoutfile="C:/1_analyses/ersst/na area2.csv"
-
-# NorthEAST Atlantic Area bounded by 55-70N and 10W-20E
-#minlon= -10; #maxlon= -2; #minlat= 56; #maxlat= 70
-#dataoutfile="C:/1_analyses/ersst/ne atl 1.csv"
-# and ...
-#minlon= 0; #maxlon= 10; #minlat= 56; #maxlat= 70
-#dataoutfile="C:/1_analyses/ersst/ne atl 2.csv"
-
-# Pacific steelhead
-#minlon= -160; #maxlon= -122; #minlat= 40; #maxlat= 62
-#dataoutfile="C:/1_analyses/ersst/pac sh.csv"
-
-#North Pacific in two parts
-#1
-#minlon= -180; #maxlon= -120; #minlat= 30; #maxlat= 72
-#dataoutfile="C:/1_analyses/ersst/n_pac_1.csv"
-#2
-#minlon= 120; #maxlon= 178; #minlat= 30; #maxlat= 72
-#dataoutfile="C:/1_analyses/ersst/n_pac_2.csv"
-
-# North Atlantic Area bounded by 20-70N and 100W-30E
-#minlon= -100; #maxlon= -2; #minlat= 20; #maxlat= 70
-#dataoutfile="C:/1_analyses/ersst/na area1.csv"
-# and ...
-#minlon= 0; #maxlon= 30; #minlat= 20; #maxlat= 70
-#dataoutfile="C:/1_analyses/ersst/na area2.csv"
-
-
-
-
-
-
-
-
-
-# constants for area
-R <- 6371 # Earth mean radius [km]
-dheight = 222
-
-#library(ncdf)
-library(ncdf4)
-
-# ERSST data
-# lon goes from 0E to 358E with lon at center of box
-# lat goes from 88S to 88N with lat at center of box
-
-# start with lon based on degrees lonew
-# array 1 2 ... 90 91 92 ... 180
-# lon 0 2 ... 178 180 182 ... 358
-# lonew 0 2 ... 178 -180 -178 ... -2
-# star with lat + deg N, - deg S
-# array 1 ... 45 ... 89
-# lon -88 ... 0 ... 88
-
-# -> -> -> TO KEEP THINGS SIMPLE, RETRIEVALS CAN'T BE CONTINUOUS FROM - LONS TO + LONs
-# have to extract from -180W to -2W separately from 0E to 180E
-
-# -> -> -> OUTPUT APPENDS SO NEED TO DELETE FILE IF ALREADY EXISTS
-
-# -> -> -> USE APPROPRIATE lon lat and outfile block:
-
-
-
-
-
-
-# set lon limits in array units
-if ( minlon < 0){
- arrayminlon=(minlon+360)/2+1
-} else {
- arrayminlon=minlon/2+1
-}
-
-if ( maxlon < 0){
- arraymaxlon=(maxlon+360)/2+1
-} else {
- arraymaxlon=maxlon/2+1
-}
-
-# set lat limits in array units
-arrayminlat=minlat/2+45
-arraymaxlat=maxlat/2+45
-
-
-filelist=list.files(pattern=years)
-
-numfiles=length(filelist)
-
-for (filenum in 1:numfiles){
-
- # ersst = open.ncdf(filelist[filenum])
- ersst = nc_open(filelist[filenum])
- print(filelist[filenum])
-
- # sst = get.var.ncdf( ersst, "sst")
- sst <- ncvar_get(ersst,"sst" )
-
- year=as.numeric(substr(filelist[filenum],10,13))
- month=as.numeric(substr(filelist[filenum],14,15))
-
- for (arrlons in arrayminlon:arraymaxlon){
- for (arrlats in arrayminlat:arraymaxlat){
-
-
- if ( arrlons < 91){
- regenlon=(arrlons-1)*2
- } else {
- regenlon=(arrlons-1)*2-360
- }
-
-
- regenlat=(arrlats-45)*2
-
- long1=regenlon-1 *pi/180
- lat1=regenlat-1 *pi/180
- long2=regenlon+1 *pi/180
- lat2=regenlat-1 *pi/180
- dwidth1 <- acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
- long1=regenlon-1 *pi/180
- lat1=regenlat+1 *pi/180
- long2=regenlon+1 *pi/180
- lat2=regenlat+1 *pi/180
- dwidth2 <- acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
- area=((dwidth1 + dwidth1)/2) * dheight
-
- dataline <- matrix(c(year, month, regenlon, regenlat,
- round(sst[arrlons,arrlats],digits=2),area),1,6)
-
-
- if(is.finite(sst[arrlons,arrlats])) {
- write.table(dataline,file=dataoutfile,sep=",",row.name=F,col.names=F,append=TRUE)
- }
-
- }
- }
-
- # close.ncdf(ersst)
- nc_close(ersst)
-
-}
-
-
-#```
\ No newline at end of file
+## Long Term SST extraction
+
+#```{r, echo = T, eval = F}
+# Include R code here
+# all year
+years <- "ersst"
+
+# a year
+#years=".2016"
+
+# which data
+setwd("C:/2_ersst/datafiles_v4")
+setwd("C:/2_ersst/datafiles_v5")
+
+
+# NES standard bounded by 34-46N and 78-62W
+minlon <- -78
+maxlon <- -62
+minlat <- 34
+maxlat <- 46
+dataoutfile <- "C:/2_ersst/nes_std_area_v5.csv"
+
+# DELETE ONLY FILE WILL APPEND AND DOUBLE DATA
+file.remove(dataoutfile)
+
+################################################## END SET
+
+# LABRODOR SEA
+#minlon= -66; #maxlon= -44; #minlat= 50; #maxlat= 70
+#dataoutfile="C:/2_ersst/lab_sea.csv"
+
+# New eel
+#minlon= -80; maxlon= -40; minlat= 20; maxlat= 40
+#dataoutfile="C:/2_ersst/new eel.csv"
+
+# G of Mex
+#minlon= -98; maxlon= -82; minlat= 18; maxlat= 30
+#dataoutfile="C:/2_ersst/gomex_area.csv"
+
+# USSE INCLUDING 28-36N and 80-76W not bounding
+#minlon= -80; #maxlon= -76; #minlat= 28; #maxlat= 36
+#dataoutfile="C:/2_ersst/usse_area.csv"
+
+# GSL standard bounded by 34-46N and 78-62W
+#minlon= -68; maxlon= -60; minlat= 46; maxlat= 48
+#dataoutfile="C:/2_ersst/gsl.csv"
+
+# PACIFIC area bounded by 10-30N and 166-146W
+#minlon= -166; #maxlon= -146; #minlat= 10; #maxlat= 30
+#dataoutfile="C:/1_analyses/ersst/pac_islands_area.csv"
+
+# Baltic area bounded by 52-66N and 14-28E
+#minlon= 14; #maxlon= 28; #minlat= 52; #maxlat= 66
+#dataoutfile="C:/2_ersst/baltic area.csv"
+
+# North Atlantic Area bounded by 30-70N and 80W-20E
+#minlon= -80; #maxlon= -2; #minlat= 30; #maxlat= 70
+#dataoutfile="C:/2_ersst/na area1.csv"
+# and ...
+#minlon= 0; #maxlon= 20; #minlat= 30; #maxlat= 70
+#dataoutfile="C:/1_analyses/ersst/na area2.csv"
+
+# NorthEAST Atlantic Area bounded by 55-70N and 10W-20E
+#minlon= -10; #maxlon= -2; #minlat= 56; #maxlat= 70
+#dataoutfile="C:/1_analyses/ersst/ne atl 1.csv"
+# and ...
+#minlon= 0; #maxlon= 10; #minlat= 56; #maxlat= 70
+#dataoutfile="C:/1_analyses/ersst/ne atl 2.csv"
+
+# Pacific steelhead
+#minlon= -160; #maxlon= -122; #minlat= 40; #maxlat= 62
+#dataoutfile="C:/1_analyses/ersst/pac sh.csv"
+
+#North Pacific in two parts
+#1
+#minlon= -180; #maxlon= -120; #minlat= 30; #maxlat= 72
+#dataoutfile="C:/1_analyses/ersst/n_pac_1.csv"
+#2
+#minlon= 120; #maxlon= 178; #minlat= 30; #maxlat= 72
+#dataoutfile="C:/1_analyses/ersst/n_pac_2.csv"
+
+# North Atlantic Area bounded by 20-70N and 100W-30E
+#minlon= -100; #maxlon= -2; #minlat= 20; #maxlat= 70
+#dataoutfile="C:/1_analyses/ersst/na area1.csv"
+# and ...
+#minlon= 0; #maxlon= 30; #minlat= 20; #maxlat= 70
+#dataoutfile="C:/1_analyses/ersst/na area2.csv"
+
+# constants for area
+R <- 6371 # Earth mean radius [km]
+dheight <- 222
+
+#library(ncdf)
+library(ncdf4)
+
+# ERSST data
+# lon goes from 0E to 358E with lon at center of box
+# lat goes from 88S to 88N with lat at center of box
+
+# start with lon based on degrees lonew
+# array 1 2 ... 90 91 92 ... 180
+# lon 0 2 ... 178 180 182 ... 358
+# lonew 0 2 ... 178 -180 -178 ... -2
+# star with lat + deg N, - deg S
+# array 1 ... 45 ... 89
+# lon -88 ... 0 ... 88
+
+# -> -> -> TO KEEP THINGS SIMPLE, RETRIEVALS CAN'T BE CONTINUOUS FROM - LONS TO + LONs
+# have to extract from -180W to -2W separately from 0E to 180E
+
+# -> -> -> OUTPUT APPENDS SO NEED TO DELETE FILE IF ALREADY EXISTS
+
+# -> -> -> USE APPROPRIATE lon lat and outfile block:
+
+# set lon limits in array units
+if (minlon < 0) {
+ arrayminlon <- (minlon + 360) / 2 + 1
+} else {
+ arrayminlon <- minlon / 2 + 1
+}
+
+if (maxlon < 0) {
+ arraymaxlon <- (maxlon + 360) / 2 + 1
+} else {
+ arraymaxlon <- maxlon / 2 + 1
+}
+
+# set lat limits in array units
+arrayminlat <- minlat / 2 + 45
+arraymaxlat <- maxlat / 2 + 45
+
+
+filelist <- list.files(pattern = years)
+
+numfiles <- length(filelist)
+
+for (filenum in 1:numfiles) {
+ # ersst = open.ncdf(filelist[filenum])
+ ersst <- nc_open(filelist[filenum])
+ print(filelist[filenum])
+
+ # sst = get.var.ncdf( ersst, "sst")
+ sst <- ncvar_get(ersst, "sst")
+
+ year <- as.numeric(substr(filelist[filenum], 10, 13))
+ month <- as.numeric(substr(filelist[filenum], 14, 15))
+
+ for (arrlons in arrayminlon:arraymaxlon) {
+ for (arrlats in arrayminlat:arraymaxlat) {
+ if (arrlons < 91) {
+ regenlon <- (arrlons - 1) * 2
+ } else {
+ regenlon <- (arrlons - 1) * 2 - 360
+ }
+
+ regenlat <- (arrlats - 45) * 2
+
+ long1 <- regenlon - 1 * pi / 180
+ lat1 <- regenlat - 1 * pi / 180
+ long2 <- regenlon + 1 * pi / 180
+ lat2 <- regenlat - 1 * pi / 180
+ dwidth1 <- acos(
+ sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(long2 - long1)
+ ) *
+ R
+ long1 <- regenlon - 1 * pi / 180
+ lat1 <- regenlat + 1 * pi / 180
+ long2 <- regenlon + 1 * pi / 180
+ lat2 <- regenlat + 1 * pi / 180
+ dwidth2 <- acos(
+ sin(lat1) * sin(lat2) + cos(lat1) * cos(lat2) * cos(long2 - long1)
+ ) *
+ R
+ area <- ((dwidth1 + dwidth1) / 2) * dheight
+
+ dataline <- matrix(
+ c(
+ year,
+ month,
+ regenlon,
+ regenlat,
+ round(sst[arrlons, arrlats], digits = 2),
+ area
+ ),
+ 1,
+ 6
+ )
+
+ if (is.finite(sst[arrlons, arrlats])) {
+ write.table(
+ dataline,
+ file = dataoutfile,
+ sep = ",",
+ row.name = F,
+ col.names = F,
+ append = TRUE
+ )
+ }
+ }
+ }
+
+ # close.ncdf(ersst)
+ nc_close(ersst)
+}
+
+#```
diff --git a/R/stored_scripts/mab_hab_extraction.R b/R/stored_scripts/mab_hab_extraction.R
index 23cedc35..db77097e 100644
--- a/R/stored_scripts/mab_hab_extraction.R
+++ b/R/stored_scripts/mab_hab_extraction.R
@@ -1,148 +1,225 @@
-#mab hab extraction
-
-
-
-
-#```{r r-extract,fig.align = "center", eval = T, fig.cap='(ref:r-extract)', echo = F, message=F, warning=F}
-data.dir <- "data/CB_HAB"
-
-#Function to process data - cpm specifies cells per ml filter
-fixer <- function(cpm){
- hab_2007_2012 <- read_excel(file.path(data.dir,"Query_2007-2012.xlsx"))
- hab_2013_odu <- read_excel(file.path(data.dir,"2013 ODU Data.xlsx"),skip = 4)
- hab_2013_vims <- read_excel(file.path(data.dir,"vims_2013.xlsx"),skip = 6)
- hab_2014_odu <- read_excel(file.path(data.dir,"2014 ODU data.xlsx"))
- hab_2014_vims <- read_excel(file.path(data.dir,"FINALforVDH_22Dec14final.xlsx"))
- hab_2016 <- read_excel(file.path(data.dir,"HAB_MAP_Data_2016.xlsx"))
- hab_2017 <- read_excel(file.path(data.dir,"HAB_MAP_Data_2017.xlsx"),sheet=2)
-
- #2012---------------------------------------------------------
- HAB_2007_2012 <- hab_2007_2012 %>% filter(!is.na(cells_per_ml)) %>%
- filter(!is.na(date)) %>%
- mutate(year = format(as.POSIXct(date), "%Y")) %>%
- filter(cells_per_ml >= cpm) %>%
- group_by(year, species) %>%
- dplyr::summarise(Events = n()) %>%
- as.data.frame()
-
- #2013---------------------------------------------------------
- #ODU
- odu_2013 <- gather(hab_2013_odu, species, cells_per_ml,
- `Pfiesteria like dinoflagellate`:`A. monilatum`) %>%
- filter(!is.na(cells_per_ml)) %>%
- filter(cells_per_ml >= cpm) %>%
- mutate(year = 2013) %>%
- group_by(year, species) %>%
- dplyr::summarise(Events = n()) %>%
- as.data.frame()
-
- #VIMS
- vims_2013 <- hab_2013_vims %>% filter(!is.na(cells_per_ml)) %>%
- mutate(year = "2013") %>%
- filter(cells_per_ml >= cpm) %>%
- group_by(year, species) %>%
- dplyr::summarise(Events = n()) %>%
- as.data.frame()
-
- HAB_2013 <- rbind(vims_2013, odu_2013)
-
- #2014--------------------------------------------------------
- #ODU
- long <- gather(hab_2014_odu, species, cells_per_ml,
- `Karlodinium veneficum`:`Cyanobacteria bloom`, factor_key = TRUE)
- hab_2014_odu <- long %>% filter(cells_per_ml != 0)
- hab_2014_odu$species <- sub("[.]"," ", hab_2014_odu$species)
- hab_2014_odu$cells_per_ml <- gsub("[A-Za-z+//]",'',hab_2014_odu$cells_per_ml)
- hab_2014_odu$cells_per_ml <- as.numeric(hab_2014_odu$cells_per_ml)
-
- hab_2014_odu <- hab_2014_odu %>% mutate(year = "2014") %>%
- filter(cells_per_ml >= cpm) %>%
- group_by(year,species) %>%
- dplyr::summarise(Events = n()) %>%
- as.data.frame()
-
- #VIMS
- long <- gather(hab_2014_vims, species, cells_per_ml, `A. monilatum`:`C. subsalsa`)
- hab_2014_vims <- long %>% mutate(year = "2014") %>% filter(!is.na(cells_per_ml)) %>%
- mutate(cells_per_ml = as.numeric(cells_per_ml)) %>%
- filter(cells_per_ml >= cpm) %>%
- group_by(year,species) %>%
- dplyr::summarise(Events = n()) %>%
- as.data.frame()
- HAB_2014 <- rbind(hab_2014_odu, hab_2014_vims)
-
- #2015----------------------------------------------------------
- #No data
-
- #2016---------------------------------------------------------
- HAB_2016 <- hab_2016 %>% mutate(species= plyr::mapvalues(species,
- from = c("Eugelna sanguinea",
- "Microcystin aeruginosa",
- "Microcystis aeruginosa",
- "Alexandrium monilatum-likely",
- "Alexandrium monilatum"),
- to = c("Eugelena spp.",
- "Microcystis spp.",
- "Microcystis spp.",
- "Alexandrium spp.",
- "Alexandrium spp.")))
- HAB_2016$cells_per_ml <- gsub('[a-zA-Z+<>]','',HAB_2016$cells_per_ml)
- HAB_2016 <- HAB_2016 %>%
- filter(!is.na(cells_per_ml)) %>%
- mutate(year = 2016, cells_per_ml = as.numeric(cells_per_ml)) %>%
- filter(cells_per_ml >= cpm) %>%
- group_by(year, species) %>%
- dplyr::summarise(Events = n()) %>%
- as.data.frame()
-
- #2017------------------------------------------------------------
- hab_2017$species = str_trim(hab_2017$species)
- HAB_2017 <- hab_2017 %>%
- mutate(species = plyr::mapvalues(species, c("A. monilatum","Anabaena sp",
- "Anabaena sp.","Anabaena spp",
- "none","NO HABs",
- "C. polykrikoides",
- "Microcystis aeurignosa",
- "Cylindrospermopsis sp"),
- c("Alexandrium monilatum", "Anabaena spp.",
- "Anabaena spp.","Anabaena spp.",
- "NA","NA","Cochlodinium polykrikoides",
- "Microcystis aeruginosa",
- "Cylindrospermopsis sp.")))
- HAB_2017$cells_per_ml <- gsub("[a-zA-Z+/]",'',HAB_2017$cells_per_ml)
- HAB_2017$cells_per_ml <- str_trim(HAB_2017$cells_per_ml)
- HAB_2017$cells_per_ml <- as.numeric(HAB_2017$cells_per_ml)
- HAB_2017 <- HAB_2017 %>%
- filter(!is.na(cells_per_ml)) %>%
- mutate(year = "2017") %>%
- filter(cells_per_ml >= cpm) %>%
- group_by(year, species) %>%
- dplyr::summarise(Events = n()) %>%
- as.data.frame()
-
- #Aggregate--------------------------------------------------------
- ts <- rbind(HAB_2007_2012, HAB_2013, HAB_2014, HAB_2016, HAB_2017)
-
- return(ts)
-}
-
-#All blooms > 5000 cells ml^-1
-full <- fixer(cpm = 5000)
-full <- full %>% group_by(year) %>% dplyr::summarise(total = sum(Events))
-plot(full$year, full$total, type = "o", ylim = c(0,90),
- pch = 20, ylab = "Bloom Events", las = 1, xlab = "Time", lwd = 2)
-
-#cochlodinum > 300 cells ml^-1
-cochlo <- fixer(cpm = 300)
-cochlo[cochlo$species == "C. polykrikoides" |
- cochlo$species == "C.polykrikoides" ,]$species <- "Cochlodinium polykrikoides"
-cochlo <- cochlo[cochlo$species == "Cochlodinium polykrikoides",]
-cochlo <- cochlo %>% group_by(year) %>% dplyr::summarise(total = sum(Events))
-points(cochlo$year, cochlo$total, type = "o", pch = 20, col = "indianred", lwd = 2)
-legend(x = 2007, y = 80, legend = c(expression(paste("All reports >5000 cells ml"^"-1")),
- expression(paste(italic("C. polykrikoides "),
- "reports >300 cells ml"^"-1"))),
- col = c("black","indianred"),
- lwd = 2,
- bty = "n")
-#```
\ No newline at end of file
+#mab hab extraction
+
+#```{r r-extract,fig.align = "center", eval = T, fig.cap='(ref:r-extract)', echo = F, message=F, warning=F}
+data.dir <- "data/CB_HAB"
+
+#Function to process data - cpm specifies cells per ml filter
+fixer <- function(cpm) {
+ hab_2007_2012 <- read_excel(file.path(data.dir, "Query_2007-2012.xlsx"))
+ hab_2013_odu <- read_excel(
+ file.path(data.dir, "2013 ODU Data.xlsx"),
+ skip = 4
+ )
+ hab_2013_vims <- read_excel(file.path(data.dir, "vims_2013.xlsx"), skip = 6)
+ hab_2014_odu <- read_excel(file.path(data.dir, "2014 ODU data.xlsx"))
+ hab_2014_vims <- read_excel(file.path(
+ data.dir,
+ "FINALforVDH_22Dec14final.xlsx"
+ ))
+ hab_2016 <- read_excel(file.path(data.dir, "HAB_MAP_Data_2016.xlsx"))
+ hab_2017 <- read_excel(
+ file.path(data.dir, "HAB_MAP_Data_2017.xlsx"),
+ sheet = 2
+ )
+
+ #2012---------------------------------------------------------
+ HAB_2007_2012 <- hab_2007_2012 %>%
+ filter(!is.na(cells_per_ml)) %>%
+ filter(!is.na(date)) %>%
+ mutate(year = format(as.POSIXct(date), "%Y")) %>%
+ filter(cells_per_ml >= cpm) %>%
+ group_by(year, species) %>%
+ dplyr::summarise(Events = n()) %>%
+ as.data.frame()
+
+ #2013---------------------------------------------------------
+ #ODU
+ odu_2013 <- gather(
+ hab_2013_odu,
+ species,
+ cells_per_ml,
+ `Pfiesteria like dinoflagellate`:`A. monilatum`
+ ) %>%
+ filter(!is.na(cells_per_ml)) %>%
+ filter(cells_per_ml >= cpm) %>%
+ mutate(year = 2013) %>%
+ group_by(year, species) %>%
+ dplyr::summarise(Events = n()) %>%
+ as.data.frame()
+
+ #VIMS
+ vims_2013 <- hab_2013_vims %>%
+ filter(!is.na(cells_per_ml)) %>%
+ mutate(year = "2013") %>%
+ filter(cells_per_ml >= cpm) %>%
+ group_by(year, species) %>%
+ dplyr::summarise(Events = n()) %>%
+ as.data.frame()
+
+ HAB_2013 <- rbind(vims_2013, odu_2013)
+
+ #2014--------------------------------------------------------
+ #ODU
+ long <- gather(
+ hab_2014_odu,
+ species,
+ cells_per_ml,
+ `Karlodinium veneficum`:`Cyanobacteria bloom`,
+ factor_key = TRUE
+ )
+ hab_2014_odu <- long %>% filter(cells_per_ml != 0)
+ hab_2014_odu$species <- sub("[.]", " ", hab_2014_odu$species)
+ hab_2014_odu$cells_per_ml <- gsub(
+ "[A-Za-z+//]",
+ '',
+ hab_2014_odu$cells_per_ml
+ )
+ hab_2014_odu$cells_per_ml <- as.numeric(hab_2014_odu$cells_per_ml)
+
+ hab_2014_odu <- hab_2014_odu %>%
+ mutate(year = "2014") %>%
+ filter(cells_per_ml >= cpm) %>%
+ group_by(year, species) %>%
+ dplyr::summarise(Events = n()) %>%
+ as.data.frame()
+
+ #VIMS
+ long <- gather(
+ hab_2014_vims,
+ species,
+ cells_per_ml,
+ `A. monilatum`:`C. subsalsa`
+ )
+ hab_2014_vims <- long %>%
+ mutate(year = "2014") %>%
+ filter(!is.na(cells_per_ml)) %>%
+ mutate(cells_per_ml = as.numeric(cells_per_ml)) %>%
+ filter(cells_per_ml >= cpm) %>%
+ group_by(year, species) %>%
+ dplyr::summarise(Events = n()) %>%
+ as.data.frame()
+ HAB_2014 <- rbind(hab_2014_odu, hab_2014_vims)
+
+ #2015----------------------------------------------------------
+ #No data
+
+ #2016---------------------------------------------------------
+ HAB_2016 <- hab_2016 %>%
+ mutate(
+ species = plyr::mapvalues(
+ species,
+ from = c(
+ "Eugelna sanguinea",
+ "Microcystin aeruginosa",
+ "Microcystis aeruginosa",
+ "Alexandrium monilatum-likely",
+ "Alexandrium monilatum"
+ ),
+ to = c(
+ "Eugelena spp.",
+ "Microcystis spp.",
+ "Microcystis spp.",
+ "Alexandrium spp.",
+ "Alexandrium spp."
+ )
+ )
+ )
+ HAB_2016$cells_per_ml <- gsub('[a-zA-Z+<>]', '', HAB_2016$cells_per_ml)
+ HAB_2016 <- HAB_2016 %>%
+ filter(!is.na(cells_per_ml)) %>%
+ mutate(year = 2016, cells_per_ml = as.numeric(cells_per_ml)) %>%
+ filter(cells_per_ml >= cpm) %>%
+ group_by(year, species) %>%
+ dplyr::summarise(Events = n()) %>%
+ as.data.frame()
+
+ #2017------------------------------------------------------------
+ hab_2017$species <- str_trim(hab_2017$species)
+ HAB_2017 <- hab_2017 %>%
+ mutate(
+ species = plyr::mapvalues(
+ species,
+ c(
+ "A. monilatum",
+ "Anabaena sp",
+ "Anabaena sp.",
+ "Anabaena spp",
+ "none",
+ "NO HABs",
+ "C. polykrikoides",
+ "Microcystis aeurignosa",
+ "Cylindrospermopsis sp"
+ ),
+ c(
+ "Alexandrium monilatum",
+ "Anabaena spp.",
+ "Anabaena spp.",
+ "Anabaena spp.",
+ "NA",
+ "NA",
+ "Cochlodinium polykrikoides",
+ "Microcystis aeruginosa",
+ "Cylindrospermopsis sp."
+ )
+ )
+ )
+ HAB_2017$cells_per_ml <- gsub("[a-zA-Z+/]", '', HAB_2017$cells_per_ml)
+ HAB_2017$cells_per_ml <- str_trim(HAB_2017$cells_per_ml)
+ HAB_2017$cells_per_ml <- as.numeric(HAB_2017$cells_per_ml)
+ HAB_2017 <- HAB_2017 %>%
+ filter(!is.na(cells_per_ml)) %>%
+ mutate(year = "2017") %>%
+ filter(cells_per_ml >= cpm) %>%
+ group_by(year, species) %>%
+ dplyr::summarise(Events = n()) %>%
+ as.data.frame()
+
+ #Aggregate--------------------------------------------------------
+ ts <- rbind(HAB_2007_2012, HAB_2013, HAB_2014, HAB_2016, HAB_2017)
+
+ return(ts)
+}
+
+#All blooms > 5000 cells ml^-1
+full <- fixer(cpm = 5000)
+full <- full %>% group_by(year) %>% dplyr::summarise(total = sum(Events))
+plot(
+ full$year,
+ full$total,
+ type = "o",
+ ylim = c(0, 90),
+ pch = 20,
+ ylab = "Bloom Events",
+ las = 1,
+ xlab = "Time",
+ lwd = 2
+)
+
+#cochlodinum > 300 cells ml^-1
+cochlo <- fixer(cpm = 300)
+cochlo[
+ cochlo$species == "C. polykrikoides" |
+ cochlo$species == "C.polykrikoides",
+]$species <- "Cochlodinium polykrikoides"
+cochlo <- cochlo[cochlo$species == "Cochlodinium polykrikoides", ]
+cochlo <- cochlo %>% group_by(year) %>% dplyr::summarise(total = sum(Events))
+points(
+ cochlo$year,
+ cochlo$total,
+ type = "o",
+ pch = 20,
+ col = "indianred",
+ lwd = 2
+)
+legend(
+ x = 2007,
+ y = 80,
+ legend = c(
+ expression(paste("All reports >5000 cells ml"^"-1")),
+ expression(paste(italic("C. polykrikoides "), "reports >300 cells ml"^"-1"))
+ ),
+ col = c("black", "indianred"),
+ lwd = 2,
+ bty = "n"
+)
+#```
diff --git a/R/stored_scripts/ne_hab_plotting.R b/R/stored_scripts/ne_hab_plotting.R
index 2528c3f0..b6a8c49a 100644
--- a/R/stored_scripts/ne_hab_plotting.R
+++ b/R/stored_scripts/ne_hab_plotting.R
@@ -1,82 +1,119 @@
-## ne hab plotting
-
-#```{r NE-HAB, fig.cap="Regional HAB related shellfish bed closures in New England between 2007 and 2016.", fig.asp=1.1, fig.align='center', message=F, warning=F, echo = T}
-#get map data and set constants
-
-# Relative working directories
-data.dir <- here::here('data')
-r.dir <- here::here('R')
-gis.dir <- here::here('gis')
-
-#Source GIS script
-source(file.path(r.dir, "GIS_source.R"))
-
-# Load data
-load(file.path(data.dir,"SOE_data_erddap.Rdata"))
-
-
-#projection
-map.crs <- CRS("+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
- +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")
-
-#coastline
-coast <- readOGR(gis.dir, 'NES_LME_coast', verbose = F)
-coast <- spTransform(coast,map.crs)
-
-#define extents for cropping
-e1 <- extent(-78.5, -64, 41, 45)
-
-#crop
-coast1 <- crop(coast, e1)
-
-#Get data from SOE dataset
-events <- SOE.data[grepl("SP occurrence",SOE.data$Var),]
-lon <- SOE.data %>%
- dplyr::filter(Var == "NE HAB Regional center Lon") %>% pull(Value)
-lat <- SOE.data %>%
- dplyr::filter(Var == "NE HAB Regional center Lat") %>% pull(Value)
-
-events_df <- data.frame(lon = lon,
- lat = lat,
- val = events$Value,
- var = events$Var)
-
-
-g1 <- events_df %>% filter(val == 8)
-#g2 <- events_df %>% filter(val == 3.5)
-g3 <- events_df %>% filter(val == 1)
-
-#data.frame to sp object
-coordinates(g1) <- ~lon+lat
-g1@proj4string <- map.crs
-g1 <- spTransform(g1, map.crs)
-
-coordinates(g3) <- ~lon+lat
-g3@proj4string <- map.crs
-g3 <- spTransform(g3, map.crs)
-
-
-#plot map and dots of different size based on category
-par(mar = c(0,2.8,0,0.2))
-plot(coast1, xlim = c(-71.5,-64.5),ylim = c(41,45),col = "grey",yaxs="i")
-plot(g1, add = T,cex = 6, pch = 16, col = "darkorange")
-#plot(g2, add = T,cex = 4, pch = 16, col = "purple")
-plot(g3, add = T,cex = 2, pch = 16, col = c("purple","#56B4E9"))
-
-axis(1, at = c(-71,-69,-67,-65), labels = paste( c(-71,-69,-67,-65) * -1, 'W')
- ,col = NA, col.ticks = 1, pos = 41)
-axis(2, at = c(45, 44, 43, 42, 41.05), labels = paste(c(45, 44, 43, 42, 41), 'N')
- , las = T, pos = -71.78,col = NA, col.ticks = 1)
-legend(-66.2,42.5, c("PSP", "ASP", "DSP"), col = c("darkorange","purple","#56B4E9"), pch = 16,
- cex = 1.1, bty = "n", pt.cex = 2)
-text(-65.65,42.495, "Category")
-arrows(-71.765,41,-71.765,45,angle = 90,lwd = 2)
-arrows(-64.22,41,-64.22,45,angle = 90,lwd = 2)
-abline(h = 41, lwd = 2)
-abline(h = 45, lwd = 2)
-abline(v = -64, lwd = 2)
-legend(-67.9,42.5, c("6-10", "2-5", "1"), col = c("black"), pch = 16, cex = 1.1,
- pt.cex = c(6,4,2), x.intersp = 1.45, y.intersp = 1.75, bty = "n")
-text(-67.7,42.525, "2007-2016 Detections")
-
-#```
\ No newline at end of file
+## ne hab plotting
+
+#```{r NE-HAB, fig.cap="Regional HAB related shellfish bed closures in New England between 2007 and 2016.", fig.asp=1.1, fig.align='center', message=F, warning=F, echo = T}
+#get map data and set constants
+
+# Relative working directories
+data.dir <- here::here('data')
+r.dir <- here::here('R')
+gis.dir <- here::here('gis')
+
+#Source GIS script
+source(file.path(r.dir, "GIS_source.R"))
+
+# Load data
+load(file.path(data.dir, "SOE_data_erddap.Rdata"))
+
+
+#projection
+map.crs <- CRS(
+ "+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
+ +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0"
+)
+
+#coastline
+coast <- readOGR(gis.dir, 'NES_LME_coast', verbose = F)
+coast <- spTransform(coast, map.crs)
+
+#define extents for cropping
+e1 <- extent(-78.5, -64, 41, 45)
+
+#crop
+coast1 <- crop(coast, e1)
+
+#Get data from SOE dataset
+events <- SOE.data[grepl("SP occurrence", SOE.data$Var), ]
+lon <- SOE.data %>%
+ dplyr::filter(Var == "NE HAB Regional center Lon") %>%
+ pull(Value)
+lat <- SOE.data %>%
+ dplyr::filter(Var == "NE HAB Regional center Lat") %>%
+ pull(Value)
+
+events_df <- data.frame(
+ lon = lon,
+ lat = lat,
+ val = events$Value,
+ var = events$Var
+)
+
+
+g1 <- events_df %>% filter(val == 8)
+#g2 <- events_df %>% filter(val == 3.5)
+g3 <- events_df %>% filter(val == 1)
+
+#data.frame to sp object
+coordinates(g1) <- ~ lon + lat
+g1@proj4string <- map.crs
+g1 <- spTransform(g1, map.crs)
+
+coordinates(g3) <- ~ lon + lat
+g3@proj4string <- map.crs
+g3 <- spTransform(g3, map.crs)
+
+
+#plot map and dots of different size based on category
+par(mar = c(0, 2.8, 0, 0.2))
+plot(coast1, xlim = c(-71.5, -64.5), ylim = c(41, 45), col = "grey", yaxs = "i")
+plot(g1, add = T, cex = 6, pch = 16, col = "darkorange")
+#plot(g2, add = T,cex = 4, pch = 16, col = "purple")
+plot(g3, add = T, cex = 2, pch = 16, col = c("purple", "#56B4E9"))
+
+axis(
+ 1,
+ at = c(-71, -69, -67, -65),
+ labels = paste(c(-71, -69, -67, -65) * -1, 'W'),
+ col = NA,
+ col.ticks = 1,
+ pos = 41
+)
+axis(
+ 2,
+ at = c(45, 44, 43, 42, 41.05),
+ labels = paste(c(45, 44, 43, 42, 41), 'N'),
+ las = T,
+ pos = -71.78,
+ col = NA,
+ col.ticks = 1
+)
+legend(
+ -66.2,
+ 42.5,
+ c("PSP", "ASP", "DSP"),
+ col = c("darkorange", "purple", "#56B4E9"),
+ pch = 16,
+ cex = 1.1,
+ bty = "n",
+ pt.cex = 2
+)
+text(-65.65, 42.495, "Category")
+arrows(-71.765, 41, -71.765, 45, angle = 90, lwd = 2)
+arrows(-64.22, 41, -64.22, 45, angle = 90, lwd = 2)
+abline(h = 41, lwd = 2)
+abline(h = 45, lwd = 2)
+abline(v = -64, lwd = 2)
+legend(
+ -67.9,
+ 42.5,
+ c("6-10", "2-5", "1"),
+ col = c("black"),
+ pch = 16,
+ cex = 1.1,
+ pt.cex = c(6, 4, 2),
+ x.intersp = 1.45,
+ y.intersp = 1.75,
+ bty = "n"
+)
+text(-67.7, 42.525, "2007-2016 Detections")
+
+#```
diff --git a/R/stored_scripts/observer_data_plotting.R b/R/stored_scripts/observer_data_plotting.R
index fe4eadbb..2671bc80 100644
--- a/R/stored_scripts/observer_data_plotting.R
+++ b/R/stored_scripts/observer_data_plotting.R
@@ -1,54 +1,75 @@
-# observer data plotting
-
-#```{r, echo = T, eval = F}
-
-#For map and plot. Latitude and longitude data for this figure are not publicly available.
-sk.dat <- SOE.data[grepl("Lat",SOE.data$Units) &
- grepl("Southern Kingfish",SOE.data$Var),]
-lon <- sk.dat[as.numeric(sk.dat$Value) < 0,]$Value
-lat <- sk.dat[as.numeric(sk.dat$Value) > 0,]$Value
-
-#create data.frame
-df <- data.frame(year = sk.dat$Time,
- lon = lon,
- lat = lat)
-
-#set color palette
-colors1 <- adjustcolor(matlab.like2(8),.5)
-colors2 <- adjustcolor(matlab.like2(8),.5)
-colors3 <- adjustcolor(matlab.like2(8),.5)
-colors4 <- adjustcolor(matlab.like2(8),1)
-colors <- c(colors1[1:2], colors2[3:4], colors3[5:6],colors4[7:8])
-
-#map values to colors
-df <- df %>% arrange(year) %>%
- mutate(colors = plyr::mapvalues(year, from = c("2010","2011","2012","2013",
- "2014","2015","2016","2017"),
- to = c(colors)))
-colors <- df$colors
-
-#projection
-map.crs <- CRS("+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
- +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0")
-
-#data.frame to sp object
-coordinates(df) <- ~lon+lat
-df@proj4string <- map.crs
-df <- spTransform(df, map.crs)
-
-#plot
-par(fig = c(0,1,0,1))
-plot(coast, xlim = c(-76,-73), ylim = c(35,40.5),col = "grey")
-plot(df, pch = 16, col = colors, add = T, cex = 2.5)
-
-
-occur <- SOE.data[SOE.data$Var == "Southern Kingfish observer sightings",]$Value
-time <- SOE.data[SOE.data$Var == "Southern Kingfish observer sightings",]$Time
-
-ts <- zoo(occur,time)
-par(fig = c(0.5,1, 0.1, .5), new = T, bty = "l",mar = c(5,6,3,1))
-barplot(occur,time, col = matlab.like2(8), xlab = c("Time"),ylab = "S. Kingfish Occurrence, n",
- cex.lab = 1, las = 1, cex.axis = 1)
-axis(1,at = seq(1250,18500,length.out = 8),labels = c("2010","2011","2012","2013",
- "2014","2015","2016","2017"), cex.axis=1)
-#```
\ No newline at end of file
+# observer data plotting
+
+#```{r, echo = T, eval = F}
+
+#For map and plot. Latitude and longitude data for this figure are not publicly available.
+sk.dat <- SOE.data[
+ grepl("Lat", SOE.data$Units) &
+ grepl("Southern Kingfish", SOE.data$Var),
+]
+lon <- sk.dat[as.numeric(sk.dat$Value) < 0, ]$Value
+lat <- sk.dat[as.numeric(sk.dat$Value) > 0, ]$Value
+
+#create data.frame
+df <- data.frame(year = sk.dat$Time, lon = lon, lat = lat)
+
+#set color palette
+colors1 <- adjustcolor(matlab.like2(8), .5)
+colors2 <- adjustcolor(matlab.like2(8), .5)
+colors3 <- adjustcolor(matlab.like2(8), .5)
+colors4 <- adjustcolor(matlab.like2(8), 1)
+colors <- c(colors1[1:2], colors2[3:4], colors3[5:6], colors4[7:8])
+
+#map values to colors
+df <- df %>%
+ arrange(year) %>%
+ mutate(
+ colors = plyr::mapvalues(
+ year,
+ from = c("2010", "2011", "2012", "2013", "2014", "2015", "2016", "2017"),
+ to = c(colors)
+ )
+ )
+colors <- df$colors
+
+#projection
+map.crs <- CRS(
+ "+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
+ +y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0"
+)
+
+#data.frame to sp object
+coordinates(df) <- ~ lon + lat
+df@proj4string <- map.crs
+df <- spTransform(df, map.crs)
+
+#plot
+par(fig = c(0, 1, 0, 1))
+plot(coast, xlim = c(-76, -73), ylim = c(35, 40.5), col = "grey")
+plot(df, pch = 16, col = colors, add = T, cex = 2.5)
+
+
+occur <- SOE.data[
+ SOE.data$Var == "Southern Kingfish observer sightings",
+]$Value
+time <- SOE.data[SOE.data$Var == "Southern Kingfish observer sightings", ]$Time
+
+ts <- zoo(occur, time)
+par(fig = c(0.5, 1, 0.1, .5), new = T, bty = "l", mar = c(5, 6, 3, 1))
+barplot(
+ occur,
+ time,
+ col = matlab.like2(8),
+ xlab = c("Time"),
+ ylab = "S. Kingfish Occurrence, n",
+ cex.lab = 1,
+ las = 1,
+ cex.axis = 1
+)
+axis(
+ 1,
+ at = seq(1250, 18500, length.out = 8),
+ labels = c("2010", "2011", "2012", "2013", "2014", "2015", "2016", "2017"),
+ cex.axis = 1
+)
+#```
diff --git a/R/stored_scripts/occupancy_plotting.R b/R/stored_scripts/occupancy_plotting.R
index 423e0dee..d77b60e5 100644
--- a/R/stored_scripts/occupancy_plotting.R
+++ b/R/stored_scripts/occupancy_plotting.R
@@ -1,27 +1,47 @@
-# summer flounder occupancy model plot
-
-#```{r occupancy-MAB, fig.cap="Summer flounder spring (A) and fall (B) occupancy habitat area in the Northeast Large Marine Ecosystem. ", echo = T, fig.show='hold', warning = F, message = F,fig.pos='H'}
-
-# Relative working directories
-data.dir <- here::here('data')
-r.dir <- here::here('R')
-
-# Load data
-load(file.path(data.dir,"SOE_data_erddap.Rdata"))
-
-# Source plotting functions
-source(file.path(r.dir,"BasePlot_source.R"))
-
-
-opar <- par(mfrow = c(2, 1), mar = c(0, 0, 0, 0), oma = c(3.5, 5, 2, 4))
-
-soe.plot(SOE.data, "Time", "sumflo spring habitat occupancy", stacked = "A",
- rel.y.num = 1.1, scale.axis = 10^3, end.start = 2007, full.trend = F,
- cex.stacked = 1.5)
-soe.plot(SOE.data, "Time", "sumflo fall habitat occupancy", stacked = "B",
- rel.y.num = 1.1, scale.axis = 10^3, end.start = 2007, full.trend = F,
- cex.stacked = 1.5)
-
-soe.stacked.axis("Year", expression("Habitat Area, 10"^3*" km"^2), y.line = 2.5)
-
-#```
\ No newline at end of file
+# summer flounder occupancy model plot
+
+#```{r occupancy-MAB, fig.cap="Summer flounder spring (A) and fall (B) occupancy habitat area in the Northeast Large Marine Ecosystem. ", echo = T, fig.show='hold', warning = F, message = F,fig.pos='H'}
+
+# Relative working directories
+data.dir <- here::here('data')
+r.dir <- here::here('R')
+
+# Load data
+load(file.path(data.dir, "SOE_data_erddap.Rdata"))
+
+# Source plotting functions
+source(file.path(r.dir, "BasePlot_source.R"))
+
+
+opar <- par(mfrow = c(2, 1), mar = c(0, 0, 0, 0), oma = c(3.5, 5, 2, 4))
+
+soe.plot(
+ SOE.data,
+ "Time",
+ "sumflo spring habitat occupancy",
+ stacked = "A",
+ rel.y.num = 1.1,
+ scale.axis = 10^3,
+ end.start = 2007,
+ full.trend = F,
+ cex.stacked = 1.5
+)
+soe.plot(
+ SOE.data,
+ "Time",
+ "sumflo fall habitat occupancy",
+ stacked = "B",
+ rel.y.num = 1.1,
+ scale.axis = 10^3,
+ end.start = 2007,
+ full.trend = F,
+ cex.stacked = 1.5
+)
+
+soe.stacked.axis(
+ "Year",
+ expression("Habitat Area, 10"^3 * " km"^2),
+ y.line = 2.5
+)
+
+#```
diff --git a/R/stored_scripts/rec_catch_div_analysis.R b/R/stored_scripts/rec_catch_div_analysis.R
index d7762c64..c1d20857 100644
--- a/R/stored_scripts/rec_catch_div_analysis.R
+++ b/R/stored_scripts/rec_catch_div_analysis.R
@@ -1,30 +1,32 @@
-# rec catch div analysis
-
-
-
-#```{r, eval = F, include = T, echo = T}
-REC_CATCH <- read.csv('X:/gdepiper/ESR2018/SOE/Data/Rec_Species_Quantity_2018.csv', as.is=TRUE)
-
-REC_CATCH$Value <- as.numeric(gsub(",","",REC_CATCH$Value))
-TOT_REC_CATCH <- aggregate(Value~Time+Region, data=REC_CATCH, FUN=sum)
-names(TOT_REC_CATCH) <- c('Time','Region','Tot_Catch')
-REC_CATCH <- merge(REC_CATCH,TOT_REC_CATCH, by=c('Time','Region'))
-REC_CATCH$P_Catch <- -(REC_CATCH$Value/REC_CATCH$Tot_Catch*
- log(REC_CATCH$Value/REC_CATCH$Tot_Catch))
-REC_CATCH <- aggregate(P_Catch~Time+Region, data=REC_CATCH, FUN=sum)
-REC_CATCH$Value <- exp(REC_CATCH$P_Catch)
-REC_CATCH <- subset(REC_CATCH, select=c('Time','Region','Value'))
-REC_CATCH$Region[REC_CATCH$Region=="MID-ATLANTIC"] <- 'MA'
-REC_CATCH$Region[REC_CATCH$Region=="NORTH ATLANTIC"] <- 'NE'
-REC_CATCH$Units <- 'Effective Shannon'
-REC_CATCH$Var <- 'Recreational Diversity of Catch'
-
-##Species include: American Eel, Atlantic Cod, Atlantic Mackerel,
-##Atlantic Sturgeon, Black Drum, Black Sea Bass, Bluefish,
-##Cobia, Haddock, Pollock, Red Drum, Scup, Spanish Mackerel,
-##Spiny Dogfish, Spot, Spotted Seatrout, Striped Bass,
-##Summer Flounder, Tautog, Tilefish, Weakfish, Winter Flounder,
-#and All Other Species.
-
-REC_CATCH$Source <- 'MRIP catch time series.'
-#```
\ No newline at end of file
+# rec catch div analysis
+
+#```{r, eval = F, include = T, echo = T}
+REC_CATCH <- read.csv(
+ 'X:/gdepiper/ESR2018/SOE/Data/Rec_Species_Quantity_2018.csv',
+ as.is = TRUE
+)
+
+REC_CATCH$Value <- as.numeric(gsub(",", "", REC_CATCH$Value))
+TOT_REC_CATCH <- aggregate(Value ~ Time + Region, data = REC_CATCH, FUN = sum)
+names(TOT_REC_CATCH) <- c('Time', 'Region', 'Tot_Catch')
+REC_CATCH <- merge(REC_CATCH, TOT_REC_CATCH, by = c('Time', 'Region'))
+REC_CATCH$P_Catch <- -(REC_CATCH$Value /
+ REC_CATCH$Tot_Catch *
+ log(REC_CATCH$Value / REC_CATCH$Tot_Catch))
+REC_CATCH <- aggregate(P_Catch ~ Time + Region, data = REC_CATCH, FUN = sum)
+REC_CATCH$Value <- exp(REC_CATCH$P_Catch)
+REC_CATCH <- subset(REC_CATCH, select = c('Time', 'Region', 'Value'))
+REC_CATCH$Region[REC_CATCH$Region == "MID-ATLANTIC"] <- 'MA'
+REC_CATCH$Region[REC_CATCH$Region == "NORTH ATLANTIC"] <- 'NE'
+REC_CATCH$Units <- 'Effective Shannon'
+REC_CATCH$Var <- 'Recreational Diversity of Catch'
+
+##Species include: American Eel, Atlantic Cod, Atlantic Mackerel,
+##Atlantic Sturgeon, Black Drum, Black Sea Bass, Bluefish,
+##Cobia, Haddock, Pollock, Red Drum, Scup, Spanish Mackerel,
+##Spiny Dogfish, Spot, Spotted Seatrout, Striped Bass,
+##Summer Flounder, Tautog, Tilefish, Weakfish, Winter Flounder,
+#and All Other Species.
+
+REC_CATCH$Source <- 'MRIP catch time series.'
+#```
diff --git a/R/stored_scripts/rec_div_analysis.R b/R/stored_scripts/rec_div_analysis.R
index b9200333..2aeab84e 100644
--- a/R/stored_scripts/rec_div_analysis.R
+++ b/R/stored_scripts/rec_div_analysis.R
@@ -1,31 +1,44 @@
-# rec div analysis
-
-
-#```{r, eval = F, include = T, echo = T}
-REC_DATA <- read.csv('X:/gdepiper/ESR2018/SOE/Data/Rec_Days_Fished_2018.csv', as.is=TRUE)
-
-REC_DATA$P_Shore <- -(as.numeric(gsub("","",'""',REC_DATA$Shore)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes))) *
- log(as.numeric(gsub("","",'""',REC_DATA$Shore)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes)))
-
-REC_DATA$P_Private <- -(as.numeric(gsub("","",'""',REC_DATA$Private_Rental)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes))) *
- log(as.numeric(gsub("","",'""',REC_DATA$Private_Rental)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes)))
-
-REC_DATA$P_Party <- -(as.numeric(gsub("","",'""',REC_DATA$Party_Charter)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes))) *
- log(as.numeric(gsub("","",'""',REC_DATA$Party_Charter)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes)))
-
-REC_DATA$Value <- exp(REC_DATA$P_Shore+REC_DATA$P_Private+REC_DATA$P_Party)
-
-REC_DATA$Region[REC_DATA$Region=='"MID-ATLANTIC"'] <- 'MA'
-REC_DATA$Region[REC_DATA$Region=='"NORTH ATLANTIC"'] <- 'NE'
-
-E_SHANNON <- subset(REC_DATA, select=c('Time','Region','Value'))
-E_SHANNON$Units <- 'Effective Shannon'
-E_SHANNON$Var <- 'Recreational fleet effort diversity across modes'
-E_SHANNON$Source <- 'MRIP effort time series, processed to generate diversity measure.'
-#```
\ No newline at end of file
+# rec div analysis
+
+#```{r, eval = F, include = T, echo = T}
+REC_DATA <- read.csv(
+ 'X:/gdepiper/ESR2018/SOE/Data/Rec_Days_Fished_2018.csv',
+ as.is = TRUE
+)
+
+REC_DATA$P_Shore <- -(as.numeric(gsub("", "", '""', REC_DATA$Shore)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))) *
+ log(
+ as.numeric(gsub("", "", '""', REC_DATA$Shore)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))
+ )
+
+REC_DATA$P_Private <- -(as.numeric(gsub(
+ "",
+ "",
+ '""',
+ REC_DATA$Private_Rental
+)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))) *
+ log(
+ as.numeric(gsub("", "", '""', REC_DATA$Private_Rental)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))
+ )
+
+REC_DATA$P_Party <- -(as.numeric(gsub("", "", '""', REC_DATA$Party_Charter)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))) *
+ log(
+ as.numeric(gsub("", "", '""', REC_DATA$Party_Charter)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))
+ )
+
+REC_DATA$Value <- exp(REC_DATA$P_Shore + REC_DATA$P_Private + REC_DATA$P_Party)
+
+REC_DATA$Region[REC_DATA$Region == '"MID-ATLANTIC"'] <- 'MA'
+REC_DATA$Region[REC_DATA$Region == '"NORTH ATLANTIC"'] <- 'NE'
+
+E_SHANNON <- subset(REC_DATA, select = c('Time', 'Region', 'Value'))
+E_SHANNON$Units <- 'Effective Shannon'
+E_SHANNON$Var <- 'Recreational fleet effort diversity across modes'
+E_SHANNON$Source <- 'MRIP effort time series, processed to generate diversity measure.'
+#```
diff --git a/R/stored_scripts/rec_effort_div_analysis.R b/R/stored_scripts/rec_effort_div_analysis.R
index b9200333..2aeab84e 100644
--- a/R/stored_scripts/rec_effort_div_analysis.R
+++ b/R/stored_scripts/rec_effort_div_analysis.R
@@ -1,31 +1,44 @@
-# rec div analysis
-
-
-#```{r, eval = F, include = T, echo = T}
-REC_DATA <- read.csv('X:/gdepiper/ESR2018/SOE/Data/Rec_Days_Fished_2018.csv', as.is=TRUE)
-
-REC_DATA$P_Shore <- -(as.numeric(gsub("","",'""',REC_DATA$Shore)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes))) *
- log(as.numeric(gsub("","",'""',REC_DATA$Shore)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes)))
-
-REC_DATA$P_Private <- -(as.numeric(gsub("","",'""',REC_DATA$Private_Rental)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes))) *
- log(as.numeric(gsub("","",'""',REC_DATA$Private_Rental)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes)))
-
-REC_DATA$P_Party <- -(as.numeric(gsub("","",'""',REC_DATA$Party_Charter)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes))) *
- log(as.numeric(gsub("","",'""',REC_DATA$Party_Charter)) /
- as.numeric(gsub("","",'""',REC_DATA$All_Modes)))
-
-REC_DATA$Value <- exp(REC_DATA$P_Shore+REC_DATA$P_Private+REC_DATA$P_Party)
-
-REC_DATA$Region[REC_DATA$Region=='"MID-ATLANTIC"'] <- 'MA'
-REC_DATA$Region[REC_DATA$Region=='"NORTH ATLANTIC"'] <- 'NE'
-
-E_SHANNON <- subset(REC_DATA, select=c('Time','Region','Value'))
-E_SHANNON$Units <- 'Effective Shannon'
-E_SHANNON$Var <- 'Recreational fleet effort diversity across modes'
-E_SHANNON$Source <- 'MRIP effort time series, processed to generate diversity measure.'
-#```
\ No newline at end of file
+# rec div analysis
+
+#```{r, eval = F, include = T, echo = T}
+REC_DATA <- read.csv(
+ 'X:/gdepiper/ESR2018/SOE/Data/Rec_Days_Fished_2018.csv',
+ as.is = TRUE
+)
+
+REC_DATA$P_Shore <- -(as.numeric(gsub("", "", '""', REC_DATA$Shore)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))) *
+ log(
+ as.numeric(gsub("", "", '""', REC_DATA$Shore)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))
+ )
+
+REC_DATA$P_Private <- -(as.numeric(gsub(
+ "",
+ "",
+ '""',
+ REC_DATA$Private_Rental
+)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))) *
+ log(
+ as.numeric(gsub("", "", '""', REC_DATA$Private_Rental)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))
+ )
+
+REC_DATA$P_Party <- -(as.numeric(gsub("", "", '""', REC_DATA$Party_Charter)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))) *
+ log(
+ as.numeric(gsub("", "", '""', REC_DATA$Party_Charter)) /
+ as.numeric(gsub("", "", '""', REC_DATA$All_Modes))
+ )
+
+REC_DATA$Value <- exp(REC_DATA$P_Shore + REC_DATA$P_Private + REC_DATA$P_Party)
+
+REC_DATA$Region[REC_DATA$Region == '"MID-ATLANTIC"'] <- 'MA'
+REC_DATA$Region[REC_DATA$Region == '"NORTH ATLANTIC"'] <- 'NE'
+
+E_SHANNON <- subset(REC_DATA, select = c('Time', 'Region', 'Value'))
+E_SHANNON$Units <- 'Effective Shannon'
+E_SHANNON$Var <- 'Recreational fleet effort diversity across modes'
+E_SHANNON$Source <- 'MRIP effort time series, processed to generate diversity measure.'
+#```
diff --git a/R/stored_scripts/seabird_ne_div_analysis.R b/R/stored_scripts/seabird_ne_div_analysis.R
index e8ddaa92..f9baefdc 100644
--- a/R/stored_scripts/seabird_ne_div_analysis.R
+++ b/R/stored_scripts/seabird_ne_div_analysis.R
@@ -1,23 +1,23 @@
-#common tern diversity analysis
-
-
-
-#```{r diet-div, eval = T, echo = T}
-#Calculating time series of diversity indices using the vegan package.
-diet_div <- ecodata::common_tern %>%
- filter(str_detect(Var, "Diet"),
- !str_detect(Var, "Sum")) %>%
- mutate(Island = word(Var, 1),
- Var = word(Var, 4)) %>%
- group_by(Island, Time) %>%
- dplyr::summarise(evenness = diversity(Value)/log(specnumber(Value)),
- shannon = diversity(Value),
- simpson = diversity(Value, index = "simpson")) %>%
- gather(.,Var,Value,-Island, -Time) %>%
- group_by(Var, Time) %>%
- dplyr::summarize(Value = mean(Value, na.rm = T),
- sd = sd(Value, na.rm = T),
- n = n()) %>%
- group_by(Var) %>%
- mutate(hline = mean(Value, na.rm = T))
-#```
\ No newline at end of file
+#common tern diversity analysis
+
+#```{r diet-div, eval = T, echo = T}
+#Calculating time series of diversity indices using the vegan package.
+diet_div <- ecodata::common_tern %>%
+ filter(str_detect(Var, "Diet"), !str_detect(Var, "Sum")) %>%
+ mutate(Island = word(Var, 1), Var = word(Var, 4)) %>%
+ group_by(Island, Time) %>%
+ dplyr::summarise(
+ evenness = diversity(Value) / log(specnumber(Value)),
+ shannon = diversity(Value),
+ simpson = diversity(Value, index = "simpson")
+ ) %>%
+ gather(., Var, Value, -Island, -Time) %>%
+ group_by(Var, Time) %>%
+ dplyr::summarize(
+ Value = mean(Value, na.rm = T),
+ sd = sd(Value, na.rm = T),
+ n = n()
+ ) %>%
+ group_by(Var) %>%
+ mutate(hline = mean(Value, na.rm = T))
+#```
diff --git a/R/stored_scripts/slopewater_analysis.R b/R/stored_scripts/slopewater_analysis.R
index bb04dbbd..0d8d0a39 100644
--- a/R/stored_scripts/slopewater_analysis.R
+++ b/R/stored_scripts/slopewater_analysis.R
@@ -1,31 +1,33 @@
-## slopewater analysis
-
-
-#```{octave, eval = F}
-
-function [m1 m2 m3]=my_SLWpercent(T,S);
-%
-% analytically determine the proportions of water masses in a given sample,
-% as a combination of three component water masses. T and S can be a vector % of observations.
-% m1 represents the fraction of the sample that corresponds to Scotian Shelf Water (SSW), m2 the fraction corresponding
-% to Warm Slope Water (WSW) and m3 the fraction corresponding to Labrador
-% Slope Water (LSlW).
-%
-% Here we use Cramer's rule to solve the following system of equations:
-% T1*m1 + T2*m2 + T3*m3 = T
-% S1*m1 + S2*m2 + S3*m3 = S
-% m1 + m2 + m3 = 1
-%
-% p.fratantoni, 6/2011
-%
-
-T1=2;S1=32; % SSW
-T2=10;S2=35; % wSLW
-T3=6;S3=34.7; % cLSW
-
-delta=T1*(S2-S3)-S1*(T2-T3)+T2*S3-T3*S2;
-
-m1=(T.*(S2-S3)+S.*(T3-T2)+T2*S3-T3*S2)./delta;
-m2=(T.*(S3-S1)+S.*(T1-T3)+T3*S1-T1*S3)./delta;
-m3=(T.*(S1-S2)+S.*(T2-T1)+T1*S2-T2*S1)./delta;
-#```
\ No newline at end of file
+## slopewater analysis
+
+#```{octave, eval = F}
+
+#function [m1 m2 m3]=my_SLWpercent(T,S);
+#%
+#% analytically determine the proportions of water masses in a given sample,
+#% as a combination of three component water masses. T and S can be a vector % of observations.
+#% m1 represents the fraction of the sample that corresponds to Scotian Shelf Water (SSW), m2 the fraction corresponding
+#% to Warm Slope Water (WSW) and m3 the fraction corresponding to Labrador
+#% Slope Water (LSlW).
+#%
+#% Here we use Cramer's rule to solve the following system of equations:
+#% T1*m1 + T2*m2 + T3*m3 = T
+#% S1*m1 + S2*m2 + S3*m3 = S
+#% m1 + m2 + m3 = 1
+#%
+#% p.fratantoni, 6/2011
+#%
+
+#T1=2;S1=32; % SSW
+#T2=10;S2=35; % wSLW
+#T3=6;S3=34.7; % cLSW
+
+delta <- T1 * (S2 - S3) - S1 * (T2 - T3) + T2 * S3 - T3 * S2
+
+m1 <- (T. * (S2 - S3) + S. * (T3 - T2) + T2 * S3 - T3 * S2)
+. / delta
+m2 <- (T. * (S3 - S1) + S. * (T1 - T3) + T3 * S1 - T1 * S3)
+. / delta
+m3 <- (T. * (S1 - S2) + S. * (T2 - T1) + T1 * S2 - T2 * S1)
+. / delta
+#```
diff --git a/R/stored_scripts/species_density_analysis.R b/R/stored_scripts/species_density_analysis.R
index 9b10fc5b..30155f3c 100644
--- a/R/stored_scripts/species_density_analysis.R
+++ b/R/stored_scripts/species_density_analysis.R
@@ -22,10 +22,10 @@ rminyr <- 2015
rmaxyr <- 2019
# tlevel is density of color for KD contours areas
-tlevel=75 # move later
-color_b="blue"
-color_r="orange3"
-color_r="tomato3"
+tlevel <- 75 # move later
+color_b <- "blue"
+color_r <- "orange3"
+color_r <- "tomato3"
# Code to read in strata and compute areas. Or read from cache.
@@ -49,308 +49,663 @@ load(file.path(data.dir, "Survdat.RData"))
# MUST run addTrans function
# color transparency
-addTrans <- function(color,trans){
+addTrans <- function(color, trans) {
# This function adds transparancy to a color.
# Define transparancy with an integer between 0 and 255
# 0 being fully transparant and 255 being fully visable
# Works with either color and trans a vector of equal length,
# or one of the two of length 1.
-
- if (length(color)!=length(trans)&!any(c(length(color),
- length(trans))==1))
+
+ if (
+ length(color) != length(trans) & !any(c(length(color), length(trans)) == 1)
+ ) {
stop("Vector lengths not correct")
- if (length(color)==1 & length(trans)>1) color <- rep(color,length(trans))
- if (length(trans)==1 & length(color)>1) trans <- rep(trans,length(color))
-
- num2hex <- function(x)
- {
- hex <- unlist(strsplit("0123456789ABCDEF",split=""))
- return(paste(hex[(x-x%%16)/16+1],hex[x%%16+1],sep=""))
}
- rgb <- rbind(col2rgb(color),trans)
- res <- paste("#",apply(apply(rgb,2,num2hex),2,paste,collapse=""),sep="")
+ if (length(color) == 1 & length(trans) > 1) {
+ color <- rep(color, length(trans))
+ }
+ if (length(trans) == 1 & length(color) > 1) {
+ trans <- rep(trans, length(color))
+ }
+
+ num2hex <- function(x) {
+ hex <- unlist(strsplit("0123456789ABCDEF", split = ""))
+ return(paste(hex[(x - x %% 16) / 16 + 1], hex[x %% 16 + 1], sep = ""))
+ }
+ rgb <- rbind(col2rgb(color), trans)
+ res <- paste(
+ "#",
+ apply(apply(rgb, 2, num2hex), 2, paste, collapse = ""),
+ sep = ""
+ )
return(res)
}
-plot_kd <- function(species, season, exclude_years){
-
+plot_kd <- function(species, season, exclude_years) {
# stata to use
# offshore strata to use
- CoreOffshoreStrata <- c(seq(1010,1300,10),1340, seq(1360,1400,10),seq(1610,1760,10))
-
+ CoreOffshoreStrata <- c(
+ seq(1010, 1300, 10),
+ 1340,
+ seq(1360, 1400, 10),
+ seq(1610, 1760, 10)
+ )
+
# inshore strata to use, still sampled by Bigelow
- CoreInshore73to12 <- c(3020, 3050, 3080 ,3110 ,3140 ,3170, 3200, 3230,
- 3260, 3290, 3320, 3350 ,3380, 3410 ,3440)
+ CoreInshore73to12 <- c(
+ 3020,
+ 3050,
+ 3080,
+ 3110,
+ 3140,
+ 3170,
+ 3200,
+ 3230,
+ 3260,
+ 3290,
+ 3320,
+ 3350,
+ 3380,
+ 3410,
+ 3440
+ )
# combine
- strata_used <- c(CoreOffshoreStrata,CoreInshore73to12)
-
+ strata_used <- c(CoreOffshoreStrata, CoreInshore73to12)
+
survdat <- survdat %>%
- dplyr::select(c(CRUISE6,STATION,STRATUM,SVSPP,YEAR,
- SEASON,LAT,LON,ABUNDANCE,BIOMASS)) %>%
- filter(SEASON == season,
- STRATUM %in% strata_used) %>% # delete record form non-core
+ dplyr::select(c(
+ CRUISE6,
+ STATION,
+ STRATUM,
+ SVSPP,
+ YEAR,
+ SEASON,
+ LAT,
+ LON,
+ ABUNDANCE,
+ BIOMASS
+ )) %>%
+ filter(SEASON == season, STRATUM %in% strata_used) %>% # delete record form non-core
#strata and get unique records,
# should be one per species
- distinct() %>%
+ distinct() %>%
# add field with rounded BIOMASS scaler used to adjust distributions
- mutate(LOGBIO = round(log10(BIOMASS * 10+10)))
-
+ mutate(LOGBIO = round(log10(BIOMASS * 10 + 10)))
+
# trim the data....to prepare to find stations only
- survdat_stations <- survdat %>%
- dplyr::select(CRUISE6, STATION, STRATUM, YEAR) %>%
+ survdat_stations <- survdat %>%
+ dplyr::select(CRUISE6, STATION, STRATUM, YEAR) %>%
distinct()
-
+
# make table of strata by year
- numtowsstratyr <- table(survdat_stations$STRATUM,survdat_stations$YEAR)
-
+ numtowsstratyr <- table(survdat_stations$STRATUM, survdat_stations$YEAR)
+
# find records to keep based on core strata
rectokeep <- stratareas$STRATA %in% strata_used
-
+
# add rec to keep to survdat
- stratareas <- cbind(stratareas,rectokeep)
-
+ stratareas <- cbind(stratareas, rectokeep)
+
# delete record form non-core strata
- stratareas_usedonly <- stratareas[!stratareas$rectokeep=="FALSE",]
-
- areapertow=numtowsstratyr
-
+ stratareas_usedonly <- stratareas[!stratareas$rectokeep == "FALSE", ]
+
+ areapertow <- numtowsstratyr
+
#compute area covered per tow per strata per year
- for(i in 1:50){
- areapertow[,i]=stratareas_usedonly$AREA/numtowsstratyr[,i]
+ for (i in 1:50) {
+ areapertow[, i] <- stratareas_usedonly$AREA / numtowsstratyr[, i]
}
-
+
# change inf to NA and round and out in DF
- areapertow[][is.infinite(areapertow[])]=NA
- areapertow=round(areapertow)
- areapertow=data.frame(areapertow)
- colnames(areapertow) <- c("STRATUM","YEAR","AREAWT")
+ areapertow[][is.infinite(areapertow[])] <- NA
+ areapertow <- round(areapertow)
+ areapertow <- data.frame(areapertow)
+ colnames(areapertow) <- c("STRATUM", "YEAR", "AREAWT")
areapertow$STRATUM <- as.numeric(as.character(areapertow$STRATUM))
areapertow$YEAR <- as.numeric(as.character(areapertow$YEAR))
-
- survdat <- survdat %>%
- inner_join(.,areapertow, by= c("STRATUM","YEAR")) %>%
+
+ survdat <- survdat %>%
+ inner_join(., areapertow, by = c("STRATUM", "YEAR")) %>%
dplyr::rename(AREAPERTOW = AREAWT)
-
+
# add col to survdat for PLOTWT
survdat$PLOTWT <- NA
- survdat$PLOTWT <- ceiling(survdat$AREAPERTOW/1000*survdat$LOGBIO/9)
-
- if (!is.null(exclude_years)){
+ survdat$PLOTWT <- ceiling(survdat$AREAPERTOW / 1000 * survdat$LOGBIO / 9)
+
+ if (!is.null(exclude_years)) {
sdat <- survdat %>% filter(!YEAR %in% exclude_years)
} else {
sdat <- survdat
}
-
+
# read species list
- sps <- ecodata::species_groupings %>% filter(!is.na(SVSPP)) %>%
+ sps <- ecodata::species_groupings %>%
+ filter(!is.na(SVSPP)) %>%
dplyr::select(COMNAME, SVSPP)
- sps <- sps[!duplicated(sps),]
+ sps <- sps[!duplicated(sps), ]
numsps <- nrow(sps)
-
+
# graph par
- par(mar = c(0,0,0,0))
- par(oma = c(0,0,0,0))
-
+ par(mar = c(0, 0, 0, 0))
+ par(oma = c(0, 0, 0, 0))
+
# index 1:numsps, or by species record number for one species, i.e.25:25
tspe <- sps %>% filter(COMNAME == species)
-
+
# start map
- map("worldHires", xlim=c(-77,-65),ylim=c(35,45), fill=T,border=0,col="gray")
+ map(
+ "worldHires",
+ xlim = c(-77, -65),
+ ylim = c(35, 45),
+ fill = T,
+ border = 0,
+ col = "gray"
+ )
map.axes()
-
- plot(nesbath,deep=-200, shallow=-200, step=1,add=T,lwd=1,col="gray50",lty=2)
-
-
+
+ plot(
+ nesbath,
+ deep = -200,
+ shallow = -200,
+ step = 1,
+ add = T,
+ lwd = 1,
+ col = "gray50",
+ lty = 2
+ )
+
# for base period, 1970 to 1979, find call lons for species and by biomass weighting
- minyr=1969;maxyr=1980
- clons1 =
- sdat$LON[(sdat$YEAR>minyr & sdat$YEARminyr & sdat$YEARminyr & sdat$YEARminyr & sdat$YEARminyr & sdat$YEAR minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 1)
+ ]
+ clons2 <-
+ sdat$LON[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 2)
+ ]
+ clons3 <-
+ sdat$LON[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 3)
+ ]
+ clons4 <-
+ sdat$LON[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 4)
+ ]
+ clons5 <-
+ sdat$LON[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 4)
+ ]
+
# get rid of missings, KS does not like
clons1 <- na.omit(clons1)
clons2 <- na.omit(clons2)
clons3 <- na.omit(clons3)
clons4 <- na.omit(clons4)
clons5 <- na.omit(clons5)
-
- # accumulate all lons, repeating for weighting
- clons=c(clons1,clons2,clons2,clons3,clons3,clons3,clons4,clons4,clons4,clons4,
- clons5,clons5,clons5,clons5,clons5)
-
+
+ # accumulate all lons, repeating for weighting
+ clons <- c(
+ clons1,
+ clons2,
+ clons2,
+ clons3,
+ clons3,
+ clons3,
+ clons4,
+ clons4,
+ clons4,
+ clons4,
+ clons5,
+ clons5,
+ clons5,
+ clons5,
+ clons5
+ )
+
# same for lats
- clats1 =
- sdat$LAT[(sdat$YEAR>minyr & sdat$YEARminyr & sdat$YEARminyr & sdat$YEARminyr & sdat$YEARminyr & sdat$YEAR minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 1)
+ ]
+ clats2 <-
+ sdat$LAT[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 2)
+ ]
+ clats3 <-
+ sdat$LAT[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 3)
+ ]
+ clats4 <-
+ sdat$LAT[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 4)
+ ]
+ clats5 <-
+ sdat$LAT[
+ (sdat$YEAR > minyr &
+ sdat$YEAR < maxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 5)
+ ]
clats1 <- na.omit(clats1)
clats2 <- na.omit(clats2)
clats3 <- na.omit(clats3)
clats4 <- na.omit(clats4)
clats5 <- na.omit(clats5)
- clats=c(clats1,clats2,clats2,clats3,clats3,clats3,clats4,clats4,clats4,clats4,
- clats5,clats5,clats5,clats5,clats5)
-
+ clats <- c(
+ clats1,
+ clats2,
+ clats2,
+ clats3,
+ clats3,
+ clats3,
+ clats4,
+ clats4,
+ clats4,
+ clats4,
+ clats5,
+ clats5,
+ clats5,
+ clats5,
+ clats5
+ )
+
# combine lons and lats
- x=cbind(clons,clats)
+ x <- cbind(clons, clats)
# compute KD using KS routine
- Hscv1 <- Hscv.diag(x=x)
+ Hscv1 <- Hscv.diag(x = x)
#fhat.pi1 <- kde(x=x, H=Hscv1)
-
- fhat.pi1 <- kde(x, compute.cont=T, binned=F,
- xmin=c(-77, 35), xmax=c(-65, 45))
+
+ fhat.pi1 <- kde(
+ x,
+ compute.cont = T,
+ binned = F,
+ xmin = c(-77, 35),
+ xmax = c(-65, 45)
+ )
# specify grid to match raster stack of OISST... etc.
-
+
# add to plot each probability separately
- contour.25 <- with(fhat.pi1,
- contourLines(x=eval.points[[1]],y=eval.points[[2]],
- z=estimate,levels=cont["25%"]))
- contour.50 <- with(fhat.pi1,
- contourLines(x=eval.points[[1]],y=eval.points[[2]],
- z=estimate,levels=cont["50%"]))
- contour.75 <- with(fhat.pi1,
- contourLines(x=eval.points[[1]],y=eval.points[[2]],
- z=estimate,levels=cont["75%"]))
-
- for (j in 1:length(contour.75)){
- polygon(unlist(contour.75[[j]][2]), unlist(contour.75[[j]][3]),
- col=addTrans(color_b,tlevel), border=F)
+ contour.25 <- with(
+ fhat.pi1,
+ contourLines(
+ x = eval.points[[1]],
+ y = eval.points[[2]],
+ z = estimate,
+ levels = cont["25%"]
+ )
+ )
+ contour.50 <- with(
+ fhat.pi1,
+ contourLines(
+ x = eval.points[[1]],
+ y = eval.points[[2]],
+ z = estimate,
+ levels = cont["50%"]
+ )
+ )
+ contour.75 <- with(
+ fhat.pi1,
+ contourLines(
+ x = eval.points[[1]],
+ y = eval.points[[2]],
+ z = estimate,
+ levels = cont["75%"]
+ )
+ )
+
+ for (j in 1:length(contour.75)) {
+ polygon(
+ unlist(contour.75[[j]][2]),
+ unlist(contour.75[[j]][3]),
+ col = addTrans(color_b, tlevel),
+ border = F
+ )
}
- for (j in 1:length(contour.50)){
- polygon(unlist(contour.50[[j]][2]), unlist(contour.50[[j]][3]),
- col=addTrans(color_b,tlevel), border=F)
+ for (j in 1:length(contour.50)) {
+ polygon(
+ unlist(contour.50[[j]][2]),
+ unlist(contour.50[[j]][3]),
+ col = addTrans(color_b, tlevel),
+ border = F
+ )
}
- for (j in 1:length(contour.25)){
- polygon(unlist(contour.25[[j]][2]), unlist(contour.25[[j]][3]),
- col=addTrans(color_b,tlevel), border=F)
+ for (j in 1:length(contour.25)) {
+ polygon(
+ unlist(contour.25[[j]][2]),
+ unlist(contour.25[[j]][3]),
+ col = addTrans(color_b, tlevel),
+ border = F
+ )
}
-
- clons1 =
- sdat$LON[(sdat$YEAR>rminyr & sdat$YEARrminyr & sdat$YEARrminyr & sdat$YEARrminyr & sdat$YEARrminyr & sdat$YEAR rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 1)
+ ]
+ clons2 <-
+ sdat$LON[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 2)
+ ]
+ clons3 <-
+ sdat$LON[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 3)
+ ]
+ clons4 <-
+ sdat$LON[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 4)
+ ]
+ clons5 <-
+ sdat$LON[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 4)
+ ]
# get rid of missings, KS does not like
clons1 <- na.omit(clons1)
clons2 <- na.omit(clons2)
clons3 <- na.omit(clons3)
clons4 <- na.omit(clons4)
clons5 <- na.omit(clons5)
- # accumulate all lons, repeating for weighting
- clons=c(clons1,clons2,clons2,clons3,clons3,clons3,clons4,clons4,clons4,clons4,
- clons5,clons5,clons5,clons5,clons5)
-
+ # accumulate all lons, repeating for weighting
+ clons <- c(
+ clons1,
+ clons2,
+ clons2,
+ clons3,
+ clons3,
+ clons3,
+ clons4,
+ clons4,
+ clons4,
+ clons4,
+ clons5,
+ clons5,
+ clons5,
+ clons5,
+ clons5
+ )
+
# same for lats
- clats1 =
- sdat$LAT[(sdat$YEAR>rminyr & sdat$YEARrminyr & sdat$YEARrminyr & sdat$YEARrminyr & sdat$YEARrminyr & sdat$YEAR rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 1)
+ ]
+ clats2 <-
+ sdat$LAT[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 2)
+ ]
+ clats3 <-
+ sdat$LAT[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 3)
+ ]
+ clats4 <-
+ sdat$LAT[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 4)
+ ]
+ clats5 <-
+ sdat$LAT[
+ (sdat$YEAR > rminyr &
+ sdat$YEAR < rmaxyr &
+ sdat$SVSPP == tspe$SVSPP &
+ sdat$PLOTWT == 5)
+ ]
clats1 <- na.omit(clats1)
clats2 <- na.omit(clats2)
clats3 <- na.omit(clats3)
clats4 <- na.omit(clats4)
clats5 <- na.omit(clats5)
- clats=c(clats1,clats2,clats2,clats3,clats3,clats3,clats4,clats4,clats4,clats4,
- clats5,clats5,clats5,clats5,clats5)
-
- x=cbind(clons,clats)
- Hscv2 <- Hscv.diag(x=x)
-
-
+ clats <- c(
+ clats1,
+ clats2,
+ clats2,
+ clats3,
+ clats3,
+ clats3,
+ clats4,
+ clats4,
+ clats4,
+ clats4,
+ clats5,
+ clats5,
+ clats5,
+ clats5,
+ clats5
+ )
+
+ x <- cbind(clons, clats)
+ Hscv2 <- Hscv.diag(x = x)
+
#fhat.pi2 <- kde(x=x, H=Hscv2)
- fhat.pi2 <- kde(x, compute.cont=T,
- binned=F, xmin=c(-77, 35), xmax=c(-65, 45))
+ fhat.pi2 <- kde(
+ x,
+ compute.cont = T,
+ binned = F,
+ xmin = c(-77, 35),
+ xmax = c(-65, 45)
+ )
# specify grid to match raster stack of OISST... etc.
-
+
# add to plot each probability separately
contour.25 <-
- with(fhat.pi2, contourLines(x=eval.points[[1]],y=eval.points[[2]],
- z=estimate,levels=cont["25%"]))
- contour.50 <-
- with(fhat.pi2,contourLines(x=eval.points[[1]],y=eval.points[[2]],
- z=estimate,levels=cont["50%"]))
+ with(
+ fhat.pi2,
+ contourLines(
+ x = eval.points[[1]],
+ y = eval.points[[2]],
+ z = estimate,
+ levels = cont["25%"]
+ )
+ )
+ contour.50 <-
+ with(
+ fhat.pi2,
+ contourLines(
+ x = eval.points[[1]],
+ y = eval.points[[2]],
+ z = estimate,
+ levels = cont["50%"]
+ )
+ )
contour.75 <-
- with(fhat.pi2, contourLines(x=eval.points[[1]],y=eval.points[[2]],
- z=estimate,levels=cont["75%"]))
-
- for (j in 1:length(contour.75)){
- polygon(unlist(contour.75[[j]][2]), unlist(contour.75[[j]][3]),
- col=addTrans(color_r,tlevel), border=F)
+ with(
+ fhat.pi2,
+ contourLines(
+ x = eval.points[[1]],
+ y = eval.points[[2]],
+ z = estimate,
+ levels = cont["75%"]
+ )
+ )
+
+ for (j in 1:length(contour.75)) {
+ polygon(
+ unlist(contour.75[[j]][2]),
+ unlist(contour.75[[j]][3]),
+ col = addTrans(color_r, tlevel),
+ border = F
+ )
}
- for (j in 1:length(contour.50)){
- polygon(unlist(contour.50[[j]][2]), unlist(contour.50[[j]][3]),
- col=addTrans(color_r,tlevel), border=F)
+ for (j in 1:length(contour.50)) {
+ polygon(
+ unlist(contour.50[[j]][2]),
+ unlist(contour.50[[j]][3]),
+ col = addTrans(color_r, tlevel),
+ border = F
+ )
}
- for (j in 1:length(contour.25)){
- polygon(unlist(contour.25[[j]][2]), unlist(contour.25[[j]][3])
- ,col=addTrans(color_r,tlevel), border=F)
+ for (j in 1:length(contour.25)) {
+ polygon(
+ unlist(contour.25[[j]][2]),
+ unlist(contour.25[[j]][3]),
+ col = addTrans(color_r, tlevel),
+ border = F
+ )
}
-
-
- text(-70,37.5, pos=4,labels = species)
- segments(-69.5, 37,-68.5, 37,lwd=1,col="gray50",lty=2)
- text(-68.5,37, pos=4,labels = "200m")
-
- stline=36.5
- text(-70.4,stline, pos=4,labels = "25% 50% 75%")
- incline=-.3
- segments(-70, stline+incline,-69,
- stline+incline ,lwd=20,col=addTrans(color_b,tlevel))
- segments(-70, stline+incline,-68,
- stline+incline ,lwd=20,col=addTrans(color_b,tlevel))
- segments(-70, stline+incline,-67,
- stline+incline ,lwd=20,col=addTrans(color_b,tlevel))
- text(-66.8,stline+incline, pos=4,labels = "Base")
-
- incline=-.7
- segments(-70, stline+incline,-69,
- stline+incline ,lwd=20,col=addTrans(color_r,tlevel))
- segments(-70, stline+incline,-68,
- stline+incline ,lwd=20,col=addTrans(color_r,tlevel))
- segments(-70, stline+incline,-67,
- stline+incline ,lwd=20,col=addTrans(color_r,tlevel))
- text(-66.8,stline+incline, pos=4,labels = "Recent")
-
- incline=-1.1
- segments(-70, stline+incline,-69,
- stline+incline ,lwd=20,col=addTrans(color_b,tlevel))
- segments(-70, stline+incline,-68,
- stline+incline ,lwd=20,col=addTrans(color_b,tlevel))
- segments(-70, stline+incline,-67,
- stline+incline ,lwd=20,col=addTrans(color_b,tlevel))
- segments(-70, stline+incline,-69,
- stline+incline ,lwd=20,col=addTrans(color_r,tlevel))
- segments(-70, stline+incline,-68,
- stline+incline ,lwd=20,col=addTrans(color_r,tlevel))
- segments(-70, stline+incline,-67,
- stline+incline ,lwd=20,col=addTrans(color_r,tlevel))
- text(-66.8,stline+incline, pos=4,labels = "Overlap")
-
-}
-
-
-#```
\ No newline at end of file
+
+ text(-70, 37.5, pos = 4, labels = species)
+ segments(-69.5, 37, -68.5, 37, lwd = 1, col = "gray50", lty = 2)
+ text(-68.5, 37, pos = 4, labels = "200m")
+
+ stline <- 36.5
+ text(-70.4, stline, pos = 4, labels = "25% 50% 75%")
+ incline <- -.3
+ segments(
+ -70,
+ stline + incline,
+ -69,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_b, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -68,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_b, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -67,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_b, tlevel)
+ )
+ text(-66.8, stline + incline, pos = 4, labels = "Base")
+
+ incline <- -.7
+ segments(
+ -70,
+ stline + incline,
+ -69,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_r, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -68,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_r, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -67,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_r, tlevel)
+ )
+ text(-66.8, stline + incline, pos = 4, labels = "Recent")
+
+ incline <- -1.1
+ segments(
+ -70,
+ stline + incline,
+ -69,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_b, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -68,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_b, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -67,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_b, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -69,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_r, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -68,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_r, tlevel)
+ )
+ segments(
+ -70,
+ stline + incline,
+ -67,
+ stline + incline,
+ lwd = 20,
+ col = addTrans(color_r, tlevel)
+ )
+ text(-66.8, stline + incline, pos = 4, labels = "Overlap")
+}
+
+#```
diff --git a/R/stored_scripts/species_distribution_analysis.R b/R/stored_scripts/species_distribution_analysis.R
index e868831d..8d5b3986 100644
--- a/R/stored_scripts/species_distribution_analysis.R
+++ b/R/stored_scripts/species_distribution_analysis.R
@@ -1,405 +1,427 @@
-### species distribution analysis
-
-#```{r, echo = T, eval = F}
-
-library(raster)
-library(ncdf4)
-library(stats)
-library(geosphere)
-library(plyr)
-
-# set wd C:\1_analyses_ne_shelf\along shelf pos
-#setwd(choose.dir(default=getwd()))
-setwd("C:/1_analyses_ne_shelf/along shelf pos")
-wd=getwd()
-
-
-# name of survey data file select season <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-surfilename="Survdat_8_2017.Rdata"
-
-# select season SPRING <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-selseaon="SPRING"
-outfile="dhdc_8_2017_fallASS_sprDATA.csv"
-outfile="dhdc_8_2017_fallASS_sprDATA jc.csv"
-outfile="dhdc_8_2017_fallASS_sprDATA joe.csv"
-outfile="dhdc_8_2017_fallASS_sprDATA all.csv"
-
-# select season FALL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-selseaon="FALL"
-#outfile="dhdc_1_2017_sprASS_fallDATA.csv"
-outfile="dhdc_1_2017_sprASS_fallDATA jc.csv"
-outfile="dhdc_1_2017_sprASS_fallDATA joe.csv"
-outfile="dhdc_1_2017_sprASS_fallDATA all.csv"
-
-
-# read species list sps.csv
-#sps=read.csv(file.choose(), header = TRUE)
-sps=read.csv(file="sps.csv", header = TRUE)
-sps=read.csv(file="sps 312.csv", header = TRUE)
-sps=read.csv(file="sps_joe.csv", header = TRUE)
-sps=read.csv(file="sps_spring.csv", header = TRUE)
-sps=read.csv(file="sps_fall.csv", header = TRUE)
-numsps=nrow(sps)
-
-
-# select species to analyze <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-spptokeep=sps$SVSPP
-#spptokeep=c(73,74,75,76,77)
-#spptokeep=c(312) #Jonah Crab 312
-
-
-# read in depth grid
-gdepth=raster("nes_bath_data.nc", band=1)
-
-# read in coordinates for along shelf diagnal diag.csv
-#diag=read.csv(file.choose(), header = TRUE)
-diag=read.csv(file="diag.csv", header = TRUE)
-
-# read in coordinate for coast nes_coastline.csv
-#nescoast=read.csv(file.choose(), header = TRUE)
-nescoast=read.csv(file="nes_coastline.csv", header = TRUE)
-
-# read in coordinate for coast nes_coast_2.csv
-#nescoast2=read.csv(file.choose(), header = TRUE)
-nescoast2=read.csv(file="nes_coast_2.csv", header = TRUE)
-
-# read in coordinate for coast V2 hersey_high_2.csv
-#nesc2=read.csv(file.choose(), header = TRUE)
-nesc2=read.csv(file="hersey_high_2.csv", header = TRUE)
-
-# constants
-radt=pi/180
-R <- 6371 # Earth mean radius [km]
-
-
-
-
-# CODE TO READ IN STRATA COMPUTE AREAS, NOW JUST READ IN STRATAREAS dataframe
-# readin in strata.shp and compute areas of strata
-#TrawlStrata<-shapefile(file.choose())
-#plot(TrawlStrata)
-#AREA<-areaPolygon(TrawlStrata, r=6371000)/10^6
-
-# for array of strata and area and make into dataframe
-#stratareas=cbind(TrawlStrata@data$STRATA, AREA)
-#colnames(stratareas) <- c("STRATA","AREA")
-#stratareas=data.frame(stratareas)
-#save(stratareas, file="stratareas.rdata")
-
-# load stratareas
-load("stratareas.rdata")
-
-
-# get durvey datafile Survdat.RData
-#load(file.choose())
-#load(file="Survdat.RData")
-load(file=surfilename)
-
-# trin the data.... need to choose season
-retvars <- c("CRUISE6","STATION","STRATUM","SVSPP","YEAR","SEASON",
- "LAT","LON","DEPTH","ABUNDANCE","BIOMASS")
-survdat <- survdat[retvars]
-survdat <- survdat[(survdat$SEASON==selseaon),]
-
-# stata to use
-# offshore strata to use
-CoreOffshoreStrata<-c(seq(1010,1300,10),1340, seq(1360,1400,10),seq(1610,1760,10))
-# inshore strata to use, still sampled by Bigelow
-CoreInshore73to12=c(3020, 3050, 3080 ,3110 ,3140 ,3170, 3200,
- 3230, 3260, 3290, 3320, 3350 ,3380, 3410 ,3440)
-# combine
-strata_used=c(CoreOffshoreStrata,CoreInshore73to12)
-
-# find records to keep based on core strata
-rectokeep=survdat$STRATUM %in% strata_used
-
-#table(rectokeep)
-# add rec to keep to survdat
-survdat=cbind(survdat,rectokeep)
-
-# delete record form non-core strata
-survdat=survdat[!survdat$rectokeep=="FALSE",]
-
-# get rid of species
-survdat$rectokeep=survdat$SVSPP %in% spptokeep
-survdat=survdat[!survdat$rectokeep=="FALSE",]
-
-
-# find unique tow records only, since length and weight removed
-# unique deletes to one record per species
-survdat <- unique(survdat)
-
-# add field with rounded BIOMASS scaler used to adjust distributions
-survdat$LOGBIO <- round(log10(survdat$BIOMASS * 10+10))
-# take a look go from 1 to 5?
-table(survdat$LOGBIO)
-
-# trim the data.... to prepare to find stations only
-retvars <- c("CRUISE6","STATION","STRATUM","YEAR")
-survdat_stations <- survdat[retvars]
-# unique reduces to a record per tow
-survdat_stations <- unique(survdat_stations)
-
-
-# make table of strata by year
-numtowsstratyr=table(survdat_stations$STRATUM,survdat_stations$YEAR)
-
-# find records to keep based on core strata
-rectokeep=stratareas$STRATA %in% strata_used
-
-# add rec to keep to survdat
-stratareas=cbind(stratareas,rectokeep)
-
-# delete record form non-core strata
-stratareas_usedonly=stratareas[!stratareas$rectokeep=="FALSE",]
-
-# creat areapertow
-areapertow=numtowsstratyr
-
-#compute area covered per tow per strata per year
-for(i in 1:47){
- areapertow[,i]=stratareas_usedonly$AREA/numtowsstratyr[,i]
-}
-
-# change inf to NA and round and out in DF
-areapertow[][is.infinite(areapertow[])]=NA
-areapertow=round(areapertow)
-areapertow=data.frame(areapertow)
-colnames(areapertow) <- c("STRATA","YEAR","AREAWT")
-
-# add col to survdat for strata weight
-survdat$AREAPERTOW=NA
-
-#fill AREAPERTOW
-dimsurvdat=dim(survdat)
-for (i in 1:dimsurvdat[1]){
- survdat$AREAPERTOW[i]=
- areapertow$AREAWT[which(survdat$STRATUM[i]==
- areapertow$STRATA &
- survdat$YEAR[i]==
- areapertow$YEAR)]
-}
-
-table(ceiling(survdat$AREAPERTOW/1000))
-table(survdat$LOGBIO)
-table(ceiling(survdat$AREAPERTOW/1000*survdat$LOGBIO/9))
-
-# add col to survdat for PLOTWT
-survdat$PLOTWT=NA
-survdat$PLOTWT= ceiling(survdat$AREAPERTOW/1000*survdat$LOGBIO/9)
-
-table(survdat$PLOTWT)
-
-# Plot stations
-plot(survdat$LON[survdat$YEAR==1974],survdat$LAT[survdat$YEAR==1974])
-
-
-# put in shorter name
-sdat=survdat
-
-# clear some space
-remove(survdat)
-
-# number of records to evaluate
-numrecs=nrow(sdat)
-
-
-#======================================================================================
-
-# TAKEN OUT SINCE THE SAME AS GASDIST
-
-#blank array for ASDIST
-#d = array(data = NA, dim = nrow(diag))
-
-# block to calculate diag distance ASDIST
-#for (j in 1:numrecs) {
-# print(numrecs-j)
-#
-# lat1=sdat$LAT[j]* radt
-# long1=sdat$LON[j]* radt
-# for (i in 1:150){
-# lat2=diag$LAT[i]* radt
-# long2=diag$LON[i]* radt
-# d[i] <- acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
-# }
-# dindex=which(d==min(d))
-##
-# lat1=34.60* radt
-# long1=-76.53* radt
-#
-# lat2=diag$LAT[dindex]* radt
-# long2=diag$LON[dindex]* radt
-# sdat$ASDIST[j] = acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
-#}
-
-
-#======================================================================================
-
-# TAKEN OUT SINCE THE SAME AS GDTOC
-
-#blank array for DTOC
-#d = array(data = NA, dim = nrow(nescoast))
-
-# block to calculate diag distance DTOC
-#for (j in 1:numrecs) {
-## print(numrecs-j)
-
-# lat1=sdat$LAT[j]* radt
-# long1=sdat$LON[j]* radt
-# for (i in 1:nrow(nescoast)){
-# lat2=nescoast$LAT[i]* radt
-# long2=nescoast$LON[i]* radt
-# d[i] <- acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
-# }
-# sdat$DTOC[j] = d[which(d==min(d))]
-
-#}
-
-
-
-#======================================================================================
-print("distance to coast using geosphere")
-
-#### Geosphere package to calc distance to coastline from pts (lon,lat), returns meters
-dd = array(data = NA, dim = nrow(sdat))
-pts = data.frame(sdat$LON, sdat$LAT)
-#line = t(rbind(nescoast$Longitude, nescoast$Latitude))
-#line = t(rbind(nesc2$LON, nesc2$LAT))
-line_nescoast2 = t(rbind(nescoast2$LON, nescoast2$LAT))
-
-#dd=dist2Line(pts[,], line)
-dd=dist2Line(pts[,], line_nescoast2)
-sdat$GDTOC=dd/1000 # convert meters to KM
-
-# TESTING (look at sdat to compare dtc (geosphere) to DTOC (from loop))
-# plot(line)
-# lines(diag)
-# lines(line)
-# points(nescoast)
-#ddtest=data.frame(dd)
-#ddtest$distance=NULL
-#plot(nescoast2)
-#lines(nescoast2)
-#ptt=105
-#points(sdat$LON[ptt], sdat$LAT[ptt], col="red"); sdat$DTOC[ptt];
-#sdat$dtc[ptt]; points(ddtest[ptt,], col="green")
-
-#======================================================================================
-
-print("diag distance using geosphere")
-# Find distance to diagonal line (diag), use coordinates of
-# nearest point to find distance to NC outerbanks (min(diag))
-dd2 = array(data = NA, dim = nrow(sdat))
-dd2 = dist2Line(pts[,], diag, distfun=distHaversine)
-#Distance of closest point to data along diag line to NC coast
-p1 = diag[1,] #start of line
-p3 = diag[150,] #end of line
-p2 = data.frame(dd2[,2], dd2[,3])
-distNC = distCosine(p1, p2, r=6378137) /1000 # convert to KM (Great circle distance)
-sdat$GASDIST = distNC
-
-
-#======================================================================================
-
-
-# create column for missing depth data intially with depth data
-sdat$MISDEPTH=sdat$DEPTH
-
-# find cases with missing depth data
-missingdepth=which(is.na(sdat$DEPTH))
-
-# fill only those records in misdepth with depth from grid
-for(k in missingdepth){
- sdat$MISDEPTH[k] = extract(gdepth,cbind(sdat$LON[k],sdat$LAT[k])) * -1
-}
-
-#=========================================================================================
-
-
-
-
-#outline=paste("YR",",","SVSPP",",","mASDIST",",","mDTOC",",",
-#"mMISDEPTH",",","mLAT",",","mLON",",","mGASDIST",",","mGDTOC")
-#write.table(outline,file=outfile,row.name=F,col.names=F,append=TRUE)
-
-
-
-out_data=array(NA,c((max(sdat$YEAR)-min(sdat$YEAR)+1)*numsps,7))
-
-row_c=0
-
-for (i in 1:numsps){
- print (i)
- for(j in min(sdat$YEAR):max(sdat$YEAR)){
-
- row_c=row_c+1
- #sumdist=sum(sdat$ASDIST[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
- #*sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- #lendist=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- #mASDIST =sumdist / lendist
-
- #sumdist=sum(sdat$DTOC[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
- #*sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- #lendist=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- #mDTOC =sumdist / lendist
-
- sumdepth=sum(sdat$MISDEPTH[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
- *sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- lendepth=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- mMISDEPTH =sumdepth / lendepth
-
- sumdepth=sum(sdat$LAT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
- *sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- lendepth=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- mLAT =sumdepth / lendepth
-
- sumdepth=sum(sdat$LON[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
- *sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- lendepth=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- mLON =sumdepth / lendepth
-
-
- sumdepth=sum(sdat$GASDIST[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
- *sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- lendepth=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- mGASDIST =sumdepth / lendepth
-
- sumdepth=sum(sdat$GDTOC[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
- *sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- lendepth=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
- mGDTOC =sumdepth / lendepth
-
-
- out_data[row_c,1]=j
- out_data[row_c,2]=sps$SVSPP[i]
- out_data[row_c,3]=mMISDEPTH
- out_data[row_c,4]=mLAT
- out_data[row_c,5]=mLON
- out_data[row_c,6]=mGASDIST
- out_data[row_c,7]=mGDTOC
-
-
-
- }
-}
-
-
-#outline=paste(j,",",sps$SVSPP[i],",",mMISDEPTH,",",mLAT,",",mLON,",",mGASDIST,",",mGDTOC)
-#write.table(outline,file=outfile,row.name=F,col.names=F,append=TRUE)
-
-out_data=data.frame(out_data)
-
-
-
-names(out_data)[names(out_data)=="X1"] <- "YR"
-names(out_data)[names(out_data)=="X2"] <- "SP"
-names(out_data)[names(out_data)=="X3"] <- "DEPTH"
-names(out_data)[names(out_data)=="X4"] <- "LAT"
-names(out_data)[names(out_data)=="X5"] <- "LON"
-names(out_data)[names(out_data)=="X6"] <- "ASDIST"
-names(out_data)[names(out_data)=="X7"] <- "DTEOC"
-
-
-write.csv(out_data,file=outfile )
-
-#```
\ No newline at end of file
+### species distribution analysis
+
+#```{r, echo = T, eval = F}
+
+library(raster)
+library(ncdf4)
+library(stats)
+library(geosphere)
+library(plyr)
+
+# set wd C:\1_analyses_ne_shelf\along shelf pos
+#setwd(choose.dir(default=getwd()))
+setwd("C:/1_analyses_ne_shelf/along shelf pos")
+wd <- getwd()
+
+
+# name of survey data file select season <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+surfilename <- "Survdat_8_2017.Rdata"
+
+# select season SPRING <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+selseaon <- "SPRING"
+outfile <- "dhdc_8_2017_fallASS_sprDATA.csv"
+outfile <- "dhdc_8_2017_fallASS_sprDATA jc.csv"
+outfile <- "dhdc_8_2017_fallASS_sprDATA joe.csv"
+outfile <- "dhdc_8_2017_fallASS_sprDATA all.csv"
+
+# select season FALL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+selseaon <- "FALL"
+#outfile="dhdc_1_2017_sprASS_fallDATA.csv"
+outfile <- "dhdc_1_2017_sprASS_fallDATA jc.csv"
+outfile <- "dhdc_1_2017_sprASS_fallDATA joe.csv"
+outfile <- "dhdc_1_2017_sprASS_fallDATA all.csv"
+
+
+# read species list sps.csv
+#sps=read.csv(file.choose(), header = TRUE)
+sps <- read.csv(file = "sps.csv", header = TRUE)
+sps <- read.csv(file = "sps 312.csv", header = TRUE)
+sps <- read.csv(file = "sps_joe.csv", header = TRUE)
+sps <- read.csv(file = "sps_spring.csv", header = TRUE)
+sps <- read.csv(file = "sps_fall.csv", header = TRUE)
+numsps <- nrow(sps)
+
+
+# select species to analyze <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+spptokeep <- sps$SVSPP
+#spptokeep=c(73,74,75,76,77)
+#spptokeep=c(312) #Jonah Crab 312
+
+# read in depth grid
+gdepth <- raster("nes_bath_data.nc", band = 1)
+
+# read in coordinates for along shelf diagnal diag.csv
+#diag=read.csv(file.choose(), header = TRUE)
+diag <- read.csv(file = "diag.csv", header = TRUE)
+
+# read in coordinate for coast nes_coastline.csv
+#nescoast=read.csv(file.choose(), header = TRUE)
+nescoast <- read.csv(file = "nes_coastline.csv", header = TRUE)
+
+# read in coordinate for coast nes_coast_2.csv
+#nescoast2=read.csv(file.choose(), header = TRUE)
+nescoast2 <- read.csv(file = "nes_coast_2.csv", header = TRUE)
+
+# read in coordinate for coast V2 hersey_high_2.csv
+#nesc2=read.csv(file.choose(), header = TRUE)
+nesc2 <- read.csv(file = "hersey_high_2.csv", header = TRUE)
+
+# constants
+radt <- pi / 180
+R <- 6371 # Earth mean radius [km]
+
+
+# CODE TO READ IN STRATA COMPUTE AREAS, NOW JUST READ IN STRATAREAS dataframe
+# readin in strata.shp and compute areas of strata
+#TrawlStrata<-shapefile(file.choose())
+#plot(TrawlStrata)
+#AREA<-areaPolygon(TrawlStrata, r=6371000)/10^6
+
+# for array of strata and area and make into dataframe
+#stratareas=cbind(TrawlStrata@data$STRATA, AREA)
+#colnames(stratareas) <- c("STRATA","AREA")
+#stratareas=data.frame(stratareas)
+#save(stratareas, file="stratareas.rdata")
+
+# load stratareas
+load("stratareas.rdata")
+
+
+# get durvey datafile Survdat.RData
+#load(file.choose())
+#load(file="Survdat.RData")
+load(file = surfilename)
+
+# trin the data.... need to choose season
+retvars <- c(
+ "CRUISE6",
+ "STATION",
+ "STRATUM",
+ "SVSPP",
+ "YEAR",
+ "SEASON",
+ "LAT",
+ "LON",
+ "DEPTH",
+ "ABUNDANCE",
+ "BIOMASS"
+)
+survdat <- survdat[retvars]
+survdat <- survdat[(survdat$SEASON == selseaon), ]
+
+# stata to use
+# offshore strata to use
+CoreOffshoreStrata <- c(
+ seq(1010, 1300, 10),
+ 1340,
+ seq(1360, 1400, 10),
+ seq(1610, 1760, 10)
+)
+# inshore strata to use, still sampled by Bigelow
+CoreInshore73to12 <- c(
+ 3020,
+ 3050,
+ 3080,
+ 3110,
+ 3140,
+ 3170,
+ 3200,
+ 3230,
+ 3260,
+ 3290,
+ 3320,
+ 3350,
+ 3380,
+ 3410,
+ 3440
+)
+# combine
+strata_used <- c(CoreOffshoreStrata, CoreInshore73to12)
+
+# find records to keep based on core strata
+rectokeep <- survdat$STRATUM %in% strata_used
+
+#table(rectokeep)
+# add rec to keep to survdat
+survdat <- cbind(survdat, rectokeep)
+
+# delete record form non-core strata
+survdat <- survdat[!survdat$rectokeep == "FALSE", ]
+
+# get rid of species
+survdat$rectokeep <- survdat$SVSPP %in% spptokeep
+survdat <- survdat[!survdat$rectokeep == "FALSE", ]
+
+
+# find unique tow records only, since length and weight removed
+# unique deletes to one record per species
+survdat <- unique(survdat)
+
+# add field with rounded BIOMASS scaler used to adjust distributions
+survdat$LOGBIO <- round(log10(survdat$BIOMASS * 10 + 10))
+# take a look go from 1 to 5?
+table(survdat$LOGBIO)
+
+# trim the data.... to prepare to find stations only
+retvars <- c("CRUISE6", "STATION", "STRATUM", "YEAR")
+survdat_stations <- survdat[retvars]
+# unique reduces to a record per tow
+survdat_stations <- unique(survdat_stations)
+
+
+# make table of strata by year
+numtowsstratyr <- table(survdat_stations$STRATUM, survdat_stations$YEAR)
+
+# find records to keep based on core strata
+rectokeep <- stratareas$STRATA %in% strata_used
+
+# add rec to keep to survdat
+stratareas <- cbind(stratareas, rectokeep)
+
+# delete record form non-core strata
+stratareas_usedonly <- stratareas[!stratareas$rectokeep == "FALSE", ]
+
+# creat areapertow
+areapertow <- numtowsstratyr
+
+#compute area covered per tow per strata per year
+for (i in 1:47) {
+ areapertow[, i] <- stratareas_usedonly$AREA / numtowsstratyr[, i]
+}
+
+# change inf to NA and round and out in DF
+areapertow[][is.infinite(areapertow[])] <- NA
+areapertow <- round(areapertow)
+areapertow <- data.frame(areapertow)
+colnames(areapertow) <- c("STRATA", "YEAR", "AREAWT")
+
+# add col to survdat for strata weight
+survdat$AREAPERTOW <- NA
+
+#fill AREAPERTOW
+dimsurvdat <- dim(survdat)
+for (i in 1:dimsurvdat[1]) {
+ survdat$AREAPERTOW[i] <-
+ areapertow$AREAWT[which(
+ survdat$STRATUM[i] == areapertow$STRATA &
+ survdat$YEAR[i] == areapertow$YEAR
+ )]
+}
+
+table(ceiling(survdat$AREAPERTOW / 1000))
+table(survdat$LOGBIO)
+table(ceiling(survdat$AREAPERTOW / 1000 * survdat$LOGBIO / 9))
+
+# add col to survdat for PLOTWT
+survdat$PLOTWT <- NA
+survdat$PLOTWT <- ceiling(survdat$AREAPERTOW / 1000 * survdat$LOGBIO / 9)
+
+table(survdat$PLOTWT)
+
+# Plot stations
+plot(survdat$LON[survdat$YEAR == 1974], survdat$LAT[survdat$YEAR == 1974])
+
+
+# put in shorter name
+sdat <- survdat
+
+# clear some space
+remove(survdat)
+
+# number of records to evaluate
+numrecs <- nrow(sdat)
+
+
+#======================================================================================
+
+# TAKEN OUT SINCE THE SAME AS GASDIST
+
+#blank array for ASDIST
+#d = array(data = NA, dim = nrow(diag))
+
+# block to calculate diag distance ASDIST
+#for (j in 1:numrecs) {
+# print(numrecs-j)
+#
+# lat1=sdat$LAT[j]* radt
+# long1=sdat$LON[j]* radt
+# for (i in 1:150){
+# lat2=diag$LAT[i]* radt
+# long2=diag$LON[i]* radt
+# d[i] <- acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
+# }
+# dindex=which(d==min(d))
+##
+# lat1=34.60* radt
+# long1=-76.53* radt
+#
+# lat2=diag$LAT[dindex]* radt
+# long2=diag$LON[dindex]* radt
+# sdat$ASDIST[j] = acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
+#}
+
+#======================================================================================
+
+# TAKEN OUT SINCE THE SAME AS GDTOC
+
+#blank array for DTOC
+#d = array(data = NA, dim = nrow(nescoast))
+
+# block to calculate diag distance DTOC
+#for (j in 1:numrecs) {
+## print(numrecs-j)
+
+# lat1=sdat$LAT[j]* radt
+# long1=sdat$LON[j]* radt
+# for (i in 1:nrow(nescoast)){
+# lat2=nescoast$LAT[i]* radt
+# long2=nescoast$LON[i]* radt
+# d[i] <- acos(sin(lat1)*sin(lat2) + cos(lat1)*cos(lat2) * cos(long2-long1)) * R
+# }
+# sdat$DTOC[j] = d[which(d==min(d))]
+
+#}
+
+#======================================================================================
+print("distance to coast using geosphere")
+
+#### Geosphere package to calc distance to coastline from pts (lon,lat), returns meters
+dd <- array(data = NA, dim = nrow(sdat))
+pts <- data.frame(sdat$LON, sdat$LAT)
+#line = t(rbind(nescoast$Longitude, nescoast$Latitude))
+#line = t(rbind(nesc2$LON, nesc2$LAT))
+line_nescoast2 <- t(rbind(nescoast2$LON, nescoast2$LAT))
+
+#dd=dist2Line(pts[,], line)
+dd <- dist2Line(pts[,], line_nescoast2)
+sdat$GDTOC <- dd / 1000 # convert meters to KM
+
+# TESTING (look at sdat to compare dtc (geosphere) to DTOC (from loop))
+# plot(line)
+# lines(diag)
+# lines(line)
+# points(nescoast)
+#ddtest=data.frame(dd)
+#ddtest$distance=NULL
+#plot(nescoast2)
+#lines(nescoast2)
+#ptt=105
+#points(sdat$LON[ptt], sdat$LAT[ptt], col="red"); sdat$DTOC[ptt];
+#sdat$dtc[ptt]; points(ddtest[ptt,], col="green")
+
+#======================================================================================
+
+print("diag distance using geosphere")
+# Find distance to diagonal line (diag), use coordinates of
+# nearest point to find distance to NC outerbanks (min(diag))
+dd2 <- array(data = NA, dim = nrow(sdat))
+dd2 <- dist2Line(pts[,], diag, distfun = distHaversine)
+#Distance of closest point to data along diag line to NC coast
+p1 <- diag[1, ] #start of line
+p3 <- diag[150, ] #end of line
+p2 <- data.frame(dd2[, 2], dd2[, 3])
+distNC <- distCosine(p1, p2, r = 6378137) / 1000 # convert to KM (Great circle distance)
+sdat$GASDIST <- distNC
+
+
+#======================================================================================
+
+# create column for missing depth data intially with depth data
+sdat$MISDEPTH <- sdat$DEPTH
+
+# find cases with missing depth data
+missingdepth <- which(is.na(sdat$DEPTH))
+
+# fill only those records in misdepth with depth from grid
+for (k in missingdepth) {
+ sdat$MISDEPTH[k] <- extract(gdepth, cbind(sdat$LON[k], sdat$LAT[k])) * -1
+}
+
+#=========================================================================================
+
+#outline=paste("YR",",","SVSPP",",","mASDIST",",","mDTOC",",",
+#"mMISDEPTH",",","mLAT",",","mLON",",","mGASDIST",",","mGDTOC")
+#write.table(outline,file=outfile,row.name=F,col.names=F,append=TRUE)
+
+out_data <- array(NA, c((max(sdat$YEAR) - min(sdat$YEAR) + 1) * numsps, 7))
+
+row_c <- 0
+
+for (i in 1:numsps) {
+ print(i)
+ for (j in min(sdat$YEAR):max(sdat$YEAR)) {
+ row_c <- row_c + 1
+ #sumdist=sum(sdat$ASDIST[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
+ #*sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
+ #lendist=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
+ #mASDIST =sumdist / lendist
+
+ #sumdist=sum(sdat$DTOC[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]]
+ #*sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
+ #lendist=sum(sdat$PLOTWT[sdat$YEAR==j & sdat$SVSPP==sps$SVSPP[i]])
+ #mDTOC =sumdist / lendist
+
+ sumdepth <- sum(
+ sdat$MISDEPTH[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]] *
+ sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]]
+ )
+ lendepth <- sum(sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]])
+ mMISDEPTH <- sumdepth / lendepth
+
+ sumdepth <- sum(
+ sdat$LAT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]] *
+ sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]]
+ )
+ lendepth <- sum(sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]])
+ mLAT <- sumdepth / lendepth
+
+ sumdepth <- sum(
+ sdat$LON[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]] *
+ sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]]
+ )
+ lendepth <- sum(sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]])
+ mLON <- sumdepth / lendepth
+
+ sumdepth <- sum(
+ sdat$GASDIST[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]] *
+ sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]]
+ )
+ lendepth <- sum(sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]])
+ mGASDIST <- sumdepth / lendepth
+
+ sumdepth <- sum(
+ sdat$GDTOC[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]] *
+ sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]]
+ )
+ lendepth <- sum(sdat$PLOTWT[sdat$YEAR == j & sdat$SVSPP == sps$SVSPP[i]])
+ mGDTOC <- sumdepth / lendepth
+
+ out_data[row_c, 1] <- j
+ out_data[row_c, 2] <- sps$SVSPP[i]
+ out_data[row_c, 3] <- mMISDEPTH
+ out_data[row_c, 4] <- mLAT
+ out_data[row_c, 5] <- mLON
+ out_data[row_c, 6] <- mGASDIST
+ out_data[row_c, 7] <- mGDTOC
+ }
+}
+
+
+#outline=paste(j,",",sps$SVSPP[i],",",mMISDEPTH,",",mLAT,",",mLON,",",mGASDIST,",",mGDTOC)
+#write.table(outline,file=outfile,row.name=F,col.names=F,append=TRUE)
+
+out_data <- data.frame(out_data)
+
+
+names(out_data)[names(out_data) == "X1"] <- "YR"
+names(out_data)[names(out_data) == "X2"] <- "SP"
+names(out_data)[names(out_data) == "X3"] <- "DEPTH"
+names(out_data)[names(out_data) == "X4"] <- "LAT"
+names(out_data)[names(out_data) == "X5"] <- "LON"
+names(out_data)[names(out_data) == "X6"] <- "ASDIST"
+names(out_data)[names(out_data) == "X7"] <- "DTEOC"
+
+
+write.csv(out_data, file = outfile)
+
+#```
diff --git a/R/stored_scripts/trend_analysis.R b/R/stored_scripts/trend_analysis.R
index 815fed28..e282ed6c 100644
--- a/R/stored_scripts/trend_analysis.R
+++ b/R/stored_scripts/trend_analysis.R
@@ -1,340 +1,423 @@
-#trend analysis
-
-
-
-
-#```{r, echo=T, message=FALSE, warning=FALSE, include=T}
-
-#R packages
-library(dplyr)
-library(nlme)
-library(AICcmodavg)
-library(data.table)
-#```
-
-#```{r, echo = T, message= F, warning=F, include=T}
-
-# data.dir <- "./data"
-# load(file.path(data.dir, "SOE_data_2018.Rdata"))
-
-#--------------------------------GLS Model Selection-----------------------------#
-fit_lm <- function(dat) {
-
- constant_norm <-
- nlme::gls(series ~ 1,
- data = dat)
-
- constant_ar1 <-
- try(nlme::gls(series ~ 1,
- data = dat,
- correlation = nlme::corAR1(form = ~time)))
- if (class(constant_ar1) == "try-error"){
- return(best_lm <- data.frame(model = NA,
- aicc = NA,
- coefs..Intercept = NA,
- coefs.time = NA,
- coefs.time2 = NA,
- pval = NA))
- }
-
-
-
- # Linear model with normal error
- linear_norm <-
- nlme::gls(series ~ time,
- data = dat)
-
- # Linear model with AR1 error
- linear_ar1 <-
- try(nlme::gls(series ~ time,
- data = dat,
- correlation = nlme::corAR1(form = ~time)))
- if (class(linear_ar1) == "try-error"){
- return(best_lm <- data.frame(model = NA,
- aicc = NA,
- coefs..Intercept = NA,
- coefs.time = NA,
- coefs.time2 = NA,
- pval = NA))
-
- }
-
- # Polynomial model with normal error
- dat$time2 <- dat$time^2
- poly_norm <-
- nlme::gls(series ~ time + time2,
- data = dat)
-
- # Polynomial model with AR1 error
- poly_ar1 <-
- try(nlme::gls(series ~ time + time2,
- data = dat,
- correlation = nlme::corAR1(form = ~time)))
- if (class(poly_ar1) == "try-error"){
- return(best_lm <- data.frame(model = NA,
- aicc = NA,
- coefs..Intercept = NA,
- coefs.time = NA,
- coefs.time2 = NA,
- pval = NA))
-
- }
-
- # Calculate AICs for all models
- df_aicc <-
- data.frame(model = c("poly_norm",
- "poly_ar1",
- "linear_norm",
- "linear_ar1"),
- aicc = c(AICc(poly_norm),
- AICc(poly_ar1),
- AICc(linear_norm),
- AICc(linear_ar1)),
- coefs = rbind(coef(poly_norm),
- coef(poly_ar1),
- c(coef(linear_norm), NA),
- c(coef(linear_ar1), NA)),
- # Calculate overall signifiance (need to use
- # ML not REML for this)
- pval = c(anova(update(constant_norm, method = "ML"),
- update(poly_norm, method = "ML"))$`p-value`[2],
- anova(update(constant_ar1, method = "ML"),
- update(poly_ar1, method = "ML"))$`p-value`[2],
- anova(update(constant_norm, method = "ML"),
- update(linear_norm, method = "ML"))$`p-value`[2],
- anova(update(constant_ar1, method = "ML"),
- update(linear_ar1, method = "ML"))$`p-value`[2]))
-
- best_lm <-
- df_aicc %>%
- dplyr::filter(aicc == min(aicc))
-
-
- if (best_lm$model == "poly_norm") {
- model <- poly_norm
- } else if (best_lm$model == "poly_ar1") {
- model <- poly_ar1
- } else if (best_lm$model == "linear_norm") {
- model <- linear_norm
- } else if (best_lm$model == "linear_ar1") {
- model <- linear_ar1
- }
-
- return(list(p = best_lm$pval,
- model = model))
-}
-
-#-------------------------------------Plotting code------------------------------------#
-soe.plot <- function(data, x.var, y.var, x.label = '', y.label = '', tol = 0.1,
- x.start = NA, x.end = NA, end.start = 2008,
- bg.col = background, mean_line = T,
- end.col = recent, stacked = NA, x.line = 2.5, y.line = 3.5,
- scale.axis = 1,
- rel.y.num = 1.5, rel.y.text = 1.5, suppressAxis = FALSE,
- status = F,anomaly = F,
- endshade = TRUE, full.trend = TRUE, point.cex = 1.5,
- lwd = 2, ymax = TRUE,ymin = TRUE,
- y.upper = y.upper, y.lower = y.lower, extra = FALSE,
- x.var2 = x.var2, y.var2 = y.var2,
- line.forward = FALSE, mean_line.2 = T, cex.stacked = 1,
- website = T) {
-
-
- #Select Data
- x <- data[Var == y.var, ]
- x <- x[order(x[, get(x.var)]), ]
- setnames(x, x.var, 'X')
-
- #Set common time step if necessary
- if(is.na(x.start)) x.start <- min(x[, X])
- if(is.na(x.end)) x.end <- max(x[, X])
- x <- x[X >= x.start, ]
-
- #Set up plot parameters
- if (ymax == TRUE){
- y.max <- max(x[, Value]) + tol * max(x[, Value])
- } else {
- y.max <- as.numeric(y.upper)
- }
-
- if (ymin == TRUE){
- y.min <- min(x[, Value]) - tol * abs(min(x[, Value]))
- } else if (ymin == FALSE){
- y.min <- as.numeric(y.lower)
- }
-
- y.mean <- mean(x[, Value])
- y.sd <- sd(x[, Value])
-
- #Plot blank plot
- plot(x[X >= x.start, list(X)], xlim = c(x.start, x.end),
- ylim = c(y.min,y.max), xlab = '', ylab = '', axes = F)
-
-
- #Add background
- u <- par('usr')
- rect(u[1], u[3], u[2], u[4], border = NA, col = bg.col)
-
- #Add end period shading
- if (endshade == TRUE){
- rect(end.start - 0.5, u[3], u[2], u[4], border = NA, col = end.col)
- }
-
- #Add mean line
- if (anomaly == F){
- if (mean_line == TRUE){
- abline(h = y.mean, col = 'grey', lwd = 3, lty = 2)
- }
- } else if (anomaly == TRUE){
- abline(h = 0, col = 'grey', lwd = 3, lty = 2)
- }
-
- #Add x y lines
- abline(h = u[3], lwd=3)
- abline(v = u[1], lwd=3)
-
- #Add data points/lines
- points(x[, list(X, Value)], pch = 16, cex = point.cex)
- lines( x[, list(X, Value)], lwd = lwd)
-
- #extra lines
- if (extra == TRUE){
- x2 <- data[Var == y.var2, ]
- x2 <- x2[order(x2[, get(x.var2)]), ]
- setnames(x2, x.var2, 'X2')
- x2 <- x2[X2 >= x.start, ]
- if (mean_line.2 == TRUE){
- abline(h = mean(x2[, Value]), col = 'lightcoral', lwd = 3, lty = 2)
- }
- points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
- }
-
-
- #Add axis
- if (suppressAxis == FALSE){
- if(is.na(stacked)) axis(1, cex.axis = 1)
- if(!is.na(stacked)){
- if(stacked!= 'A') axis(3, cex.axis = 1.5, tck = 0.1, labels = F)
- }
- }
-
- #Stacked axes with 0 overlap so need to remove
- labels <- round((axTicks(2) / scale.axis), 5)
- if(labels[1] == 0) labels[1] <- ''
- axis(2, at = axTicks(2), labels = labels, cex.axis = rel.y.num,
- las = T)
-
- #Add axis labels
- if(!website){
- if(!is.na(stacked)) text(u[1], u[4], labels = stacked, cex = cex.stacked,
- adj = c(-0.5, 1.5))
- } else if (website){
- text(u[1], u[4], labels = "", cex = cex.stacked, adj = c(-0.5, 1.5))
- }
- if(is.na(stacked)){
- mtext(1, text = x.label, line = x.line, cex = 1)
- mtext(2, text = y.label, line = y.line, cex = rel.y.text)
- }
-
- if (full.trend == T){
- #Split data into past decade and full time series
- dat <- as.data.frame(x[, list(X, Value)])
-
- dat <- dat %>% dplyr::rename(series = Value) %>%
- mutate(time = seq(1,nrow(dat),1))
-
- # Fit linear model
- lm_out <- fit_lm(dat = dat)
- p <- lm_out$p
- if (p < .05){
-
- newtime <- seq(min(dat$time), max(dat$time), length.out=length(dat$time))
- newdata <- data.frame(time = newtime,
- time2 = newtime^2)
- lm_pred <- AICcmodavg::predictSE(lm_out$model,
- newdata = newdata,
- se.fit = TRUE)
-
- year <- seq(x$X[1],x$X[length(x$X)],length.out = length(dat$time))
-
- # Make plot
- if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1]){
- lines(year, lm_pred$fit, col = main.pos, lwd = 7)
- points(x[, list(X, Value)], pch = 16, cex = point.cex)
- lines( x[, list(X, Value)], lwd = lwd)
-
- if (line.forward == TRUE){
- lines(year, lm_pred$fit, col = main.pos, lwd = 7)
- }
- } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]){
- lines(year, lm_pred$fit, col = main.neg, lwd = 7)
- points(x[, list(X, Value)], pch = 16, cex = point.cex)
- lines( x[, list(X, Value)], lwd = lwd)
- if (line.forward == TRUE){
- lines(year, lm_pred$fit, col = main.neg, lwd = 7)
- }
- }
- }
-
- if (extra == TRUE){
-
- # Second variable
- dat <- as.data.frame(x2[, list(X2, Value)])
-
- dat <- dat %>% dplyr::rename(series = Value) %>%
- mutate(time = seq(1,nrow(dat),1))
-
- # Fit linear model
- lm_out <- fit_lm(dat = dat)
- p <- lm_out$p
- points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
- if (p < .05){
-
- newtime <- seq(min(dat$time), max(dat$time), length.out=length(dat$time))
- newdata <- data.frame(time = newtime,
- time2 = newtime^2)
- lm_pred <- AICcmodavg::predictSE(lm_out$model,
- newdata = newdata,
- se.fit = TRUE)
-
- year <- seq(x2$X2[1],x2$X2[length(x2$X2)],length.out =length(dat$time))
-
- # Make plot
- if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1] ){
- lines(year, lm_pred$fit, col = main.pos, lwd = 7)
- points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
- } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]){
- lines(year, lm_pred$fit, col = main.neg, lwd = 7)
- points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
- lines( x2[, list(X2, Value)], lwd = lwd, col = "indianred")
- }
- }
- }
-
- }
-
-
-
-}
-
-
-#Add axis labels for stacked plots
-soe.stacked.axis <- function(x.label, y.label, x.line = 2.5,rel.x.text = 1.5,
- y.line = 3.5, rel.y.text = 1.5, outer = TRUE){
- axis(1, cex.axis = rel.x.text)
- mtext(1, text = x.label, line = x.line, cex = rel.x.text, outer = outer)
- mtext(2, text = y.label, line = y.line, cex = rel.y.text, outer = outer)
-
-}
-
-
-#Background colors
-background <- 'white'
-recent <- '#E6E6E6'
-main.pos <- rgb(253/255, 184/255, 99/255, alpha = .9)
-main.neg <- rgb(178/255, 171/255, 210/255, alpha = .9)
-
-#```
\ No newline at end of file
+#trend analysis
+
+#```{r, echo=T, message=FALSE, warning=FALSE, include=T}
+
+#R packages
+library(dplyr)
+library(nlme)
+library(AICcmodavg)
+library(data.table)
+#```
+
+#```{r, echo = T, message= F, warning=F, include=T}
+
+# data.dir <- "./data"
+# load(file.path(data.dir, "SOE_data_2018.Rdata"))
+
+#--------------------------------GLS Model Selection-----------------------------#
+fit_lm <- function(dat) {
+ constant_norm <-
+ nlme::gls(series ~ 1, data = dat)
+
+ constant_ar1 <-
+ try(nlme::gls(
+ series ~ 1,
+ data = dat,
+ correlation = nlme::corAR1(form = ~time)
+ ))
+ if (class(constant_ar1) == "try-error") {
+ return(
+ best_lm <- data.frame(
+ model = NA,
+ aicc = NA,
+ coefs..Intercept = NA,
+ coefs.time = NA,
+ coefs.time2 = NA,
+ pval = NA
+ )
+ )
+ }
+
+ # Linear model with normal error
+ linear_norm <-
+ nlme::gls(series ~ time, data = dat)
+
+ # Linear model with AR1 error
+ linear_ar1 <-
+ try(nlme::gls(
+ series ~ time,
+ data = dat,
+ correlation = nlme::corAR1(form = ~time)
+ ))
+ if (class(linear_ar1) == "try-error") {
+ return(
+ best_lm <- data.frame(
+ model = NA,
+ aicc = NA,
+ coefs..Intercept = NA,
+ coefs.time = NA,
+ coefs.time2 = NA,
+ pval = NA
+ )
+ )
+ }
+
+ # Polynomial model with normal error
+ dat$time2 <- dat$time^2
+ poly_norm <-
+ nlme::gls(series ~ time + time2, data = dat)
+
+ # Polynomial model with AR1 error
+ poly_ar1 <-
+ try(nlme::gls(
+ series ~ time + time2,
+ data = dat,
+ correlation = nlme::corAR1(form = ~time)
+ ))
+ if (class(poly_ar1) == "try-error") {
+ return(
+ best_lm <- data.frame(
+ model = NA,
+ aicc = NA,
+ coefs..Intercept = NA,
+ coefs.time = NA,
+ coefs.time2 = NA,
+ pval = NA
+ )
+ )
+ }
+
+ # Calculate AICs for all models
+ df_aicc <-
+ data.frame(
+ model = c("poly_norm", "poly_ar1", "linear_norm", "linear_ar1"),
+ aicc = c(
+ AICc(poly_norm),
+ AICc(poly_ar1),
+ AICc(linear_norm),
+ AICc(linear_ar1)
+ ),
+ coefs = rbind(
+ coef(poly_norm),
+ coef(poly_ar1),
+ c(coef(linear_norm), NA),
+ c(coef(linear_ar1), NA)
+ ),
+ # Calculate overall signifiance (need to use
+ # ML not REML for this)
+ pval = c(
+ anova(
+ update(constant_norm, method = "ML"),
+ update(poly_norm, method = "ML")
+ )$`p-value`[2],
+ anova(
+ update(constant_ar1, method = "ML"),
+ update(poly_ar1, method = "ML")
+ )$`p-value`[2],
+ anova(
+ update(constant_norm, method = "ML"),
+ update(linear_norm, method = "ML")
+ )$`p-value`[2],
+ anova(
+ update(constant_ar1, method = "ML"),
+ update(linear_ar1, method = "ML")
+ )$`p-value`[2]
+ )
+ )
+
+ best_lm <-
+ df_aicc %>%
+ dplyr::filter(aicc == min(aicc))
+
+ if (best_lm$model == "poly_norm") {
+ model <- poly_norm
+ } else if (best_lm$model == "poly_ar1") {
+ model <- poly_ar1
+ } else if (best_lm$model == "linear_norm") {
+ model <- linear_norm
+ } else if (best_lm$model == "linear_ar1") {
+ model <- linear_ar1
+ }
+
+ return(list(p = best_lm$pval, model = model))
+}
+
+#-------------------------------------Plotting code------------------------------------#
+soe.plot <- function(
+ data,
+ x.var,
+ y.var,
+ x.label = '',
+ y.label = '',
+ tol = 0.1,
+ x.start = NA,
+ x.end = NA,
+ end.start = 2008,
+ bg.col = background,
+ mean_line = T,
+ end.col = recent,
+ stacked = NA,
+ x.line = 2.5,
+ y.line = 3.5,
+ scale.axis = 1,
+ rel.y.num = 1.5,
+ rel.y.text = 1.5,
+ suppressAxis = FALSE,
+ status = F,
+ anomaly = F,
+ endshade = TRUE,
+ full.trend = TRUE,
+ point.cex = 1.5,
+ lwd = 2,
+ ymax = TRUE,
+ ymin = TRUE,
+ y.upper = y.upper,
+ y.lower = y.lower,
+ extra = FALSE,
+ x.var2 = x.var2,
+ y.var2 = y.var2,
+ line.forward = FALSE,
+ mean_line.2 = T,
+ cex.stacked = 1,
+ website = T
+) {
+ #Select Data
+ x <- data[Var == y.var, ]
+ x <- x[order(x[, get(x.var)]), ]
+ setnames(x, x.var, 'X')
+
+ #Set common time step if necessary
+ if (is.na(x.start)) {
+ x.start <- min(x[, X])
+ }
+ if (is.na(x.end)) {
+ x.end <- max(x[, X])
+ }
+ x <- x[X >= x.start, ]
+
+ #Set up plot parameters
+ if (ymax == TRUE) {
+ y.max <- max(x[, Value]) + tol * max(x[, Value])
+ } else {
+ y.max <- as.numeric(y.upper)
+ }
+
+ if (ymin == TRUE) {
+ y.min <- min(x[, Value]) - tol * abs(min(x[, Value]))
+ } else if (ymin == FALSE) {
+ y.min <- as.numeric(y.lower)
+ }
+
+ y.mean <- mean(x[, Value])
+ y.sd <- sd(x[, Value])
+
+ #Plot blank plot
+ plot(
+ x[X >= x.start, list(X)],
+ xlim = c(x.start, x.end),
+ ylim = c(y.min, y.max),
+ xlab = '',
+ ylab = '',
+ axes = F
+ )
+
+ #Add background
+ u <- par('usr')
+ rect(u[1], u[3], u[2], u[4], border = NA, col = bg.col)
+
+ #Add end period shading
+ if (endshade == TRUE) {
+ rect(end.start - 0.5, u[3], u[2], u[4], border = NA, col = end.col)
+ }
+
+ #Add mean line
+ if (anomaly == F) {
+ if (mean_line == TRUE) {
+ abline(h = y.mean, col = 'grey', lwd = 3, lty = 2)
+ }
+ } else if (anomaly == TRUE) {
+ abline(h = 0, col = 'grey', lwd = 3, lty = 2)
+ }
+
+ #Add x y lines
+ abline(h = u[3], lwd = 3)
+ abline(v = u[1], lwd = 3)
+
+ #Add data points/lines
+ points(x[, list(X, Value)], pch = 16, cex = point.cex)
+ lines(x[, list(X, Value)], lwd = lwd)
+
+ #extra lines
+ if (extra == TRUE) {
+ x2 <- data[Var == y.var2, ]
+ x2 <- x2[order(x2[, get(x.var2)]), ]
+ setnames(x2, x.var2, 'X2')
+ x2 <- x2[X2 >= x.start, ]
+ if (mean_line.2 == TRUE) {
+ abline(h = mean(x2[, Value]), col = 'lightcoral', lwd = 3, lty = 2)
+ }
+ points(x2[, list(X2, Value)], pch = 16, cex = point.cex, col = "indianred")
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ }
+
+ #Add axis
+ if (suppressAxis == FALSE) {
+ if (is.na(stacked)) {
+ axis(1, cex.axis = 1)
+ }
+ if (!is.na(stacked)) {
+ if (stacked != 'A') axis(3, cex.axis = 1.5, tck = 0.1, labels = F)
+ }
+ }
+
+ #Stacked axes with 0 overlap so need to remove
+ labels <- round((axTicks(2) / scale.axis), 5)
+ if (labels[1] == 0) {
+ labels[1] <- ''
+ }
+ axis(2, at = axTicks(2), labels = labels, cex.axis = rel.y.num, las = T)
+
+ #Add axis labels
+ if (!website) {
+ if (!is.na(stacked)) {
+ text(u[1], u[4], labels = stacked, cex = cex.stacked, adj = c(-0.5, 1.5))
+ }
+ } else if (website) {
+ text(u[1], u[4], labels = "", cex = cex.stacked, adj = c(-0.5, 1.5))
+ }
+ if (is.na(stacked)) {
+ mtext(1, text = x.label, line = x.line, cex = 1)
+ mtext(2, text = y.label, line = y.line, cex = rel.y.text)
+ }
+
+ if (full.trend == T) {
+ #Split data into past decade and full time series
+ dat <- as.data.frame(x[, list(X, Value)])
+
+ dat <- dat %>%
+ dplyr::rename(series = Value) %>%
+ mutate(time = seq(1, nrow(dat), 1))
+
+ # Fit linear model
+ lm_out <- fit_lm(dat = dat)
+ p <- lm_out$p
+ if (p < .05) {
+ newtime <- seq(
+ min(dat$time),
+ max(dat$time),
+ length.out = length(dat$time)
+ )
+ newdata <- data.frame(time = newtime, time2 = newtime^2)
+ lm_pred <- AICcmodavg::predictSE(
+ lm_out$model,
+ newdata = newdata,
+ se.fit = TRUE
+ )
+
+ year <- seq(x$X[1], x$X[length(x$X)], length.out = length(dat$time))
+
+ # Make plot
+ if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1]) {
+ lines(year, lm_pred$fit, col = main.pos, lwd = 7)
+ points(x[, list(X, Value)], pch = 16, cex = point.cex)
+ lines(x[, list(X, Value)], lwd = lwd)
+
+ if (line.forward == TRUE) {
+ lines(year, lm_pred$fit, col = main.pos, lwd = 7)
+ }
+ } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]) {
+ lines(year, lm_pred$fit, col = main.neg, lwd = 7)
+ points(x[, list(X, Value)], pch = 16, cex = point.cex)
+ lines(x[, list(X, Value)], lwd = lwd)
+ if (line.forward == TRUE) {
+ lines(year, lm_pred$fit, col = main.neg, lwd = 7)
+ }
+ }
+ }
+
+ if (extra == TRUE) {
+ # Second variable
+ dat <- as.data.frame(x2[, list(X2, Value)])
+
+ dat <- dat %>%
+ dplyr::rename(series = Value) %>%
+ mutate(time = seq(1, nrow(dat), 1))
+
+ # Fit linear model
+ lm_out <- fit_lm(dat = dat)
+ p <- lm_out$p
+ points(
+ x2[, list(X2, Value)],
+ pch = 16,
+ cex = point.cex,
+ col = "indianred"
+ )
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ if (p < .05) {
+ newtime <- seq(
+ min(dat$time),
+ max(dat$time),
+ length.out = length(dat$time)
+ )
+ newdata <- data.frame(time = newtime, time2 = newtime^2)
+ lm_pred <- AICcmodavg::predictSE(
+ lm_out$model,
+ newdata = newdata,
+ se.fit = TRUE
+ )
+
+ year <- seq(
+ x2$X2[1],
+ x2$X2[length(x2$X2)],
+ length.out = length(dat$time)
+ )
+
+ # Make plot
+ if (lm_pred$fit[length(lm_pred$fit)] > lm_pred$fit[1]) {
+ lines(year, lm_pred$fit, col = main.pos, lwd = 7)
+ points(
+ x2[, list(X2, Value)],
+ pch = 16,
+ cex = point.cex,
+ col = "indianred"
+ )
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ } else if (lm_pred$fit[length(lm_pred$fit)] < lm_pred$fit[1]) {
+ lines(year, lm_pred$fit, col = main.neg, lwd = 7)
+ points(
+ x2[, list(X2, Value)],
+ pch = 16,
+ cex = point.cex,
+ col = "indianred"
+ )
+ lines(x2[, list(X2, Value)], lwd = lwd, col = "indianred")
+ }
+ }
+ }
+ }
+}
+
+
+#Add axis labels for stacked plots
+soe.stacked.axis <- function(
+ x.label,
+ y.label,
+ x.line = 2.5,
+ rel.x.text = 1.5,
+ y.line = 3.5,
+ rel.y.text = 1.5,
+ outer = TRUE
+) {
+ axis(1, cex.axis = rel.x.text)
+ mtext(1, text = x.label, line = x.line, cex = rel.x.text, outer = outer)
+ mtext(2, text = y.label, line = y.line, cex = rel.y.text, outer = outer)
+}
+
+
+#Background colors
+background <- 'white'
+recent <- '#E6E6E6'
+main.pos <- rgb(253 / 255, 184 / 255, 99 / 255, alpha = .9)
+main.neg <- rgb(178 / 255, 171 / 255, 210 / 255, alpha = .9)
+
+#```
diff --git a/R/stored_scripts/zooplankton_analysis.R b/R/stored_scripts/zooplankton_analysis.R
index bddc3aa1..adc3f741 100644
--- a/R/stored_scripts/zooplankton_analysis.R
+++ b/R/stored_scripts/zooplankton_analysis.R
@@ -1,260 +1,328 @@
-# zooplankton analysis
-
-
-
-#```{r, echo = T, eval = F}
-
-#libraries
-library(vegan)
-library(stats)
-library(mgcv)
-library(reshape2)
-library(readxl)
-library(lubridate)
-library(sp)
-library(maptools)
-library(marmap)
-library(rgeos)
-
-
-# load data
-URL='ftp://ftp.nefsc.noaa.gov/pub/hydro/zooplankton_data/EcoMon_Plankton_Data_v3_0.xlsx'
-ZPD=openxlsx::read.xlsx(URL, sheet='Data')
-# Fix date, time
-dt=as_date(ZPD$date, origin = "1899-12-30")
-DOY=yday(dt) #day of year
-month=as.numeric(format(dt, '%m'))
-year=as.numeric(format(dt, '%Y'))
-ZPD$year=year
-ZPD$month=month
-ZPD$dt=dt
-ZPD$DOY=DOY
-ZPD$day=as.numeric(format(dt, '%d'))
-ZPD$lat2=ceiling(ZPD$lat) #use for binning into 1 degree bins for removal of undersampled bins
-ZPD$lon2=floor(ZPD$lon) #use for binning into 1 degree bins for removal of undersampled bins
-# ASSIGN EPU based on GPS data
-## load shapefiles from EDAB EPU analysis ## not available here
-
-gbk=readShapeSpatial("EPU_GBKPoly.shp")
-gom=readShapeSpatial("EPU_GOMPoly.shp")
-mab=readShapeSpatial("EPU_MABPoly.shp")
-scs=readShapeSpatial("EPU_SCSPoly.shp")
-#combine shapefiles GOM and GBK
-gom.gbk.shp=gUnion(gom, gbk, byid=F, id=NULL)
-gom.gbk.shp=gUnion(gom, gbk, byid=F, id=NULL)
-gom.scs.shp=gUnion(gom, scs, byid=F, id=NULL)
-mab.gbk.shp=gUnion(mab, gbk, byid=F, id=NULL)
-NES.shp=gUnion(mab.gbk.shp, gom.scs.shp, byid=F, id=NULL)
-#extract just lat/lons for lines
-gbk.lonlat =as.data.frame(
- lapply(slot(gbk, "polygons"),
- function(x) lapply(slot(x, "Polygons"),
- function(y) slot(y, "coords"))))
-gom.lonlat =as.data.frame(
- lapply(slot(gom, "polygons"),
- function(x) lapply(slot(x, "Polygons"),
- function(y) slot(y, "coords"))))
-mab.lonlat =as.data.frame(
- lapply(slot(mab, "polygons"),
- function(x) lapply(slot(x, "Polygons"),
- function(y) slot(y, "coords"))))
-scs.lonlat =as.data.frame(
- lapply(slot(scs, "polygons"),
- function(x) lapply(slot(x, "Polygons"),
- function(y) slot(y, "coords"))))
-gom.gbk.lonlat =as.data.frame(
- lapply(slot(gom.gbk.shp, "polygons"),
- function(x) lapply(slot(x, "Polygons"),
- function(y) slot(y, "coords"))))
-NES.lonlat =as.data.frame(NES.shp@polygons[[1]]@Polygons[[1]]@coords)
-# create matrix to use in in.out function
-# create matrix to use in in.out function from package 'mgcv'
-gom.mat=as.matrix(gom.lonlat)
-gbk.mat=as.matrix(gbk.lonlat)
-mab.mat=as.matrix(mab.lonlat)
-scs.mat=as.matrix(scs.lonlat)
-gom.gbk.mat=as.matrix(gom.gbk.lonlat)
-# assign samples to EPU
-m4=as.matrix(ZPD[,6:5]) #lon,lat from ZPD
-ZPD$epu=NA
-ZPD$epu[which(in.out(gbk.mat, m4))]='GBK'
-ZPD$epu[which(in.out(gom.mat, m4))]='GOM'
-ZPD$epu[which(in.out(scs.mat, m4))]='SCS'
-ZPD$epu[which(in.out(mab.mat, m4))]='MAB'
-test=ZPD[is.na(ZPD$epu),] #unassigned
-nms=data.frame(colnames(ZPD)) # column names of orginal data
-# limit data set to zooplankton from 1977 on
-ZPDb=ZPD[,c(seq(1,14,1), seq(290,297,1), seq(106,197,1))]
-# check to make sure these are correct against 'nms' if data source changes!!!
-ZPDb=ZPDb[order(ZPDb$date),]
-ZPDb=ZPDb[which(ZPDb$year > 1976),] # remove NA data in years prior to 1977
-# Select only taxa present in yearly data > x percent of samples
-X=20 # percent criteria to use as minimum percent in samples
-ZPDa=ZPDb
-ZPDa=ZPDa[!is.na(ZPDa$zoo_gear),] # Remove NA in zooplankton rows
-# Reduce to taxa occurrance > x percent in samples
-p.a=ZPDa[,24:114]
-p.a[p.a > 0]=1 # presence/absence
-count=colSums(p.a)
-pct=(count/dim(ZPDa)[1])*100
-crit=which(pct>X)
-ZPDa=ZPDa[c(1:23,crit+23)] # data limited to taxa occurring in > X percent of samples
-
-#Take median date from each cruise and assign cruise to bimonth for bi-monthly means aggregation
-cruises=unique(ZPDa$cruise_name)
-for (i in 1:length(cruises)){
- ZPDa$medmonth[ZPDa$cruise_name == cruises[i]]=median(ZPDa$DOY[ZPDa$cruise_name == cruises[i]])
-}
-ZPDa$bmm=NA
-ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(0,59))]=1
-ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(60,120))]=3
-ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(121,181))]=5
-ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(182,243))]=7
-ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(244,304))]=9
-ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(305,366))]=11
-
-ZPDa[,14]=as.numeric(ZPDa[,14])
-ZPDa[,23]=as.numeric(ZPDa[,23])
-ZPDsave=ZPDa #from above routine, Yearly (all data)
-
-SEASON='Yearly'
-ZPDa=ZPDsave
-# LOG transform data using ZPDa from above (select season first)
-test=log10(ZPDa[,24:50]+1) #choose columns with zooplankton data
-ZPDlog=ZPDa
-ZPDlog[,24:50]=test
-nm=matrix(colnames(ZPDlog))
-
-area='GBK'
-gbk.yr.spln=data.frame()
-for (i in 23:50){
- num=i
- name=nm[num,1]
- mean.loc.x=aggregate(ZPDlog[which(ZPDlog$epu==area),num],
- by=list(ZPDlog$bmm[which(ZPDlog$epu==area)]),
- FUN=mean, na.rm=T)
- func = splinefun(mean.loc.x[,1], y=mean.loc.x[,2],
- method="natural",
- ties = mean)
- x.daily=func(seq(1, 12, 0.0302)) #365 days
- gbk.yr.spln=rbind(gbk.yr.spln,x.daily)
-}
-gbk.yr.spln=t(gbk.yr.spln)
-rownames(gbk.yr.spln)=seq(1:365); colnames(gbk.yr.spln)=nm[23:50,1]
-
-area='GOM'
-gom.yr.spln=data.frame()
-for (i in 23:50){
- num=i
- name=nm[num,1]
- mean.loc.x=aggregate(ZPDlog[which(ZPDlog$epu==area),num],
- by=list(ZPDlog$bmm[which(ZPDlog$epu==area)]),
- FUN=mean, na.rm=T)
- func = splinefun(mean.loc.x[,1], y=mean.loc.x[,2],
- method="natural", ties = mean)
- x.daily=func(seq(1, 12, 0.0302)) #365 days
- gom.yr.spln=rbind(gom.yr.spln,x.daily)
-}
-gom.yr.spln=t(gom.yr.spln)
-rownames(gom.yr.spln)=seq(1:365); colnames(gom.yr.spln)=nm[23:50,1]
-
-area='MAB'
-mab.yr.spln=data.frame()
-for (i in 23:50){
- num=i
- name=nm[num,1]
- mean.loc.x=aggregate(ZPDlog[which(ZPDlog$epu==area),num],
- by=list(ZPDlog$bmm[which(ZPDlog$epu==area)]),
- FUN=mean, na.rm=T)
- func = splinefun(mean.loc.x[,1], y=mean.loc.x[,2],
- method="natural", ties = mean)
- x.daily=func(seq(1, 12, 0.0302)) #365 days
- mab.yr.spln=rbind(mab.yr.spln,x.daily)
-}
-mab.yr.spln=t(mab.yr.spln)
-rownames(mab.yr.spln)=seq(1:365); colnames(mab.yr.spln)=nm[23:50,1]
-
-area='SCS'
-scs.yr.spln=data.frame()
-for (i in 23:50){
- num=i
- name=nm[num,1]
- mean.loc.x=aggregate(ZPDlog[which(ZPDlog$epu==area),num],
- by=list(ZPDlog$bmm[which(ZPDlog$epu==area)]),
- FUN=mean, na.rm=T)
- func = splinefun(mean.loc.x[,1], y=mean.loc.x[,2],
- method="natural", ties = mean)
- x.daily=func(seq(1, 12, 0.0302)) #365 days
- scs.yr.spln=rbind(scs.yr.spln,x.daily)
-}
-scs.yr.spln=t(scs.yr.spln)
-rownames(scs.yr.spln)=seq(1:365); colnames(scs.yr.spln)=nm[23:50,1]
-
-# Subtract mean expected value from observed abundance to get anomaly
-gbk.anom=ZPDlog[which(ZPDlog$epu=='GBK'),]
-gom.anom=ZPDlog[which(ZPDlog$epu=='GOM'),]
-mab.anom=ZPDlog[which(ZPDlog$epu=='MAB'),]
-scs.anom=ZPDlog[which(ZPDlog$epu=='SCS'),]
-
-gbk.anom.b=data.frame(matrix(NA, nrow = dim(gbk.anom)[1], ncol = dim(gbk.anom)[2]))
-for (i in 1:dim(gbk.anom)[1]){
- gbk.anom.b[i,23:50]=gbk.anom[i,23:50]-gbk.yr.spln[which(gbk.anom$DOY[i]==rownames(gbk.yr.spln)),]
-}
-gom.anom.b=data.frame(matrix(NA, nrow = dim(gom.anom)[1], ncol = dim(gom.anom)[2]))
-for (i in 1:dim(gom.anom)[1]){
- gom.anom.b[i,23:50]=gom.anom[i,23:50]-gom.yr.spln[which(gom.anom$DOY[i]==rownames(gom.yr.spln)),]
-}
-mab.anom.b=data.frame(matrix(NA, nrow = dim(mab.anom)[1], ncol = dim(mab.anom)[2]))
-for (i in 1:dim(mab.anom)[1]){
- mab.anom.b[i,23:50]=mab.anom[i,23:50]-mab.yr.spln[which(mab.anom$DOY[i]==rownames(mab.yr.spln)),]
-}
-scs.anom.b=data.frame(matrix(NA, nrow = dim(scs.anom)[1], ncol = dim(scs.anom)[2]))
-for (i in 1:dim(scs.anom)[1]){
- scs.anom.b[i,23:50]=scs.anom[i,23:50]-scs.yr.spln[which(scs.anom$DOY[i]==rownames(scs.yr.spln)),]
-}
-
-scs.anom.b=rbind(scs.anom.b,test)
-# Aggregrate by Year, Yearly anomaly by epu
-gbk.yr.anom=aggregate(gbk.anom.b,
- by=list(gbk.anom$year),
- FUN=mean, na.rm=T);
-rownames(gbk.yr.anom)=gbk.yr.anom[,1];
-gbk.yr.anom[,1]=NULL;
-colnames(gbk.yr.anom)=colnames(gbk.anom)
-gom.yr.anom=aggregate(gom.anom.b,
- by=list(gom.anom$year),
- FUN=mean, na.rm=T);
-rownames(gom.yr.anom)=gom.yr.anom[,1];
-gom.yr.anom[,1]=NULL;
-colnames(gom.yr.anom)=colnames(gom.anom)
-mab.yr.anom=aggregate(mab.anom.b,
- by=list(mab.anom$year),
- FUN=mean, na.rm=T);
-rownames(mab.yr.anom)=mab.yr.anom[,1];
-mab.yr.anom[,1]=NULL;
-colnames(mab.yr.anom)=colnames(mab.anom)
-scs.yr.anom=aggregate(scs.anom.b,
- by=list(scs.anom$year),
- FUN=mean, na.rm=T);
-rownames(scs.yr.anom)=scs.yr.anom[,1];
-scs.yr.anom[,1]=NULL;
-colnames(scs.yr.anom)=colnames(scs.anom)
-
-# Small-Large body copepod abundance anomaly
-lgtx=c(25) #column for Calanus finmarchicus
-smtx=c(26,24,28,27)
-#Pseudocalanus spp, Centropoges typicus, Centropages hamatus, Temora longicornis
-
-dataTsm=gbk.yr.anom[,smtx]
-dataTlg=gbk.yr.anom[,lgtx]
-anom.gbk=rowMeans(dataTsm)-(dataTlg)
-dataTsm=gom.yr.anom[,smtx]
-dataTlg=gom.yr.anom[,lgtx]
-anom.gom=rowMeans(dataTsm)-(dataTlg)
-dataTsm=mab.yr.anom[,smtx]
-dataTlg=mab.yr.anom[,lgtx]
-anom.mab=rowMeans(dataTsm)-(dataTlg)
-dataTsm=scs.yr.anom[,smtx]
-dataTlg=scs.yr.anom[,lgtx]
-anom.scs=rowMeans(dataTsm)-(dataTlg)
-#```
\ No newline at end of file
+# zooplankton analysis
+
+#```{r, echo = T, eval = F}
+
+#libraries
+library(vegan)
+library(stats)
+library(mgcv)
+library(reshape2)
+library(readxl)
+library(lubridate)
+library(sp)
+library(maptools)
+library(marmap)
+library(rgeos)
+
+
+# load data
+URL <- 'ftp://ftp.nefsc.noaa.gov/pub/hydro/zooplankton_data/EcoMon_Plankton_Data_v3_0.xlsx'
+ZPD <- openxlsx::read.xlsx(URL, sheet = 'Data')
+# Fix date, time
+dt <- as_date(ZPD$date, origin = "1899-12-30")
+DOY <- yday(dt) #day of year
+month <- as.numeric(format(dt, '%m'))
+year <- as.numeric(format(dt, '%Y'))
+ZPD$year <- year
+ZPD$month <- month
+ZPD$dt <- dt
+ZPD$DOY <- DOY
+ZPD$day <- as.numeric(format(dt, '%d'))
+ZPD$lat2 <- ceiling(ZPD$lat) #use for binning into 1 degree bins for removal of undersampled bins
+ZPD$lon2 <- floor(ZPD$lon) #use for binning into 1 degree bins for removal of undersampled bins
+# ASSIGN EPU based on GPS data
+## load shapefiles from EDAB EPU analysis ## not available here
+
+gbk <- readShapeSpatial("EPU_GBKPoly.shp")
+gom <- readShapeSpatial("EPU_GOMPoly.shp")
+mab <- readShapeSpatial("EPU_MABPoly.shp")
+scs <- readShapeSpatial("EPU_SCSPoly.shp")
+#combine shapefiles GOM and GBK
+gom.gbk.shp <- gUnion(gom, gbk, byid = F, id = NULL)
+gom.gbk.shp <- gUnion(gom, gbk, byid = F, id = NULL)
+gom.scs.shp <- gUnion(gom, scs, byid = F, id = NULL)
+mab.gbk.shp <- gUnion(mab, gbk, byid = F, id = NULL)
+NES.shp <- gUnion(mab.gbk.shp, gom.scs.shp, byid = F, id = NULL)
+#extract just lat/lons for lines
+gbk.lonlat <- as.data.frame(
+ lapply(slot(gbk, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+ })
+)
+gom.lonlat <- as.data.frame(
+ lapply(slot(gom, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+ })
+)
+mab.lonlat <- as.data.frame(
+ lapply(slot(mab, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+ })
+)
+scs.lonlat <- as.data.frame(
+ lapply(slot(scs, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+ })
+)
+gom.gbk.lonlat <- as.data.frame(
+ lapply(slot(gom.gbk.shp, "polygons"), function(x) {
+ lapply(slot(x, "Polygons"), function(y) slot(y, "coords"))
+ })
+)
+NES.lonlat <- as.data.frame(NES.shp@polygons[[1]]@Polygons[[1]]@coords)
+# create matrix to use in in.out function
+# create matrix to use in in.out function from package 'mgcv'
+gom.mat <- as.matrix(gom.lonlat)
+gbk.mat <- as.matrix(gbk.lonlat)
+mab.mat <- as.matrix(mab.lonlat)
+scs.mat <- as.matrix(scs.lonlat)
+gom.gbk.mat <- as.matrix(gom.gbk.lonlat)
+# assign samples to EPU
+m4 <- as.matrix(ZPD[, 6:5]) #lon,lat from ZPD
+ZPD$epu <- NA
+ZPD$epu[which(in.out(gbk.mat, m4))] <- 'GBK'
+ZPD$epu[which(in.out(gom.mat, m4))] <- 'GOM'
+ZPD$epu[which(in.out(scs.mat, m4))] <- 'SCS'
+ZPD$epu[which(in.out(mab.mat, m4))] <- 'MAB'
+test <- ZPD[is.na(ZPD$epu), ] #unassigned
+nms <- data.frame(colnames(ZPD)) # column names of orginal data
+# limit data set to zooplankton from 1977 on
+ZPDb <- ZPD[, c(seq(1, 14, 1), seq(290, 297, 1), seq(106, 197, 1))]
+# check to make sure these are correct against 'nms' if data source changes!!!
+ZPDb <- ZPDb[order(ZPDb$date), ]
+ZPDb <- ZPDb[which(ZPDb$year > 1976), ] # remove NA data in years prior to 1977
+# Select only taxa present in yearly data > x percent of samples
+X <- 20 # percent criteria to use as minimum percent in samples
+ZPDa <- ZPDb
+ZPDa <- ZPDa[!is.na(ZPDa$zoo_gear), ] # Remove NA in zooplankton rows
+# Reduce to taxa occurrance > x percent in samples
+p.a <- ZPDa[, 24:114]
+p.a[p.a > 0] <- 1 # presence/absence
+count <- colSums(p.a)
+pct <- (count / dim(ZPDa)[1]) * 100
+crit <- which(pct > X)
+ZPDa <- ZPDa[c(1:23, crit + 23)] # data limited to taxa occurring in > X percent of samples
+
+#Take median date from each cruise and assign cruise to bimonth for bi-monthly means aggregation
+cruises <- unique(ZPDa$cruise_name)
+for (i in 1:length(cruises)) {
+ ZPDa$medmonth[ZPDa$cruise_name == cruises[i]] <- median(ZPDa$DOY[
+ ZPDa$cruise_name == cruises[i]
+ ])
+}
+ZPDa$bmm <- NA
+ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(0, 59))] <- 1
+ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(60, 120))] <- 3
+ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(121, 181))] <- 5
+ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(182, 243))] <- 7
+ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(244, 304))] <- 9
+ZPDa$bmm[which(as.integer(ZPDa$medmonth) %in% seq(305, 366))] <- 11
+
+ZPDa[, 14] <- as.numeric(ZPDa[, 14])
+ZPDa[, 23] <- as.numeric(ZPDa[, 23])
+ZPDsave <- ZPDa #from above routine, Yearly (all data)
+
+SEASON <- 'Yearly'
+ZPDa <- ZPDsave
+# LOG transform data using ZPDa from above (select season first)
+test <- log10(ZPDa[, 24:50] + 1) #choose columns with zooplankton data
+ZPDlog <- ZPDa
+ZPDlog[, 24:50] <- test
+nm <- matrix(colnames(ZPDlog))
+
+area <- 'GBK'
+gbk.yr.spln <- data.frame()
+for (i in 23:50) {
+ num <- i
+ name <- nm[num, 1]
+ mean.loc.x <- aggregate(
+ ZPDlog[which(ZPDlog$epu == area), num],
+ by = list(ZPDlog$bmm[which(ZPDlog$epu == area)]),
+ FUN = mean,
+ na.rm = T
+ )
+ func <- splinefun(
+ mean.loc.x[, 1],
+ y = mean.loc.x[, 2],
+ method = "natural",
+ ties = mean
+ )
+ x.daily <- func(seq(1, 12, 0.0302)) #365 days
+ gbk.yr.spln <- rbind(gbk.yr.spln, x.daily)
+}
+gbk.yr.spln <- t(gbk.yr.spln)
+rownames(gbk.yr.spln) <- seq(1:365)
+colnames(gbk.yr.spln) <- nm[23:50, 1]
+
+area <- 'GOM'
+gom.yr.spln <- data.frame()
+for (i in 23:50) {
+ num <- i
+ name <- nm[num, 1]
+ mean.loc.x <- aggregate(
+ ZPDlog[which(ZPDlog$epu == area), num],
+ by = list(ZPDlog$bmm[which(ZPDlog$epu == area)]),
+ FUN = mean,
+ na.rm = T
+ )
+ func <- splinefun(
+ mean.loc.x[, 1],
+ y = mean.loc.x[, 2],
+ method = "natural",
+ ties = mean
+ )
+ x.daily <- func(seq(1, 12, 0.0302)) #365 days
+ gom.yr.spln <- rbind(gom.yr.spln, x.daily)
+}
+gom.yr.spln <- t(gom.yr.spln)
+rownames(gom.yr.spln) <- seq(1:365)
+colnames(gom.yr.spln) <- nm[23:50, 1]
+
+area <- 'MAB'
+mab.yr.spln <- data.frame()
+for (i in 23:50) {
+ num <- i
+ name <- nm[num, 1]
+ mean.loc.x <- aggregate(
+ ZPDlog[which(ZPDlog$epu == area), num],
+ by = list(ZPDlog$bmm[which(ZPDlog$epu == area)]),
+ FUN = mean,
+ na.rm = T
+ )
+ func <- splinefun(
+ mean.loc.x[, 1],
+ y = mean.loc.x[, 2],
+ method = "natural",
+ ties = mean
+ )
+ x.daily <- func(seq(1, 12, 0.0302)) #365 days
+ mab.yr.spln <- rbind(mab.yr.spln, x.daily)
+}
+mab.yr.spln <- t(mab.yr.spln)
+rownames(mab.yr.spln) <- seq(1:365)
+colnames(mab.yr.spln) <- nm[23:50, 1]
+
+area <- 'SCS'
+scs.yr.spln <- data.frame()
+for (i in 23:50) {
+ num <- i
+ name <- nm[num, 1]
+ mean.loc.x <- aggregate(
+ ZPDlog[which(ZPDlog$epu == area), num],
+ by = list(ZPDlog$bmm[which(ZPDlog$epu == area)]),
+ FUN = mean,
+ na.rm = T
+ )
+ func <- splinefun(
+ mean.loc.x[, 1],
+ y = mean.loc.x[, 2],
+ method = "natural",
+ ties = mean
+ )
+ x.daily <- func(seq(1, 12, 0.0302)) #365 days
+ scs.yr.spln <- rbind(scs.yr.spln, x.daily)
+}
+scs.yr.spln <- t(scs.yr.spln)
+rownames(scs.yr.spln) <- seq(1:365)
+colnames(scs.yr.spln) <- nm[23:50, 1]
+
+# Subtract mean expected value from observed abundance to get anomaly
+gbk.anom <- ZPDlog[which(ZPDlog$epu == 'GBK'), ]
+gom.anom <- ZPDlog[which(ZPDlog$epu == 'GOM'), ]
+mab.anom <- ZPDlog[which(ZPDlog$epu == 'MAB'), ]
+scs.anom <- ZPDlog[which(ZPDlog$epu == 'SCS'), ]
+
+gbk.anom.b <- data.frame(matrix(
+ NA,
+ nrow = dim(gbk.anom)[1],
+ ncol = dim(gbk.anom)[2]
+))
+for (i in 1:dim(gbk.anom)[1]) {
+ gbk.anom.b[i, 23:50] <- gbk.anom[i, 23:50] -
+ gbk.yr.spln[which(gbk.anom$DOY[i] == rownames(gbk.yr.spln)), ]
+}
+gom.anom.b <- data.frame(matrix(
+ NA,
+ nrow = dim(gom.anom)[1],
+ ncol = dim(gom.anom)[2]
+))
+for (i in 1:dim(gom.anom)[1]) {
+ gom.anom.b[i, 23:50] <- gom.anom[i, 23:50] -
+ gom.yr.spln[which(gom.anom$DOY[i] == rownames(gom.yr.spln)), ]
+}
+mab.anom.b <- data.frame(matrix(
+ NA,
+ nrow = dim(mab.anom)[1],
+ ncol = dim(mab.anom)[2]
+))
+for (i in 1:dim(mab.anom)[1]) {
+ mab.anom.b[i, 23:50] <- mab.anom[i, 23:50] -
+ mab.yr.spln[which(mab.anom$DOY[i] == rownames(mab.yr.spln)), ]
+}
+scs.anom.b <- data.frame(matrix(
+ NA,
+ nrow = dim(scs.anom)[1],
+ ncol = dim(scs.anom)[2]
+))
+for (i in 1:dim(scs.anom)[1]) {
+ scs.anom.b[i, 23:50] <- scs.anom[i, 23:50] -
+ scs.yr.spln[which(scs.anom$DOY[i] == rownames(scs.yr.spln)), ]
+}
+
+scs.anom.b <- rbind(scs.anom.b, test)
+# Aggregrate by Year, Yearly anomaly by epu
+gbk.yr.anom <- aggregate(
+ gbk.anom.b,
+ by = list(gbk.anom$year),
+ FUN = mean,
+ na.rm = T
+)
+rownames(gbk.yr.anom) <- gbk.yr.anom[, 1]
+gbk.yr.anom[, 1] <- NULL
+colnames(gbk.yr.anom) <- colnames(gbk.anom)
+gom.yr.anom <- aggregate(
+ gom.anom.b,
+ by = list(gom.anom$year),
+ FUN = mean,
+ na.rm = T
+)
+rownames(gom.yr.anom) <- gom.yr.anom[, 1]
+gom.yr.anom[, 1] <- NULL
+colnames(gom.yr.anom) <- colnames(gom.anom)
+mab.yr.anom <- aggregate(
+ mab.anom.b,
+ by = list(mab.anom$year),
+ FUN = mean,
+ na.rm = T
+)
+rownames(mab.yr.anom) <- mab.yr.anom[, 1]
+mab.yr.anom[, 1] <- NULL
+colnames(mab.yr.anom) <- colnames(mab.anom)
+scs.yr.anom <- aggregate(
+ scs.anom.b,
+ by = list(scs.anom$year),
+ FUN = mean,
+ na.rm = T
+)
+rownames(scs.yr.anom) <- scs.yr.anom[, 1]
+scs.yr.anom[, 1] <- NULL
+colnames(scs.yr.anom) <- colnames(scs.anom)
+
+# Small-Large body copepod abundance anomaly
+lgtx <- c(25) #column for Calanus finmarchicus
+smtx <- c(26, 24, 28, 27)
+#Pseudocalanus spp, Centropoges typicus, Centropages hamatus, Temora longicornis
+
+dataTsm <- gbk.yr.anom[, smtx]
+dataTlg <- gbk.yr.anom[, lgtx]
+anom.gbk <- rowMeans(dataTsm) - (dataTlg)
+dataTsm <- gom.yr.anom[, smtx]
+dataTlg <- gom.yr.anom[, lgtx]
+anom.gom <- rowMeans(dataTsm) - (dataTlg)
+dataTsm <- mab.yr.anom[, smtx]
+dataTlg <- mab.yr.anom[, lgtx]
+anom.mab <- rowMeans(dataTsm) - (dataTlg)
+dataTsm <- scs.yr.anom[, smtx]
+dataTlg <- scs.yr.anom[, lgtx]
+anom.scs <- rowMeans(dataTsm) - (dataTlg)
+#```
diff --git a/_common.R b/_common.R
index ff04b979..2080b19b 100644
--- a/_common.R
+++ b/_common.R
@@ -5,4 +5,4 @@ options(width = 60)
knitr::opts_chunk$set(
comment = "#>",
collapse = TRUE
- )
+)
diff --git a/data-raw/simplify_coastline.R b/data-raw/simplify_coastline.R
index 0e83084c..6b339f43 100644
--- a/data-raw/simplify_coastline.R
+++ b/data-raw/simplify_coastline.R
@@ -1,19 +1,35 @@
# reads in shapefile then simplifies it and writes out to gis folder
-simplify_coastline <- function(tol=100000) {
-
- coast <- sf::st_read(here::here("gis"),layer="us_medium_shoreline",quiet=T)
- xmin = -81
- xmax = -66
- ymin = 30
- ymax = 45
- coast <- sf::st_crop(coast,c(xmin=xmin, xmax=xmax,ymin=ymin,ymax=ymax))
+simplify_coastline <- function(tol = 100000) {
+ coast <- sf::st_read(
+ here::here("gis"),
+ layer = "us_medium_shoreline",
+ quiet = T
+ )
+ xmin <- -81
+ xmax <- -66
+ ymin <- 30
+ ymax <- 45
+ coast <- sf::st_crop(
+ coast,
+ c(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax)
+ )
map.crs <- "+proj=longlat +lat_1=35 +lat_2=45 +lat_0=40 +lon_0=-77 +x_0=0
+y_0=0 +datum=NAD83 +no_defs +ellps=GRS80 +towgs84=0,0,0"
- coast <- sf::st_transform(coast,map.crs)
-
- simplifiedCoast <- sf::st_as_sf(rgeos::gSimplify(sf::as_Spatial(sf::st_geometry(coast)),tol=tol))
-# return(simplifiedCoast)
-
- # plot(gSimplify(sf::as_Spatial(sf::st_geometry(coast)),tol=10000000));title("tol: 10000000")
- sf::st_write(simplifiedCoast,dsn=here::here("gis"),layer="NEUSCoast",driver="ESRI Shapefile",delete_layer=T,update=T)
-}
\ No newline at end of file
+ coast <- sf::st_transform(coast, map.crs)
+
+ simplifiedCoast <- sf::st_as_sf(rgeos::gSimplify(
+ sf::as_Spatial(sf::st_geometry(coast)),
+ tol = tol
+ ))
+ # return(simplifiedCoast)
+
+ # plot(gSimplify(sf::as_Spatial(sf::st_geometry(coast)),tol=10000000));title("tol: 10000000")
+ sf::st_write(
+ simplifiedCoast,
+ dsn = here::here("gis"),
+ layer = "NEUSCoast",
+ driver = "ESRI Shapefile",
+ delete_layer = T,
+ update = T
+ )
+}
From 6fc528d8e4fb1d1bab6a841d170f36a876cf670c Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Wed, 29 Jul 2026 12:50:12 -0400
Subject: [PATCH 25/29] build: increment to new major version
---
DESCRIPTION | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index df7a36fa..ebc84ae6 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: placeholder
Type: Book
Title: Technical Documentation, State of the Ecosystem Report
Description: Technical documentation for State of the Ecosystem Reporting.
-Version: 7.0.0
+Version: 8.0.0
Depends:
bookdown,
rmarkdown,
@@ -17,7 +17,7 @@ Depends:
DT,
formatR
Remotes:
- NOAA-EDAB/ecodata@dev,
+ NOAA-EDAB/ecodata,
NOAA-EDAB/stocksmart
From cd05938b8ccc3f476d5c9811ddc5bc78b0f5e861 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Wed, 29 Jul 2026 12:50:44 -0400
Subject: [PATCH 26/29] build: change `quiet` argument to false
---
.github/workflows/bookdown.yaml | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/.github/workflows/bookdown.yaml b/.github/workflows/bookdown.yaml
index c4242f41..e111975f 100644
--- a/.github/workflows/bookdown.yaml
+++ b/.github/workflows/bookdown.yaml
@@ -28,7 +28,7 @@ jobs:
- uses: r-lib/actions/setup-r-dependencies@v2
- name: Build book
- run: Rscript -e 'bookdown::render_book("index.Rmd", quiet = TRUE)'
+ run: Rscript -e 'bookdown::render_book("index.Rmd", quiet = FALSE)'
- name: Deploy to gh-pages
uses: JamesIves/github-pages-deploy-action@v4.8.0
From cd030d28dc0073c966390c1330adddbdffc6511b Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Wed, 29 Jul 2026 12:51:19 -0400
Subject: [PATCH 27/29] docs: add release notes for v8.0.0
---
chapters/changelog.Rmd | 17 ++++++++++++++++-
1 file changed, 16 insertions(+), 1 deletion(-)
diff --git a/chapters/changelog.Rmd b/chapters/changelog.Rmd
index 2f3110b8..7eeb2d42 100644
--- a/chapters/changelog.Rmd
+++ b/chapters/changelog.Rmd
@@ -1,6 +1,21 @@
# Changelog {.unnumbered}
-## tech-doc 7.0.0 {.unnumbered}
+## tech-doc v8.0.0 {.unnumbered}
+
+Date: 07/29/2026
+
+### Improvements
+
+- Renamed default branch from `master` to `main`
+- Deployed suite of new and revised issue templates
+- Deployed suite of new pull request templates
+- Added new repository documentation (CONTRIBUTING, CODE_OF_CONDUCT)
+- Revised README
+- Adjusted workflow triggers and bumped versions of external actions
+- Deployed Air reformatter workflows and style guide
+- Reformatted codebase according to new style guide
+
+## tech-doc v7.0.0 {.unnumbered}
Date: 07/14/2026
From d5dd14a56a116b6c22529d9badcb0b97fe19afa7 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Wed, 29 Jul 2026 12:59:41 -0400
Subject: [PATCH 28/29] build: add chapters folder to changelog target
---
.github/workflows/verify_pr.yml | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/.github/workflows/verify_pr.yml b/.github/workflows/verify_pr.yml
index 63a78c39..9ddf30c9 100644
--- a/.github/workflows/verify_pr.yml
+++ b/.github/workflows/verify_pr.yml
@@ -17,4 +17,4 @@ jobs:
- name: Verify Changelog Updated
uses: takanuva15/verify-file-updated@v1
with:
- filename_to_check: changelog.Rmd
+ filename_to_check: chapters/changelog.Rmd
From 729a63dce6a484ce10f1a28334684cab6f448dd6 Mon Sep 17 00:00:00 2001
From: Brandon Beltz - NOAA Affiliate
<136381970+BBeltz1@users.noreply.github.com>
Date: Wed, 29 Jul 2026 14:05:01 -0400
Subject: [PATCH 29/29] docs: unnumber release notes subheader
---
chapters/changelog.Rmd | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/chapters/changelog.Rmd b/chapters/changelog.Rmd
index 7eeb2d42..d4095a66 100644
--- a/chapters/changelog.Rmd
+++ b/chapters/changelog.Rmd
@@ -4,7 +4,7 @@
Date: 07/29/2026
-### Improvements
+### Improvements {.unnumbered}
- Renamed default branch from `master` to `main`
- Deployed suite of new and revised issue templates