From 0f17022533e158a69d384b052734233764c43ae0 Mon Sep 17 00:00:00 2001 From: Iago Mosqueira Date: Tue, 27 Jun 2017 11:46:03 +0200 Subject: [PATCH] Very first version --- .Rbuildignore | 9 + .gitignore | 1 + .travis.yml | 28 ++ DESCRIPTION | 25 ++ EUPL_v1_2_EN_UTF-8.txt | 191 +++++++++++ Makefile | 51 +++ NAMESPACE | 6 + NEWS.md | 14 + R/load.R | 231 +++++++++++++ R/readSS3.R | 718 +++++++++++++++++++++++++++++++++++++++++ README.md | 33 +- appveyor.yml | 54 ++++ man/readFLIBss3.Rd | 33 ++ man/readFLSss3.Rd | 42 +++ 14 files changed, 1435 insertions(+), 1 deletion(-) create mode 100644 .Rbuildignore create mode 100644 .gitignore create mode 100644 .travis.yml create mode 100644 DESCRIPTION create mode 100644 EUPL_v1_2_EN_UTF-8.txt create mode 100644 Makefile create mode 100644 NAMESPACE create mode 100644 NEWS.md create mode 100644 R/load.R create mode 100644 R/readSS3.R create mode 100644 appveyor.yml create mode 100644 man/readFLIBss3.Rd create mode 100644 man/readFLSss3.Rd diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..7495d6a --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,9 @@ +.travis.yml +appveyor.yml +NEWS.md +docs/ +man-roxygen/ +Makefile +.git/ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c066a39 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +inst/doc diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..c62458a --- /dev/null +++ b/.travis.yml @@ -0,0 +1,28 @@ +# .travis.yml for R projects. +# +# https://travis-ci.org/flr/FLCore + +warnings_are_errors: false + +os: + - linux + - osx + +language: R + +r: + - release + - devel + +sudo: false + +cache: packages + +notifications: + email: + on_success: change + on_failure: change + +branches: + only: + - master diff --git a/DESCRIPTION b/DESCRIPTION new file mode 100644 index 0000000..74f7d96 --- /dev/null +++ b/DESCRIPTION @@ -0,0 +1,25 @@ +Package: ss3om +Title: Tools for Conditioning Fisheries Operating Models Using Stock Synthesis 3 +Version: 0.0.1 +Date: 2017-06-027 +Authors@R: person("Iago", "Mosqueira", email = "iago.mosqueira@ec.europa.eu", + role = c("aut", "cre")) +Description: Tools for conditioning of Operating Models based on SS3 by considering + structural uncertainty in input parameters and assumptions, jackknifing of + models and use of McMC output. A grid of SS3 runs is created and results are + loaded on various FLR objects using functions from the r4ss package. +Depends: + R (>= 3.3.2), + FLCore (>= 2.5.20170101) +Imports: + methods, + stats, + data.table, + r4ss (>= 1.27.0), +Additional_repositories: http://flr-project.org/R +Suggests: + doParallel, + testthat +License: File EUPL_v1_2_EN_UTF-8.txt +LazyData: false +RoxygenNote: 6.0.1 diff --git a/EUPL_v1_2_EN_UTF-8.txt b/EUPL_v1_2_EN_UTF-8.txt new file mode 100644 index 0000000..173e5e2 --- /dev/null +++ b/EUPL_v1_2_EN_UTF-8.txt @@ -0,0 +1,191 @@ +EUROPEAN UNION PUBLIC LICENCE v. 1.2 +EUPL © the European Union 2007, 2016 + +This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined below) which is provided under the +terms of this Licence. Any use of the Work, other than as authorised under this Licence is prohibited (to the extent such +use is covered by a right of the copyright holder of the Work). +The Work is provided under the terms of this Licence when the Licensor (as defined below) has placed the following +notice immediately following the copyright notice for the Work: + Licensed under the EUPL +or has expressed by any other means his willingness to license under the EUPL. + +1.Definitions +In this Licence, the following terms have the following meaning: +— ‘The Licence’:this Licence. +— ‘The Original Work’:the work or software distributed or communicated by the Licensor under this Licence, available +as Source Code and also as Executable Code as the case may be. +— ‘Derivative Works’:the works or software that could be created by the Licensee, based upon the Original Work or +modifications thereof. This Licence does not define the extent of modification or dependence on the Original Work +required in order to classify a work as a Derivative Work; this extent is determined by copyright law applicable in +the country mentioned in Article 15. +— ‘The Work’:the Original Work or its Derivative Works. +— ‘The Source Code’:the human-readable form of the Work which is the most convenient for people to study and +modify. +— ‘The Executable Code’:any code which has generally been compiled and which is meant to be interpreted by +a computer as a program. +— ‘The Licensor’:the natural or legal person that distributes or communicates the Work under the Licence. +— ‘Contributor(s)’:any natural or legal person who modifies the Work under the Licence, or otherwise contributes to +the creation of a Derivative Work. +— ‘The Licensee’ or ‘You’:any natural or legal person who makes any usage of the Work under the terms of the +Licence. +— ‘Distribution’ or ‘Communication’:any act of selling, giving, lending, renting, distributing, communicating, +transmitting, or otherwise making available, online or offline, copies of the Work or providing access to its essential +functionalities at the disposal of any other natural or legal person. + +2.Scope of the rights granted by the Licence +The Licensor hereby grants You a worldwide, royalty-free, non-exclusive, sublicensable licence to do the following, for +the duration of copyright vested in the Original Work: +— use the Work in any circumstance and for all usage, +— reproduce the Work, +— modify the Work, and make Derivative Works based upon the Work, +— communicate to the public, including the right to make available or display the Work or copies thereof to the public +and perform publicly, as the case may be, the Work, +— distribute the Work or copies thereof, +— lend and rent the Work or copies thereof, +— sublicense rights in the Work or copies thereof. +Those rights can be exercised on any media, supports and formats, whether now known or later invented, as far as the +applicable law permits so. +In the countries where moral rights apply, the Licensor waives his right to exercise his moral right to the extent allowed +by law in order to make effective the licence of the economic rights here above listed. +The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to any patents held by the Licensor, to the +extent necessary to make use of the rights granted on the Work under this Licence. + +3.Communication of the Source Code +The Licensor may provide the Work either in its Source Code form, or as Executable Code. If the Work is provided as +Executable Code, the Licensor provides in addition a machine-readable copy of the Source Code of the Work along with +each copy of the Work that the Licensor distributes or indicates, in a notice following the copyright notice attached to +the Work, a repository where the Source Code is easily and freely accessible for as long as the Licensor continues to +distribute or communicate the Work. + +4.Limitations on copyright +Nothing in this Licence is intended to deprive the Licensee of the benefits from any exception or limitation to the +exclusive rights of the rights owners in the Work, of the exhaustion of those rights or of other applicable limitations +thereto. + +5.Obligations of the Licensee +The grant of the rights mentioned above is subject to some restrictions and obligations imposed on the Licensee. Those +obligations are the following: + +Attribution right: The Licensee shall keep intact all copyright, patent or trademarks notices and all notices that refer to +the Licence and to the disclaimer of warranties. The Licensee must include a copy of such notices and a copy of the +Licence with every copy of the Work he/she distributes or communicates. The Licensee must cause any Derivative Work +to carry prominent notices stating that the Work has been modified and the date of modification. + +Copyleft clause: If the Licensee distributes or communicates copies of the Original Works or Derivative Works, this +Distribution or Communication will be done under the terms of this Licence or of a later version of this Licence unless +the Original Work is expressly distributed only under this version of the Licence — for example by communicating +‘EUPL v. 1.2 only’. The Licensee (becoming Licensor) cannot offer or impose any additional terms or conditions on the +Work or Derivative Work that alter or restrict the terms of the Licence. + +Compatibility clause: If the Licensee Distributes or Communicates Derivative Works or copies thereof based upon both +the Work and another work licensed under a Compatible Licence, this Distribution or Communication can be done +under the terms of this Compatible Licence. For the sake of this clause, ‘Compatible Licence’ refers to the licences listed +in the appendix attached to this Licence. Should the Licensee's obligations under the Compatible Licence conflict with +his/her obligations under this Licence, the obligations of the Compatible Licence shall prevail. + +Provision of Source Code: When distributing or communicating copies of the Work, the Licensee will provide +a machine-readable copy of the Source Code or indicate a repository where this Source will be easily and freely available +for as long as the Licensee continues to distribute or communicate the Work. +Legal Protection: This Licence does not grant permission to use the trade names, trademarks, service marks, or names +of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and +reproducing the content of the copyright notice. + +6.Chain of Authorship +The original Licensor warrants that the copyright in the Original Work granted hereunder is owned by him/her or +licensed to him/her and that he/she has the power and authority to grant the Licence. +Each Contributor warrants that the copyright in the modifications he/she brings to the Work are owned by him/her or +licensed to him/her and that he/she has the power and authority to grant the Licence. +Each time You accept the Licence, the original Licensor and subsequent Contributors grant You a licence to their contributions +to the Work, under the terms of this Licence. + +7.Disclaimer of Warranty +The Work is a work in progress, which is continuously improved by numerous Contributors. It is not a finished work +and may therefore contain defects or ‘bugs’ inherent to this type of development. +For the above reason, the Work is provided under the Licence on an ‘as is’ basis and without warranties of any kind +concerning the Work, including without limitation merchantability, fitness for a particular purpose, absence of defects or +errors, accuracy, non-infringement of intellectual property rights other than copyright as stated in Article 6 of this +Licence. +This disclaimer of warranty is an essential part of the Licence and a condition for the grant of any rights to the Work. + +8.Disclaimer of Liability +Except in the cases of wilful misconduct or damages directly caused to natural persons, the Licensor will in no event be +liable for any direct or indirect, material or moral, damages of any kind, arising out of the Licence or of the use of the +Work, including without limitation, damages for loss of goodwill, work stoppage, computer failure or malfunction, loss +of data or any commercial damage, even if the Licensor has been advised of the possibility of such damage. However, +the Licensor will be liable under statutory product liability laws as far such laws apply to the Work. + +9.Additional agreements +While distributing the Work, You may choose to conclude an additional agreement, defining obligations or services +consistent with this Licence. However, if accepting obligations, You may act only on your own behalf and on your sole +responsibility, not on behalf of the original Licensor or any other Contributor, and only if You agree to indemnify, +defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against such Contributor by +the fact You have accepted any warranty or additional liability. + +10.Acceptance of the Licence +The provisions of this Licence can be accepted by clicking on an icon ‘I agree’ placed under the bottom of a window +displaying the text of this Licence or by affirming consent in any other similar way, in accordance with the rules of +applicable law. Clicking on that icon indicates your clear and irrevocable acceptance of this Licence and all of its terms +and conditions. +Similarly, you irrevocably accept this Licence and all of its terms and conditions by exercising any rights granted to You +by Article 2 of this Licence, such as the use of the Work, the creation by You of a Derivative Work or the Distribution +or Communication by You of the Work or copies thereof. + +11.Information to the public +In case of any Distribution or Communication of the Work by means of electronic communication by You (for example, +by offering to download the Work from a remote location) the distribution channel or media (for example, a website) +must at least provide to the public the information requested by the applicable law regarding the Licensor, the Licence +and the way it may be accessible, concluded, stored and reproduced by the Licensee. + +12.Termination of the Licence +The Licence and the rights granted hereunder will terminate automatically upon any breach by the Licensee of the terms +of the Licence. +Such a termination will not terminate the licences of any person who has received the Work from the Licensee under +the Licence, provided such persons remain in full compliance with the Licence. + +13.Miscellaneous +Without prejudice of Article 9 above, the Licence represents the complete agreement between the Parties as to the +Work. +If any provision of the Licence is invalid or unenforceable under applicable law, this will not affect the validity or +enforceability of the Licence as a whole. Such provision will be construed or reformed so as necessary to make it valid +and enforceable. +The European Commission may publish other linguistic versions or new versions of this Licence or updated versions of +the Appendix, so far this is required and reasonable, without reducing the scope of the rights granted by the Licence. +New versions of the Licence will be published with a unique version number. +All linguistic versions of this Licence, approved by the European Commission, have identical value. Parties can take +advantage of the linguistic version of their choice. + +14.Jurisdiction +Without prejudice to specific agreement between parties, +— any litigation resulting from the interpretation of this License, arising between the European Union institutions, +bodies, offices or agencies, as a Licensor, and any Licensee, will be subject to the jurisdiction of the Court of Justice +of the European Union, as laid down in article 272 of the Treaty on the Functioning of the European Union, +— any litigation arising between other parties and resulting from the interpretation of this License, will be subject to +the exclusive jurisdiction of the competent court where the Licensor resides or conducts its primary business. + +15.Applicable Law +Without prejudice to specific agreement between parties, +— this Licence shall be governed by the law of the European Union Member State where the Licensor has his seat, +resides or has his registered office, +— this licence shall be governed by Belgian law if the Licensor has no seat, residence or registered office inside +a European Union Member State. + + + Appendix + +‘Compatible Licences’ according to Article 5 EUPL are: +— GNU General Public License (GPL) v. 2, v. 3 +— GNU Affero General Public License (AGPL) v. 3 +— Open Software License (OSL) v. 2.1, v. 3.0 +— Eclipse Public License (EPL) v. 1.0 +— CeCILL v. 2.0, v. 2.1 +— Mozilla Public Licence (MPL) v. 2 +— GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3 +— Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for works other than software +— European Union Public Licence (EUPL) v. 1.1, v. 1.2 +— Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong Reciprocity (LiLiQ-R+) + +The European Commission may update this Appendix to later versions of the above licences without producing +a new version of the EUPL, as long as they provide the rights granted in Article 2 of this Licence and protect the +covered Source Code from exclusive appropriation. +All other changes or additions to this Appendix require the production of a new EUPL version. + diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..069d6df --- /dev/null +++ b/Makefile @@ -0,0 +1,51 @@ +PKGNAME := $(shell sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION) +PKGVERS := $(shell sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION) +PKGDATE := $(shell sed -n "s/Date: *\([^ ]*\)/\1/p" DESCRIPTION) +PKGSRC := $(shell basename `pwd`) + +GITDATE=$(shell (git log -1 --date=short --pretty=format:"%ad")) +GITVERS=$(shell (date -d `git log -1 --date=short --pretty=format:"%ad"` +%Y%m%d)) + +R_FILES := $(wildcard $(PKGSRC)/R/*.R) +HELP_FILES := $(wildcard $(PKGSRC)/man/*.Rd) + +all: README.md build + +README.md: DESCRIPTION + sed -i 's/Version: *\([^ ]*\)/Version: $(PKGVERS)/' README.md + sed -i 's/Date: *\([^ ]*\)/Date: $(PKGDATE)/' README.md + +TEST: NEWS.md + awk '1;/^## CHANGES/{print}' README.md > TMP + sed 's/^#/##/' NEWS.md >> TMP + mv TMP README.md + +NEWS: NEWS.md + sed 's/^# / /' NEWS.md > NEWS + sed -i 's/^##//' NEWS + +docs: $(HELP_FILES) README.md + R --vanilla --silent -e "options(repos='http://cran.r-project.org'); pkgdown::build_site(preview=FALSE)" + +roxygen: $(R_FILES) + R --vanilla --silent -e "library(devtools);" \ + -e "document(roclets='rd')" + +update: + sed -i 's/Date: *\([^ ]*\)/Date: $(GITDATE)/' DESCRIPTION + +build: roxygen + cd ..;\ + R CMD build $(PKGSRC) --compact-vignettes + +install: build + cd ..;\ + R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz + +check: README.md build + cd ..;\ + R CMD check $(PKGNAME)_$(PKGVERS).tar.gz --as-cran + +clean: + cd ..;\ + rm -rf $(PKGNAME).Rcheck $(PKGNAME)_$(PKGVERS).tar.gz diff --git a/NAMESPACE b/NAMESPACE new file mode 100644 index 0000000..8a07967 --- /dev/null +++ b/NAMESPACE @@ -0,0 +1,6 @@ +import("methods") +import("FLCore") +import("data.table") +importFrom("stats", "optimize") +import("r4ss") +exportPattern("^[^\\.]") diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..d16db33 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,14 @@ +# CHANGES IN FLPKG VERSION 0.0.0 + +## NEW FEATURES +- A new feature + +## USER-VISIBLE CHANGES + +## BUG FIXES + +## UTILITIES + +## DOCUMENTATION + +## DEPRECATED & DEFUNCT diff --git a/R/load.R b/R/load.R new file mode 100644 index 0000000..c0d2c6f --- /dev/null +++ b/R/load.R @@ -0,0 +1,231 @@ +# load.R - DESC +# ioalbmse/R/load.R + +# Copyright European Union, 2015-2016 +# Author: Iago Mosqueira (EC JRC) +# +# Distributed under the terms of the European Union Public Licence (EUPL) V.1.1. + +# loadres(dirs, vars, progress=TRUE) {{{ +loadres <- function(dirs, + vars=list(TotBio_Unfished=3, SPB_1950=3, SSB_MSY=3, SPB_2014=3, F_2014=3, + Fstd_MSY=3, TotYield_MSY=3, `SR_LN(R0)`=3, LIKELIHOOD=2, Convergence_Level=2, + Survey=2, Length_comp=2, Catch_like=2, Recruitment=2), progress=TRUE) { + + # Loop over dirs + out <- foreach(i=seq(length(dirs)), .errorhandling = "remove" ) %dopar% { + + if(progress) + cat(paste0('[', i, ']\n')) + + # CONVERGED? + if(!file.exists(paste0(dirs[i], "/covar.sso"))) { + setNames(data.frame(matrix(NA, ncol = length(vars), nrow = 1)), names(vars)) + } else { + # READ results + readRPss3(paste(dirs[i], "Report.sso", sep="/"), vars) + } + } + + # rbind + res <- rbindlist(out) + + # names(res)[4] <- "STD_SSB_MSY" + + # res <- cbind(res, grid) + + # CHANGE SSB_MSY to both sexes + # res$SSB_MSY <- res$SSB_MSY + + return(res) +} # }}} + +# loadrec(dirs, progress=TRUE) {{{ +loadrec <- function(dirs, progress=TRUE, object="resid") { + + # Loop over dirs + out <- foreach(i=seq(length(dirs)), .errorhandling = "remove" ) %dopar% { + + if(progress) + cat(paste0('[', i, ']\n')) + + readFLQsss3(dirs[i]) + } + + res <- foreach(i=object, .errorhandling = "remove" ) %dopar% { + lapply(out, "[[", i) + } + + res <- lapply(res, function(x) Reduce(combine, x)) + names(res) <- object + + return(res) +} # }}} + +# loadom(dirs, progress=TRUE) {{{ +loadom <- function(dirs, progress=TRUE, ...) { + + master <- readFLSss3(dirs[1], ...) + + # LOOP over dirs + om <- foreach(i=seq(length(dirs)), + .combine=function(...) rbindlist(list(...)), .multicombine=TRUE) %dopar% { + + if(progress) + cat("[", i, "]\n", sep="") + + dt <- data.table(as.data.frame(readFLSss3(dirs[i], ...))) + dt[, iter := NULL] + dt[, iter := i] + dt + } + + if(progress) + cat("[ Converting ... ]\n") + + om <- as.FLStock(om, units=units(master)) + range(om) <- range(master) + + # DROP undeeded extra iters + om <- slimFLStock(om) + + return(om) +} # }}} + +# loadom2csv(dirs, progress=TRUE) {{{ +loadom2csv <- function(dirs, progress=TRUE, ...) { + + # LOOP over dirs + if(progress) + cat("[ Reading ... ]\n") + om <- foreach(i=seq(length(dirs))) %dopar% { + + if(progress) + cat("[", i, "] ", sep="") + + dt <- data.table(as.data.frame(readFLSss3(dirs[i], ...))) + dt[, iter := NULL] + dt[, iter := i] + + fwrite(dt, file=paste0(dirs[i], "/om.csv")) + paste0(dirs[i], "/om.csv") + } + + # MERGE + if(progress) + cat("[ Merging ... ]\n") + system(paste0("cp ", dirs[1], "/om.csv ./")) + for(i in seq(2, length(dirs))) { + if(progress) + cat("[", i, "] ", sep="") + system(paste0("tail -n +2 ", dirs[i], "/om.csv >> om.csv")) + system(paste0("rm ", dirs[i], "/om.csv")) + } + + # LOAD + if(progress) + cat("[ Loading ... ]\n") + om <- fread("om.csv") + system("rm om.csv") + + # COERCE + if(progress) + cat("[ Coercing ... ]\n") + om <- as(om, "FLStock") + + return(om) +} # }}} + +# loadindex(dirs, progress=TRUE) {{{ +loadindex <- function(dirs, progress=TRUE, fleets) { + + # LOOP over dirs + ind <- foreach(i=seq(length(dirs))) %dopar% { + + if(progress) + cat("[", i, "]\n", sep="") + + out <- r4ss::SS_output(dirs[i], verbose=FALSE, hidewarn=TRUE, warn=FALSE, + printstats=FALSE, covar=FALSE, forecast=FALSE) + + # dfs from out + cpue <- data.table(out[[c("cpue")]]) + selex <- data.table(out[["ageselex"]]) + + # EXTRACT index, residuals and selectivity + index <- ss3index(cpue, fleets) + index.res <- ss3index.res(cpue, fleets) + sel.pattern <- ss3sel.pattern(selex, unique(cpue$Yr), 3) + + # MERGE across fleets + list(index=index, + index.res=index.res, + sel.pattern=sel.pattern) + } + + # ind: iter - slot - index/flqs + + # out: index - slot - iter + + index <- Reduce(combine, lapply(ind, "[[", 'index')) + index.q <- Reduce(combine, lapply(ind, "[[", 'index.q')) + sel.pattern <- Reduce(combine, lapply(ind, "[[", 'sel.pattern')) + + return(FLQuants(index=index, index.q=index.q, sel.pattern=sel.pattern)) +} # }}} + +# loadhessian {{{ +loadhessian <- function(dir, grid) { + + dirs <- paste(dir, grid$id, sep='/') + + res <- vector('list', length=nrow(grid)) + names(res) <- grid$number + + for(i in seq(length(grid$number))) { + + cat(paste0("[", i, "]\n")) + + filename <- file(paste(dir, grid$id[i], "admodel.hes", sep='/'), "rb") + + num.pars <- readBin(filename, "integer", 1) + hes.vec <- readBin(filename, "numeric", num.pars^2) + + hes <- matrix(hes.vec, ncol=num.pars, nrow=num.pars) + hybrid_bounded_flag <- readBin(filename, "integer", 1) + scale <- readBin(filename, "numeric", num.pars) + + res[[i]] <- list(num.pars = num.pars, hes = hes, + hybrid_bounded_flag = hybrid_bounded_flag, scale = scale) + + close(filename) + } + + return(res) + +} # }}} + +# getRange {{{ +getRange <- function(x) { + + # empty range + range <- rep(as.numeric(NA), 7) + names(range) <- c("min", "max", "plusgroup", "minyear", "maxyear", "minfbar", "maxfbar") + + # age range from catage + range[c("min", "max")] <- range(as.numeric(names(x)[-(1:10)])) + + # plusgroup = max + range["plusgroup"] <- range["max"] + + # min/maxfbar = min/max + range[c("minfbar", "maxfbar")] <- range[c("min", "max")] + + # year range from catage + range[c("minyear", "maxyear")] <- range(x$Yr[x$Era == "TIME"]) + + # set plusgroup to max age + range["plusgroup"] <- range["maxyear"] + + return(range) +} # }}} diff --git a/R/readSS3.R b/R/readSS3.R new file mode 100644 index 0000000..3a0dea0 --- /dev/null +++ b/R/readSS3.R @@ -0,0 +1,718 @@ +# readSS3.R - DESC +# ioalbmse/R/readSS3.R + +# Copyright European Union, 2015-2016 +# Author: Iago Mosqueira (EC JRC) +# +# Distributed under the terms of the European Union Public Licence (EUPL) V.1.1. + +utils::globalVariables(c("BirthSeas", "Age", "Seas", "Sex", "Area", "Fleet", + "Morph", "Yr", "Era", "yr", "seas", "gender", "birthseas", "fleet", "Gender", + "factor", "year", "morph")) + +# readFLBFss3 {{{ +readFLBFss3 <- function(dir, birthseas=unique(out$natage$BirthSeas)) { + + # LOAD SS_output list + out <- r4ss::SS_output(dir, verbose=FALSE, hidewarn=TRUE, warn=FALSE, + printstats=FALSE, covar=TRUE, forecast=FALSE) + + # TODO CHECK out has needed elements + + out <- out[c("catage", "wtatage", "natage", "ageselex", "endgrowth", + "catch_units", "nsexes", "nseasons", "nareas", "IsFishFleet", "fleet_ID", + "FleetNames", "timeseries", "parameters")] + + # GET range + range <- getRange(out$catage) + ages <- ac(seq(range['min'], range['max'])) + + # GET dimnames + dmns <- list(age=ages, + year=seq(range['minyear'], range['maxyear']), + # unit = combinations(Sex, birthseas) + unit=c(t(outer(switch(out$nsexes, "", c("F", "M")), + switch(length(birthseas), "", birthseas), paste0))), + season=seq(out$nseasons), + area=seq(out$nareas), + iter=1) + + # --- BIOL (endgrowth, natage) + + # EXTRACT endgrowth + endgrowth <- data.table(out$endgrowth, key=c("Seas", "Sex", "BirthSeas", "Age")) + + # -- STOCK.WT + + # EXTRACT stock.wt - endgrowth[, Seas, BirthSeas, Age, M] + wt <- endgrowth[BirthSeas == birthseas, + list(BirthSeas, Sex, Seas, Age, Wt_Beg)] + + # CREATE unit from Sex + BirthSeas + wt[, unit:=paste0(ifelse(Sex == 1, "F", "M"), + ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # RENAME + names(wt) <- c("BirthSeas", "Sex", "season", "age", "data", "unit") + + # EXPAND by year, unit & season + wt <- FLCore::expand(as.FLQuant(wt[, .(season, age, data, unit)], + units="kg"), year=dmns$year, unit=dmns$unit, season=dmns$season) + + # -- MAT + + # EXTRACT mat - endgrowth + # NOTE that only Gender 1 (F) is used, M is all -1 + mat <- endgrowth[BirthSeas == birthseas & Gender == 1, + list(BirthSeas, Gender, Seas, Age, Age_Mat)] + + # RENAME + names(mat) <- c("BirthSeas", "unit", "season", "age", "data") + + # EXPAND by year & unit + mat <- FLCore::expand(as.FLQuant(mat[, .(season, age, data)], + units="NA"), year=dmns$year, unit=dmns$unit) + + mat <- predictModel(mat=mat, model=~mat) + + # -- M + + # EXTRACT m - biol[, Seas, BirthSeas, Age, M] + m <- endgrowth[BirthSeas == birthseas, + list(BirthSeas, Gender, Seas, Age, M)] + + # CREATE unit from Gender + BirthSeas + m[, unit:=paste0(ifelse(Gender == 1, "F", "M"), + ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # RENAME + names(m) <- c("BirthSeas", "Gender", "season", "age", "data", "unit") + + # EXPAND by year, unit & season + m <- FLCore::expand(as.FLQuant(m[,.(season, age, data, unit)], units="m"), + year=dmns$year, unit=dmns$unit, season=dmns$season) + + # -- N + + n <- data.table(out$natage) + + # SELECT start of season (Beg/Mid == 'B'), Era == 'TIME' & cols + n <- n[`Beg/Mid` == "B" & Era == 'TIME', + .SD, .SDcols = c("Gender", "BirthSeas", "Yr", "Seas", ages)] + + # MELT by Gender, BirthSeas, Yr & Seas + n <- data.table::melt(n, id.vars=c("Gender", "BirthSeas","Yr","Seas"), variable.name="age") + + # SUBSET according to birthseas + n <- n[BirthSeas %in% birthseas,] + + # CREATE unit from Gender + BirthSeas + n[, unit:=paste0(ifelse(Gender == 1, "F", "M"), ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # DROP Gender and BirthSeas + n[ ,c("Gender","BirthSeas") := NULL] + + # RENAME + names(n) <- c("year", "season", "age", "data", "unit") + + n <- as.FLQuant(n, units="1000") + + # REC + rec <- predictModel(model=~(4 * h * R0 * unitSums(ssb)) / (B0 * (1 - h) + unitSums(ssb) * (5 * h -1)), + params=FLPar(h=out$parameters["SR_BH_steep","Value"], + B0=sum(out$timeseries$SpawnBio[out$timeseries$Era=="VIRG"], na.rm=TRUE), + R0=sum(out$timeseries$Recruit_0[out$timeseries$Era=="VIRG"], na.rm=TRUE))) + + # -- FLBiol + + biol <- FLBiol(n=n, wt=wt, m=m, mat=mat, rec=rec) + + # -- SPWN + spwn(biol)[,,,birthseas] <- 0.5 + + # BUG FLBiol dimensions, FLQs & FLPs + + # -- FISHERIES (catage, wtatage, ageselex) + + # CAA, WAA, SEL + catage <- data.table(out$catage, + key=c("Area", "Fleet", "Gender", "Morph", "Yr", "Seas", "Era")) + wtatage <- data.table(out$wtatage, + key=c("yr", "seas", "gender", "birthseas", "fleet")) + ageselex <- data.table(out$ageselex, + key=c("factor", "fleet", "year", "seas", "gender", "morph"))[factor == "Asel2",] + + # BUG: yr in wtatage is negative + wtatage[, yr:=abs(yr)] + + # RECONSTRUCT BirthSeas from Morph & Gender + catage[, BirthSeas := Morph - (max(Seas) * (Gender - 1))] + ageselex[, BirthSeas := morph - (max(seas) * (gender - 1))] + + # FIND and SUBSET fishing fleets, TIME and BirthSeas + idx <- out$fleet_ID[out$IsFishFleet] + catage <- catage[Fleet %in% idx & Era == "TIME" & BirthSeas %in% birthseas,] + # BUG: scoping does not allow [ on variable with name matching column name + ref <- birthseas + wtatage <- wtatage[fleet %in% idx & birthseas %in% ref,] + ageselex <- ageselex[year >= min(catage[,year]) & year <= max(catage[,year]) & + BirthSeas %in% birthseas,] + + # CREATE unit from Gender + BirthSeas + catage[, unit:=paste0(ifelse(Gender == 1, "F", "M"), + ifelse(length(birthseas) == 1, "", BirthSeas)),] + wtatage[, unit:=paste0(ifelse(gender == 1, "F", "M"), + ifelse(length(ref) == 1, "", birthseas)),] + ageselex[, unit:=paste0(ifelse(gender == 1, "F", "M"), + ifelse(length(ref) == 1, "", BirthSeas)),] + + # MELT by Gender, BirthSeas, Yr & Seas + catage <- data.table::melt(catage, id.vars=c("Area", "Fleet", "Yr", "Seas", "unit"), + measure.vars=ages, variable.name="age") + names(catage) <- c("area", "fleet", "year", "season", "unit", "age", "data") + + wtatage <- data.table::melt(wtatage, id.vars=c("yr", "seas", "fleet", "unit"), + measure.vars=ages, variable.name="age") + names(wtatage) <- c("year", "season", "fleet", "unit", "age", "data") + + ageselex <- data.table::melt(ageselex, id.vars=c("fleet", "year", "seas", "unit"), + measure.vars=ages, variable.name="age") + names(ageselex) <- c("fleet", "year", "season", "unit", "age", "data") + + # CATCHES + catches <- lapply(idx, function(x) { + + landings.n <- as.FLQuant(catage[fleet %in% x,][, fleet:=NULL], units="1") + landings.wt <- as.FLQuant(wtatage[fleet %in% x,][, fleet:=NULL], units="kg") + catch.sel <- predictModel(model=~catch.sel, + FLQuants(catch.sel=as.FLQuant(ageselex[fleet %in% x,][, fleet:=NULL], units="NA"))) + + # CORRECT landings.n in biomass to numbers (catch_units) + if(out$catch_units[x] == 1) { + landings.n <- landings.n / landings.wt + units(landings.n) <- "1" + } + + res <- FLCatch(name="ALB", landings.n=landings.n, landings.wt=landings.wt, catch.sel=catch.sel) + + # discards + discards.n(res)[] <- 0 + discards.wt(res) <- landings.wt(res) + + return(res) + } + ) + + # capacity + # effort + # hperiod + + # CREATE fisheries + fisheries <- FLFisheries(lapply(catches, + function(x) { + + fi <- FLFishery(ALB=x) + + return(fi) + } + )) + + # NAME as in out$FleetNames + names(fisheries) <- out$FleetNames[idx] + + return(list(biol=biol, fisheries=fisheries)) + +} # }}} + +# readFLSss3 {{{ + +#' A function to read SS3 results as an FLStock object +#' +#' Results of a run of the Stock Synthesis sofware, SS3 (Methot & Wetzel, 2013), +#' can be loaded into an object of class \code{\link{{FLStock}}. The code makes +#' use of the r4ss::SS_output function to obtain a list from Report.sso. The +#' following elements of that list are used to generate the necessary information +#' for the slots in \code{\link{FLStock}}: "catage", "natage", "ageselex", +#' "endgrowth", "catch_units", "nsexes", "nseasons", "nareas", "IsFishFleet", +#' "fleet_ID", "FleetNames", "spawnseas", "inputs" and "SS_version". +#' +#' Aliquam sagittis feugiat felis eget consequat. Praesent eleifend dolor massa, +#' vitae faucibus justo lacinia a. Cras sed erat et magna pharetra bibendum quis in +#' mi. Sed sodales mollis arcu, sit amet venenatis lorem fringilla vel. Vivamus vitae +#' ipsum sem. Donec malesuada purus at libero bibendum accumsan. Donec ipsum sapien, +#' feugiat blandit arcu in, dapibus dictum felis. +#' +#’ @references +#' Methot RD Jr, Wetzel CR (2013) Stock Synthesis: A biological and statistical +#' framework for fish stock assessment and fishery management. +#' Fisheries Research 142: 86–99. +#' +#' @param dir Directory holding the SS3 output files +#' @param birthseas Birth seasons for this stock, defaults to spawnseas +#' @param name Name of the output object to fil the name slot +#' @param desc Description of the output object to fill the desc slot +#' +#' @return An object of class \code{\link{FLStock}} +#' +#' @name readFLSss3 +#' @rdname readFLSss3 +#' @aliases readFLSss3 +#' +#' @author The FLR Team +#' @seealso \link{FLComp} +#' @keywords classes +#' @examples +#' + +readFLSss3 <- function(dir, birthseas=out$spawnseas, name="", + desc=paste(out$inputs$repfile, out$SS_version, sep=" - ")) { + + # LOAD SS_output list + out <- r4ss::SS_output(dir, verbose=FALSE, hidewarn=TRUE, warn=FALSE, + printstats=FALSE, covar=FALSE, forecast=FALSE) + + # SUBSET out + out <- out[c("catage", "natage", "ageselex", "endgrowth", + "catch_units", "nsexes", "nseasons", "nareas", "IsFishFleet", "fleet_ID", + "FleetNames", "spawnseas", "inputs", "SS_version")] + + # GET range + range <- getRange(out$catage) + ages <- ac(seq(range['min'], range['max'])) + idx <- out$fleet_ID[out$IsFishFleet] + + # GET dimnames + dmns <- list(age=ages, + year=seq(range['minyear'], range['maxyear']), + # unit = combinations(Sex, birthseas) + unit=c(t(outer(switch(out$nsexes, "unique", c("F", "M")), + switch((length(birthseas) > 1) + 1, "", birthseas), paste0))), + season=switch(ac(out$nseasons), "1"="all", seq(out$nseasons)), + area=switch(ac(out$nareas), "1"="unique", seq(out$nareas)), + iter=1) + + dim <- unlist(lapply(dmns, length)) + + # EXTRACT from out + if(out$nsexes == 1) { + endgrowth <- data.table(out$endgrowth, key=c("Seas", "BirthSeas", "Age")) + } else { + endgrowth <- data.table(out$endgrowth, key=c("Seas", "Sex", "BirthSeas", "Age")) + } + + # NATAGE + natage <- data.table(out$natage) + setnames(natage, c("BirthSeason"), c("BirthSeas")) + + # CATCH.N + catage <- data.table(out$catage) + setnames(catage, c("Gender"), c("Sex")) + setkey(catage, "Area", "Fleet", "Sex", "Morph", "Yr", "Seas", "Era") + + # STOCK.WT + wt <- ss3wt(endgrowth, dmns, birthseas) + + # MAT + mat <- ss3mat(endgrowth, dmns, birthseas) + + # M + m <- ss3m(endgrowth, dmns, birthseas) + + # STOCK.N + n <- ss3n(natage, dmns, birthseas) + + # CATCH.WT, assumes _mat_option == 3 + wtatage <- endgrowth[BirthSeas %in% birthseas, + c("Seas", "Sex", "BirthSeas", "Age", paste0("RetWt:_", idx)), with=FALSE] + + landings <- ss3catch(catage, wtatage, dmns, birthseas, idx) + + # CALCULATE total landings.n + landings.n <- FLQuant(0, dimnames=dmns, units="1000") + for (i in seq(length(idx))) + landings.n <- landings.n %++% landings[[i]]$landings.n + + # BUG: USE landings.wt from fleet 1 + landings.wt <- FLCore::expand(landings[[1]]$landings.wt, year=dmns$year, area=dmns$area) + + # EXPAND m and mat by area + m <- do.call(FLCore::expand, c(list(x=m), dmns)) + mat <- do.call(FLCore::expand, c(list(x=mat), dmns)) + + # FLStock + stock <- FLStock( + name=name, desc=desc, + landings.n=landings.n, landings.wt=landings.wt, + stock.n=n, stock.wt=wt, + m=m, mat=mat) + + # CALCULATE stock, catch, landings & discards + discards.n(stock) <- 0 + units(discards.n(stock)) <- units(landings.n(stock)) + discards.wt(stock) <- landings.wt(stock) + + landings(stock) <- computeLandings(stock) + discards(stock) <- computeDiscards(stock) + catch(stock) <- computeCatch(stock, slot='all') + stock(stock) <- computeStock(stock) + + # ASSIGN harvest.spwn and m.spwn in birthseas + harvest.spwn(stock)[,,,birthseas] <- 0.5 + m.spwn(stock)[,,,birthseas] <- 0.5 + + # HARVEST + harvest(stock) <- harvest(stock.n(stock), catch=catch.n(stock), m=m(stock)) + + return(stock) + +} # }}} + +# readFLIBss3 {{{ + +#' A function to read the CPUE series from an SS3 run into anm FLIndex object +#' +#’ @references +#' Methot RD Jr, Wetzel CR (2013) Stock Synthesis: A biological and statistical +#' framework for fish stock assessment and fishery management. +#' Fisheries Research 142: 86–99. +#' +#' @param dir Directory holding the SS3 output files +#' @param name Name of the output object to fil the name slot +#' @param desc Description of the output object to fill the desc slot +#' +#' @return An object of class \code{\link{FLStock}} +#' +#' @name readFLIBss3 +#' @rdname readFLIBss3 +#' @aliases readFLIBss3 +#' +#' @author The FLR Team +#' @seealso \link{FLComp} +#' @keywords classes +#' @examples +#' +# +# dir <- '../../../sa/run/' +# cps <- readFLIBss3(dir, fleets=c(LLCPUE1=1, LLCPUE2=2, LLCPUE3=3, LLCPUE4=4)) + +readFLIBss3 <- function(dir, fleets) { + + # LOAD SS_output list + out <- r4ss::SS_output(dir, verbose=FALSE, hidewarn=TRUE, warn=FALSE, + printstats=FALSE, covar=FALSE, forecast=FALSE) + + # TODO LOAD ctl$sizeselex, to match fleets if not given + + # SUBSET from out + cpue <- data.table(out[[c("cpue")]]) + selex <- data.table(out[["ageselex"]]) + + # --- index + index <- ss3index(cpue, fleets) + + # --- index.var + # index.var <- ss3index.var(cpue, fleets) + + # --- index.q + index.q <- ss3index.q(cpue, fleets) + + # --- sel.pattern + sel.pattern <- ss3sel.pattern(selex, unique(cpue$Yr), fleets) + + # --- index.res (var) + index.res <- ss3index.res(cpue, fleets) + + # --- FLIndices + cpues <- lapply(names(fleets), function(x) FLIndexBiomass(name=x, + index=index[[x]], index.q=index.q[[x]], + index.var=index.res[[x]], + sel.pattern=window(sel.pattern[[x]], start=dims(index[[x]])$minyear, + end=dims(index[[x]])$maxyear))) + + if(length(fleets) > 1) + return(FLIndices(cpues)) + else + return(cpues[[1]]) + +} # }}} + +# readRPss3 {{{ +readRPss3 <- function(file, vars) { + + dat <- readLines(file, n=2000) + for(i in names(vars)) { + # vector with string + str <- unlist(strsplit(dat[grep(paste0(gsub("\\(", "\\\\\\(", i), "[ ,:]"), dat, fixed=FALSE)], " ")) + vars[[i]] <- as.numeric(str[vars[[i]]]) + } + return(as.data.frame(t(unlist(vars)))) +} # }}} + +# readFLQsss3 {{{ +readFLQsss3 <- function(dir) { + + # LOAD SS_output list + out <- r4ss::SS_output(dir, verbose=FALSE, hidewarn=TRUE, warn=FALSE, + printstats=FALSE, covar=TRUE, forecast=FALSE) + + # SUBSET out + out <- out[c("derived_quants", "recruit", "startyr", "endyr", "Kobe")] + + yrs <- ac(seq(out$startyr, out$endyr)) + + # REC + recruit <- data.table(out$recruit) + rec <- FLQuant(recruit[, pred_recr], dimnames=list(age='0', year=recruit[, year]), + units="1000")[, yrs] + + # SPB + ssb <- FLQuant(recruit[, spawn_bio], dimnames=list(age='all', year=recruit[, year]), + units="t")[, yrs] + + # RESID + resid <- FLQuant(recruit[, dev], dimnames=list(age='all', year=recruit[, year]), + units="t")[, yrs] + + # BBMSY + kobe <- data.table(out$Kobe) + bbmsy <- FLQuant(kobe[, B.Bmsy], dimnames=list(age='all', year=kobe[, Year]), + units="NA")[, yrs] + + ffmsy <- FLQuant(kobe[, F.Fmsy], dimnames=list(age='all', year=kobe[, Year]), + units="NA")[, yrs] + + # $Dynamic_Bzero + + # $derived_quants + # F_1950 + + return(FLQuants(rec=rec, ssb=ssb, resid=resid, bbmsy=bbmsy, ffmsy=ffmsy)) +} # }}} + +# ss3slot functions {{{ + +# ss3index +ss3index <- function(cpue, fleets) { + + index <- cpue[Name %in% names(fleets), c("Name", "Yr", "Seas", "Obs")] + + # CHANGE names and SORT + names(index) <- c("qname", "year", "season", "data") + setorder(index, year, season, qname) + index[, age:='all'] + + # CONVERT to FLQuants + return(as(index, "FLQuants")) +} + +# ss3index.res +ss3index.res <- function(cpue, fleets) { + + cpue[, Res := Obs-Exp] + index <- cpue[Name %in% names(fleets), c("Name", "Yr", "Seas", "Res")] + + # CHANGE names and SORT + names(index) <- c("qname", "year", "season", "data") + setorder(index, year, season, qname) + index[, age:='all'] + + # CONVERT to FLQuants + return(as(index, "FLQuants")) +} + +# ss3index.var +ss3index.var <- function(cpue, fleets) { + + index.var <- cpue[Name %in% names(fleets), c("Name", "Yr", "Seas", "SE")] + + # CHANGE names and SORT + names(index.var) <- c("qname", "year", "season", "data") + setorder(index.var, year, season, qname) + index.var[, age:='all'] + + # CONVERT to FLQuants + index.var <- as(index.var, "FLQuants") + + # units = SE + index.var <- lapply(index.var, "units<-", "se") + + return(index.var) +} + +# ss3index.q +ss3index.q <- function(cpue, fleets) { + + index.q <- cpue[Name %in% names(fleets), c("Name", "Yr", "Seas", "Calc_Q")] + + # CHANGE names and SORT + names(index.q) <- c("qname", "year", "season", "data") + setorder(index.q, year, season, qname) + index.q[, age:='all'] + + # CONVERT to FLQuants + return(as(index.q, "FLQuants")) +} + +# ss3sel.pattern +ss3sel.pattern <- function(selex, years, fleets) { + + setkey(selex, "factor", fleet, year, morph) + + # SUBSET Asel2, fleets, cpue years + selex <- selex[CJ("Asel2", fleets, years, c(4,8))] + selex[, c("factor", "morph", "label") := NULL] + + # RESHAPE to long + selex <- melt(selex, id.vars=c("fleet", "year", "seas","gender"), + variable.name="age", value.name="data") + + # CHANGE names & SORT + names(selex) <- c("qname", "year", "season", "unit", "age", "data") + setorder(selex, year, season, age, unit, qname) + + # CONVERT to FLQuants + sel.pattern <- as(as.data.frame(selex), 'FLQuants') + + # ASSIGN names + names(sel.pattern) <- names(fleets) + + return(sel.pattern) +} + +# ss3wt +ss3wt <- function(endgrowth, dmns, birthseas) { + + # EXTRACT stock.wt - endgrowth[, Seas, BirthSeas, Age, M] + wt <- endgrowth[BirthSeas == birthseas, + list(BirthSeas, Sex, Seas, Age, Wt_Beg)] + + # CREATE unit from Sex + BirthSeas + wt[, unit:=paste0(dmns$unit[Sex], + ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # RENAME + names(wt) <- c("BirthSeas", "Sex", "season", "age", "data", "unit") + + # EXPAND by year, unit & season + wt <- FLCore::expand(as.FLQuant(wt[, .(season, age, data, unit)], units="kg"), + year=dmns$year, unit=dmns$unit, season=dmns$season, area=dmns$area) +} + +# ss3mat +ss3mat <- function(endgrowth, dmns, birthseas) { + + # EXTRACT mat - endgrowth + # NOTE that only Sex 1 (F) is used, M is all -1 + mat <- endgrowth[BirthSeas == birthseas & Sex == 1, + list(BirthSeas, Sex, Seas, Age, Age_Mat)] + + # RENAME + names(mat) <- c("BirthSeas", "unit", "season", "age", "data") + + # EXPAND by year & unit + mat <- FLCore::expand(as.FLQuant(mat[, .(season, age, data)], + units="NA"), year=dmns$year, unit=dmns$unit, season=dmns$season) + + return(mat) +} + +# ss3m +ss3m <- function(endgrowth, dmns, birthseas) { + + # EXTRACT m - biol[, Seas, BirthSeas, Age, M] + m <- endgrowth[BirthSeas == birthseas, + list(BirthSeas, Sex, Seas, Age, M)] + + # CREATE unit from Sex + BirthSeas + m[, unit:=paste0(dmns$unit[Sex], + ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # SPLIT M across seasons + m[, M:=M/length(dmns$season)] + + # RENAME + names(m) <- c("BirthSeas", "Sex", "season", "age", "data", "unit") + + # EXPAND by year, unit & season + m <- FLCore::expand(as.FLQuant(m[,.(season, age, data, unit)], units="m"), + year=dmns$year, unit=dmns$unit, season=dmns$season) +} + +# ss3n +ss3n <- function(n, dmns, birthseas) { + + # SELECT start of season (Beg/Mid == 'B'), Era == 'TIME' & cols + n <- n[`Beg/Mid` == "B" & Era == 'TIME', + .SD, .SDcols = c("Area", "Sex", "BirthSeas", "Yr", "Seas", dmns$age)] + + # MELT by Sex, BirthSeas, Yr & Seas + n <- data.table::melt(n, id.vars=c("Area", "Sex", "BirthSeas","Yr","Seas"), + variable.name="age") + + # SUBSET according to birthseas + n <- n[BirthSeas %in% birthseas,] + + # CREATE unit from Sex + BirthSeas + n[, unit:=paste0(dmns$unit[Sex], + ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # DROP Sex and BirthSeas + n[ ,c("Sex","BirthSeas") := NULL] + + # RENAME + names(n) <- c("area", "year", "season", "age", "data", "unit") + n <- as.FLQuant(n, units="1000") + dimnames(n) <- dmns + + return(n) +} + +# ss3catch +ss3catch <- function(catage, wtatage, dmns, birthseas, idx) { + + # RECONSTRUCT BirthSeas from Morph & Sex + catage[, BirthSeas := Morph - max(Seas) * (Sex - 1)] + + # FIND and SUBSET fishing fleets, TIME and BirthSeas + catage <- catage[Fleet %in% idx & Era == "TIME" & BirthSeas %in% birthseas,] + + # CREATE unit from Sex + BirthSeas + catage[, unit:=paste0(dmns$unit[Sex], + ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # RENAME Area and Season if only 1 + cols <- c("Seas", "Area") + catage[, (cols) := lapply(.SD, as.character), .SDcols = cols] + catage[, Seas := if(length(unique(Seas)) == 1) "all" else Seas] + catage[, Area := if(length(unique(Area)) == 1) "unique" else Area] + + # MELT by Sex, BirthSeas, Yr & Seas + catage <- data.table::melt(catage, id.vars=c("Area", "Fleet", "Yr", "Seas", "unit"), + measure.vars=dmns$age, variable.name="age") + names(catage) <- c("area", "fleet", "year", "season", "unit", "age", "data") + + # RENAME Season if only 1 + cols <- c("Seas") + wtatage[, (cols) := lapply(.SD, as.character), .SDcols = cols] + wtatage[, Seas := if(length(unique(Seas)) == 1) "all" else Seas] + + # CREATE unit from Sex + BirthSeas + wtatage[, unit:=paste0(dmns$unit[Sex], + ifelse(length(birthseas) == 1, "", BirthSeas)),] + + # MELT by Sex, BirthSeas, Yr & Seas + wtatage <- data.table::melt(wtatage, id.vars=c("Age", "unit", "Seas"), + measure.vars=paste0("RetWt:_", idx), variable.name="fleet") + names(wtatage) <- c("age", "unit", "season", "fleet", "data") + wtatage[,fleet:=sub("RetWt:_", "", fleet)] + + # FLQuant for landings per fleet + landings <- lapply(idx, function(x) { + landings.n <- as.FLQuant(catage[fleet %in% x,][, fleet:=NULL], units="1000") + landings.wt <- as.FLQuant(wtatage[fleet %in% x,][, fleet:=NULL], units="kg") + return(FLQuants(landings.n=landings.n, landings.wt=landings.wt)) + } + ) + + return(landings) +} # }}} diff --git a/README.md b/README.md index 030d42e..bddc969 100644 --- a/README.md +++ b/README.md @@ -1 +1,32 @@ -# ss3om \ No newline at end of file +# ss3om +- Version: 0.0.1 +- Date: 2017-06-027 +- Author: Iago Mosqueira, EC JRC +- Maintainer: Iago Mosqueira +- Repository: +- Bug reports: + +## Overview +Tools for conditioning of Operating Models based on SS3 by considering structural uncertainty in input parameters and assumptions, jackknifing of models and use of McMC output. A grid of SS3 runs is created and results are loaded on various FLR objects using functions from the r4ss package. + +To install this package, start R and enter: + + devtools::install_github("iagomosqueira/ss3om") + +## Build Status +[![Travis Build Status](https://travis-ci.org/iagomosqueira/ss3om.svg?branch=master)](https://travis-ci.org/iagomosqueira/ss3om) +[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/iagomosqueira/ss3om?branch=master&svg=true)](https://ci.appveyor.com/project/iagomosqueira/ss3om) + +## Releases +- [Latest release](https://github.com/iagomosqueira/ss3om/releases/tag/) +- [All release](https://github.com/iagomosqueira/ss3om/releases/) + +## License +Copyright (c) 2017 European Union. Released under the [European Union Public License 1.2](https://joinup.ec.europa.eu/community/eupl/og_page/eupl-text-11-12). + +## Contact +You are welcome to: + +- Submit suggestions and bug-reports at: +- Send a pull request on: +- Compose a friendly e-mail to: diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000..13bbba8 --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,54 @@ +# https://ci.appveyor.com/project/flr/FLPKG +# DO NOT CHANGE the "init" and "install" sections below + +# Download script file from GitHub +init: + ps: | + $ErrorActionPreference = "Stop" + Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" + Import-Module '..\appveyor-tool.ps1' + +install: + ps: Bootstrap + +# Adapt as necessary starting from here + +environment: + global: + WARNINGS_ARE_ERRORS: + + matrix: + - R_VERSION: devel + R_ARCH: x64 + + - R_VERSION: release + R_ARCH: x64 + +build_script: + - travis-tool.sh install_deps + +test_script: + - travis-tool.sh run_tests + +on_failure: + - 7z a failure.zip *.Rcheck\* + - appveyor PushArtifact failure.zip + +artifacts: + - path: '*.Rcheck\**\*.log' + name: Logs + + - path: '*.Rcheck\**\*.out' + name: Logs + + - path: '*.Rcheck\**\*.fail' + name: Logs + + - path: '*.Rcheck\**\*.Rout' + name: Logs + + - path: '\*_*.tar.gz' + name: Bits + + - path: '\*_*.zip' + name: Bits diff --git a/man/readFLIBss3.Rd b/man/readFLIBss3.Rd new file mode 100644 index 0000000..4b94ae0 --- /dev/null +++ b/man/readFLIBss3.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readSS3.R +\name{readFLIBss3} +\alias{readFLIBss3} +\title{A function to read the CPUE series from an SS3 run into anm FLIndex object} +\usage{ +readFLIBss3(dir, fleets) +} +\arguments{ +\item{dir}{Directory holding the SS3 output files} + +\item{name}{Name of the output object to fil the name slot} + +\item{desc}{Description of the output object to fill the desc slot} +} +\value{ +An object of class \code{\link{FLStock}} +} +\description{ +Methot RD Jr, Wetzel CR (2013) Stock Synthesis: A biological and statistical +framework for fish stock assessment and fishery management. +Fisheries Research 142: 86–99. +} +\examples{ + +} +\seealso{ +\link{FLComp} +} +\author{ +The FLR Team +} +\keyword{classes} diff --git a/man/readFLSss3.Rd b/man/readFLSss3.Rd new file mode 100644 index 0000000..0981a9c --- /dev/null +++ b/man/readFLSss3.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/readSS3.R +\name{readFLSss3} +\alias{readFLSss3} +\title{A function to read SS3 results as an FLStock object} +\usage{ +readFLSss3(dir, birthseas = out$spawnseas, name = "", + desc = paste(out$inputs$repfile, out$SS_version, sep = " - ")) +} +\arguments{ +\item{dir}{Directory holding the SS3 output files} + +\item{birthseas}{Birth seasons for this stock, defaults to spawnseas} + +\item{name}{Name of the output object to fil the name slot} + +\item{desc}{Description of the output object to fill the desc slot} +} +\value{ +An object of class \code{\link{FLStock}} +} +\details{ +Aliquam sagittis feugiat felis eget consequat. Praesent eleifend dolor massa, +vitae faucibus justo lacinia a. Cras sed erat et magna pharetra bibendum quis in +mi. Sed sodales mollis arcu, sit amet venenatis lorem fringilla vel. Vivamus vitae +ipsum sem. Donec malesuada purus at libero bibendum accumsan. Donec ipsum sapien, +feugiat blandit arcu in, dapibus dictum felis. + +Methot RD Jr, Wetzel CR (2013) Stock Synthesis: A biological and statistical +framework for fish stock assessment and fishery management. +Fisheries Research 142: 86–99. +} +\examples{ + +} +\seealso{ +\link{FLComp} +} +\author{ +The FLR Team +} +\keyword{classes}