diff --git a/.dockerignore b/.dockerignore index 97656d26986..dd0e8eb54ec 100644 --- a/.dockerignore +++ b/.dockerignore @@ -1,10 +1,18 @@ +# ignore git folder .git +# ignore .install, need own version in docker .install +# ignore packrat lib/src folders, others might be needed +*/*/packrat/lib*/ +*/*/packrat/src/ + +# ignore tests and contrib folder tests contrib +# ignore compiled files from rtm modules/rtm/src/RTM/*.o modules/rtm/src/RTM/*/*.o modules/rtm/src/RTM/*/*/*.o diff --git a/.github/ISSUE_TEMPLATE/Doc_changes.md b/.github/ISSUE_TEMPLATE/Doc_changes.md index 8fa71f26768..5ca90aeaabb 100644 --- a/.github/ISSUE_TEMPLATE/Doc_changes.md +++ b/.github/ISSUE_TEMPLATE/Doc_changes.md @@ -13,6 +13,6 @@ There is a broken URL link in the documentation. It is in the master version in ### Information for those wanting to make changes -Please follow the instructions in the [Editing this Book](https://pecanproject.github.io/pecan-documentation/develop/bookediting.html) section of the documentation. +Please follow the instructions in the [Editing this Book](https://pecanproject.github.io/pecan-documentation/develop/about-the-pecan-book.html#bookediting) section of the documentation. -All R-markdown files related to documentation are located within the main directory `/pecan/book_source` except for the demos and vignettes which are in `pecan/documentation/tutorials`. \ No newline at end of file +All R-markdown files related to documentation are located within the main directory `/pecan/book_source` except for the demos and vignettes which are in `pecan/documentation/tutorials`. diff --git a/.github/workflows/book.yml b/.github/workflows/book.yml new file mode 100644 index 00000000000..a10e89c89a2 --- /dev/null +++ b/.github/workflows/book.yml @@ -0,0 +1,68 @@ +name: renderbook + +on: + push: + branches: + - master + - develop + + tags: + - '*' + + pull_request: + +jobs: + bookdown: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + container: + image: pecan/depends:R4.0.3 + + steps: + # checkout source code + - uses: actions/checkout@v2 + # install rmarkdown + - name: Install rmarkdown + run: | + Rscript -e 'install.packages(c("rmarkdown","bookdown"))' + # copy files + - name: copy extfiles + run: | + mkdir -p book_source/extfiles + cp -f documentation/tutorials/01_Demo_Basic_Run/extfiles/* book_source/extfiles + # compile PEcAn code + - name: build + run: make -j1 + # render book + - name: Render Book + run: | + cd book_source + Rscript -e 'options(bookdown.render.file_scope=FALSE); bookdown::render_book("index.Rmd", "bookdown::gitbook")' + # save artifact + - uses: actions/upload-artifact@v2 + with: + name: pecan-documentation + path: book_source/_book/ + # download documentation repo + - name: Checkout documentation repo + if: github.event_name != 'pull_request' + uses: actions/checkout@v2 + with: + repository: ${{ github.repository_owner }}/pecan-documentation + path: pecan-documentation + token: ${{ secrets.GH_PAT }} + # upload new documentation + - name: publish to github + if: github.event_name != 'pull_request' + run: | + git config --global user.email "pecanproj@gmail.com" + git config --global user.name "GitHub Documentation Robot" + export VERSION=${GITHUB_REF##*/} + cd pecan-documentation + mkdir -p $VERSION + rsync -a --delete ../book_source/_book/ ${VERSION}/ + git add --all * + git commit -m "Build book from pecan revision ${GITHUB_SHA}" || true + git push -q origin master diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 00000000000..5dcce9bf09a --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,223 @@ +name: CI + +on: + push: + branches: + - master + - develop + + tags: + - '*' + + pull_request: + + issue_comment: + types: + - created + +env: + R_LIBS_USER: /usr/local/lib/R/site-library + LC_ALL: en_US.UTF-8 + NCPUS: 2 + PGHOST: postgres + CI: true + +jobs: + + # ---------------------------------------------------------------------- + # R BUILD + # ---------------------------------------------------------------------- + build: + if: github.event_name != 'issue_comment' || startsWith(github.event.comment.body, '/build') + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + strategy: + fail-fast: false + matrix: + R: + - "4.0.3" + - "4.0.4" + + container: + image: pecan/depends:R${{ matrix.R }} + + steps: + # checkout source code + - uses: actions/checkout@v2 + + # install additional tools needed + - name: install utils + run: apt-get update && apt-get install -y postgresql-client qpdf curl + + # check dependencies + - name: update dependency lists + run: Rscript scripts/generate_dependencies.R + - name: check for out-of-date dependencies files + uses: infotroph/tree-is-clean@v1 + - name: install newly-added dependencies + run: Rscript docker/depends/pecan.depends.R + + # compile PEcAn code + - name: build + run: make -j1 + - name: check for out-of-date files + uses: infotroph/tree-is-clean@v1 + + # ---------------------------------------------------------------------- + # R TEST + # ---------------------------------------------------------------------- + test: + if: github.event_name != 'issue_comment' || startsWith(github.event.comment.body, '/build') + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + strategy: + fail-fast: false + matrix: + R: + - "4.0.3" + - "4.0.4" + + services: + postgres: + image: mdillon/postgis:9.5 + options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5 + + container: + image: pecan/depends:R${{ matrix.R }} + + steps: + # checkout source code + - uses: actions/checkout@v2 + + # install additional tools needed + - name: install utils + run: apt-get update && apt-get install -y postgresql-client qpdf + - name: install new dependencies + run: Rscript scripts/generate_dependencies.R && Rscript docker/depends/pecan.depends.R + + # initialize database + - name: db setup + uses: docker://pecan/db:ci + - name: add models to db + run: ./scripts/add.models.sh + + # run PEcAn tests + - name: test + run: make -j1 test + - name: check for out-of-date files + uses: infotroph/tree-is-clean@v1 + + # ---------------------------------------------------------------------- + # R CHECK + # ---------------------------------------------------------------------- + check: + if: github.event_name != 'issue_comment' || startsWith(github.event.comment.body, '/build') + runs-on: ubuntu-latest + + strategy: + fail-fast: false + matrix: + R: + - "4.0.3" + - "4.0.4" + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + _R_CHECK_LENGTH_1_CONDITION_: true + _R_CHECK_LENGTH_1_LOGIC2_: true + # Avoid compilation check warnings that come from the system Makevars + # See https://stat.ethz.ch/pipermail/r-package-devel/2019q2/003898.html + _R_CHECK_COMPILATION_FLAGS_KNOWN_: -Wformat -Werror=format-security -Wdate-time + # Keep R checks from trying to consult the very flaky worldclockapi.com + _R_CHECK_SYSTEM_CLOCK_: 0 + + container: + image: pecan/depends:R${{ matrix.R }} + + steps: + # checkout source code + - uses: actions/checkout@v2 + + # install additional tools needed + - name: install utils + run: apt-get update && apt-get install -y postgresql-client qpdf + - name: install new dependencies + run: Rscript scripts/generate_dependencies.R && Rscript docker/depends/pecan.depends.R + # need processx > 3.5.2 to avoid cryptic errors from + # https://github.com/r-lib/rcmdcheck/issues/140 + # Remove when https://github.com/r-lib/processx/pull/299 reaches CRAN + - name: update processx + run: Rscript -e 'devtools::install_github("r-lib/processx")' + + # run PEcAn checks + - name: check + run: make -j1 check + env: + REBUILD_DOCS: "FALSE" + RUN_TESTS: "FALSE" + - name: check for out-of-date files + uses: infotroph/tree-is-clean@v1 + + + # ---------------------------------------------------------------------- + # SIPNET TESTS + # ---------------------------------------------------------------------- + sipnet: + if: github.event_name != 'issue_comment' || startsWith(github.event.comment.body, '/build') + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + strategy: + fail-fast: false + matrix: + R: + - "4.0.3" + - "4.0.4" + + services: + postgres: + image: mdillon/postgis:9.5 + options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5 + + container: + image: pecan/depends:R${{ matrix.R }} + + steps: + # checkout source code + - uses: actions/checkout@v2 + + # install additional tools needed + - name: install utils + run: apt-get update && apt-get install -y postgresql-client qpdf + - name: install new dependencies + run: Rscript scripts/generate_dependencies.R && Rscript docker/depends/pecan.depends.R + + # initialize database + - name: db setup + uses: docker://pecan/db:ci + - name: add models to db + run: ./scripts/add.models.sh + + # install sipnet + - name: Check out SIPNET + uses: actions/checkout@v2 + with: + repository: PecanProject/sipnet + path: sipnet + - name: install sipnet + run: | + cd ${GITHUB_WORKSPACE}/sipnet + make + + # compile PEcAn code + - name: build + run: make -j1 + + # run SIPNET test + - name: integration test + run: ./tests/integration.sh ghaction diff --git a/.github/workflows/depends.yml b/.github/workflows/depends.yml new file mode 100644 index 00000000000..6e06e33962b --- /dev/null +++ b/.github/workflows/depends.yml @@ -0,0 +1,76 @@ +name: Docker Depends Image + +on: + push: + branches: + - develop + - master + + # this runs on the develop branch + schedule: + - cron: '0 0 * * *' + +env: + # official supported version of R + SUPPORTED: 4.0.3 + DOCKERHUB_ORG: pecan + +jobs: + depends: + if: github.repository == 'PecanProject/pecan' + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + strategy: + fail-fast: false + matrix: + R: + - "4.0.3" + - "4.0.4" + + steps: + - uses: actions/checkout@v2 + + # calculate some variables that are used later + - name: github branch + run: | + BRANCH=${GITHUB_REF##*/} + echo "GITHUB_BRANCH=${BRANCH}" >> $GITHUB_ENV + + tags="R${{ matrix.R }}" + if [ "${{ matrix.R }}" == "${{ env.SUPPORTED }}" ]; then + if [ "$BRANCH" == "master" ]; then + tags="${tags},latest" + elif [ "$BRANCH" == "develop" ]; then + tags="${tags},develop" + fi + fi + echo "TAG=${tags}" >> $GITHUB_ENV + + # this will publish to the actor (person) github packages + - name: Publish to GitHub + uses: elgohr/Publish-Docker-Github-Action@2.22 + env: + R_VERSION: ${{ matrix.R }} + with: + name: ${{ github.repository_owner }}/pecan/depends + username: ${{ github.actor }} + password: ${{ secrets.GITHUB_TOKEN }} + context: docker/depends + tags: "${{ env.TAG }}" + registry: docker.pkg.github.com + buildargs: R_VERSION + + # this will publish to the clowder dockerhub repo + - name: Publish to Docker Hub + uses: elgohr/Publish-Docker-Github-Action@2.18 + env: + R_VERSION: ${{ matrix.R }} + with: + name: ${{ env.DOCKERHUB_ORG }}/depends + username: ${{ secrets.DOCKERHUB_USERNAME }} + password: ${{ secrets.DOCKERHUB_PASSWORD }} + context: docker/depends + tags: "${{ env.TAG }}" + buildargs: R_VERSION diff --git a/.github/workflows/docker.yml b/.github/workflows/docker.yml new file mode 100644 index 00000000000..b9c5f9a38b0 --- /dev/null +++ b/.github/workflows/docker.yml @@ -0,0 +1,105 @@ +name: Docker + +# initially we would us on: [release] as well, the problem is that +# the code in clowder would not know what branch the code is in, +# and would not set the right version flags. + +# This will run when: +# - when new code is pushed to master/develop to push the tags +# latest and develop +# - when a pull request is created and updated to make sure the +# Dockerfile is still valid. +# To be able to push to dockerhub, this execpts the following +# secrets to be set in the project: +# - DOCKERHUB_USERNAME : username that can push to the org +# - DOCKERHUB_PASSWORD : password asscoaited with the username +on: + push: + branches: + - master + - develop + + pull_request: + + issue_comment: + types: + - created + +# Certain actions will only run when this is the master repo. +env: + MASTER_REPO: PecanProject/pecan + DOCKERHUB_ORG: pecan + +jobs: + docker: + if: github.event_name != 'issue_comment' || startsWith(github.event.comment.body, '/build') + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v2 + + # calculate some variables that are used later + - name: get version tag + run: | + BRANCH=${GITHUB_REF##*/} + echo "GITHUB_BRANCH=${BRANCH}" >> $GITHUB_ENV + if [ "$BRANCH" == "master" ]; then + version="$(awk '/Version:/ { print $2 }' base/all/DESCRIPTION)" + tags="latest" + oldversion="" + while [ "${oldversion}" != "${version}" ]; do + oldversion="${version}" + tags="${tags},${version}" + version=${version%.*} + done + echo "PECAN_VERSION=$(awk '/Version:/ { print $2 }' base/all/DESCRIPTION)" >> $GITHUB_ENV + echo "PECAN_TAGS=${tags}" >> $GITHUB_ENV + elif [ "$BRANCH" == "develop" ]; then + echo "PECAN_VERSION=develop" >> $GITHUB_ENV + echo "PECAN_TAGS=develop" >> $GITHUB_ENV + else + echo "PECAN_VERSION=develop" >> $GITHUB_ENV + echo "PECAN_TAGS=develop" >> $GITHUB_ENV + fi + + # use shell script to build, there is some complexity in this + - name: create images + run: ./docker.sh -i github + env: + PECAN_GIT_CHECKSUM: ${{ github.sha }} + PECAN_GIT_BRANCH: ${GITHUB_BRANCH} + VERSION: ${PECAN_VERSION} + + # push all images to github + - name: Publish to GitHub + if: github.event_name == 'push' && github.repository == env.MASTER_REPO + run: | + echo "${INPUT_PASSWORD}" | docker login -u ${INPUT_USERNAME} --password-stdin ${INPUT_REGISTRY} + repo=$(echo ${{ github.repository_owner }} | tr 'A-Z' 'a-z') + for image in $(docker image ls pecan/*:github --format "{{ .Repository }}"); do + for v in ${PECAN_TAGS}; do + docker tag ${image}:github ${INPUT_REGISTRY}/${repo}/${image#pecan/}:${v} + docker push ${INPUT_REGISTRY}/${repo}/${image#pecan/}:${v} + done + done + docker logout + env: + INPUT_REGISTRY: ghcr.io + INPUT_USERNAME: ${{ secrets.GHCR_USERNAME }} + INPUT_PASSWORD: ${{ secrets.GHCR_PASSWORD }} + + # push all images to dockerhub + - name: Publish to DockerHub + if: github.event_name == 'push' && github.repository == env.MASTER_REPO + run: | + echo "${INPUT_PASSWORD}" | docker login -u ${INPUT_USERNAME} --password-stdin + for image in $(docker image ls pecan/*:github --format "{{ .Repository }}"); do + for v in ${PECAN_TAGS}; do + docker tag ${image}:github ${{ env.DOCKERHUB_ORG }}/${image#pecan/}:${v} + docker push ${{ env.DOCKERHUB_ORG }}/${image#pecan/}:${v} + done + done + docker logout + env: + INPUT_USERNAME: ${{ secrets.DOCKERHUB_USERNAME }} + INPUT_PASSWORD: ${{ secrets.DOCKERHUB_PASSWORD }} diff --git a/.github/workflows/stale.yml b/.github/workflows/stale.yml new file mode 100644 index 00000000000..67c3898ff50 --- /dev/null +++ b/.github/workflows/stale.yml @@ -0,0 +1,23 @@ +name: Mark stale issues and pull requests + +on: + schedule: + - cron: "0 0 * * *" + +jobs: + stale: + if: github.repository == 'PecanProject/pecan' + + runs-on: ubuntu-latest + + steps: + - uses: actions/stale@v1 + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} + stale-issue-message: 'This issue is stale because it has been open 365 days with no activity.' + stale-pr-message: 'This PR is stale because it has been open 365 days with no activity.' + stale-issue-label: 'Status: Stale' + stale-pr-label: 'Status: Stale' + days-before-stale: 365 + days-before-close: 100000 + operations-per-run: 25 diff --git a/.github/workflows/styler-actions.yml b/.github/workflows/styler-actions.yml new file mode 100644 index 00000000000..e47fcd89d9e --- /dev/null +++ b/.github/workflows/styler-actions.yml @@ -0,0 +1,81 @@ +on: + issue_comment: + types: [created] +name: Commands +jobs: + style: + if: startsWith(github.event.comment.body, '/style') + name: style + runs-on: macOS-latest + steps: + - id: file_changes + uses: trilom/file-changes-action@v1.2.4 + - name: list changed files + run: echo '${{ steps.file_changes.outputs.files_modified }}' + - uses: actions/checkout@v2 + - uses: r-lib/actions/pr-fetch@master + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} + - uses: r-lib/actions/setup-r@master + - name: Install styler + run: | + Rscript -e 'install.packages("styler")' + - name: run styler + shell: bash + env: + FILES: ${{ join(fromJSON(steps.file_changes.outputs.files_modified), ' ') }} + run: | + for f in ${FILES}; do + if [[ "$f" == *.R || "$f" == *.Rmd ]] + then Rscript -e 'styler::style_file("'${f}'")' + fi + done + - name: commit + run: | + git add \*.R + git add \*.Rmd + if [ "$(git diff --name-only --cached)" != "" ]; then git commit -m 'automated syle update' ; fi + - uses: r-lib/actions/pr-push@master + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} + + + document: + if: (startsWith(github.event.comment.body, '/style') || startsWith(github.event.comment.body, '/document')) + runs-on: ubuntu-latest + container: pecan/depends:develop + steps: + - uses: actions/checkout@v2 + - uses: r-lib/actions/pr-fetch@v1 + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} + - name: update dependency lists + run: Rscript scripts/generate_dependencies.R + - name: install any new dependencies + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + run: Rscript docker/depends/pecan.depends.R + - id: file_changes + uses: trilom/file-changes-action@v1.2.4 + - name : make + shell: bash + env: + FILES: ${{ join(fromJSON(steps.file_changes.outputs.files_modified), ' ') }} + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + run: | + echo ${FILES} \ + | tr ' ' '\n' \ + | grep -e base -e models -e modules \ + | cut -d / -f 1-2 \ + | sort \ + | uniq \ + | xargs -n1 -I{} make .doc/{} + - name: commit + run: | + git config --global user.email "pecan_bot@example.com" + git config --global user.name "PEcAn stylebot" + git add \*.Rd \*NAMESPACE Makefile.depends docker/depends/pecan.depends.R + if [ "$(git diff --name-only --cached)" != "" ]; then git commit -m 'automated documentation update' ; fi + - uses: r-lib/actions/pr-push@master + with: + repo-token: ${{ secrets.GITHUB_TOKEN }} diff --git a/.gitignore b/.gitignore index 2942f835440..1e523cbe68f 100644 --- a/.gitignore +++ b/.gitignore @@ -96,3 +96,6 @@ docker-compose.override.yml # dont check in modellauncher binaries contrib/modellauncher/modellauncher + +# don't checkin renv +/renv/ diff --git a/.prettierignore b/.prettierignore new file mode 100644 index 00000000000..d331b786fcb --- /dev/null +++ b/.prettierignore @@ -0,0 +1,22 @@ +**/leaflet/** +**/sugarcane/** +**/vignettes/** +*min.js +*min.css +*png +*eps +*pdf +*ai +*svg +*map +*sh +*yml +*json +*md +*bak +*txt +*gif +*pegjs +*.template +*.ejs +.prettierignore \ No newline at end of file diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 40be8d2e6b2..00000000000 --- a/.travis.yml +++ /dev/null @@ -1,116 +0,0 @@ -# Follow instructions on: -# https://blog.rstudio.org/2016/03/09/r-on-travis-ci/ - -language: r -r: - - release - - devel - - oldrel - -dist: xenial -sudo: required - -env: - global: - # TODO: `make -j2` interleaves output lines from simultaneous processes. - # Would be nice to fix by adding `-Otarget`, but not supported in Make 3.x. - # When Travis updates, check for Make 4 and add -O if available. - - MAKEFLAGS="-j2" - - PGHOST=localhost - - RGL_USE_NULL=TRUE # Keeps RGL from complaining it can't find X11 - -matrix: - fast_finish: true - allow_failures: - - r: devel - - r: oldrel - -cache: - - directories: - - .install - - .check - - .test - - .doc - - packages - -addons: - apt: - sources: - - sourceline: 'ppa:ubuntugis/ppa' # for GDAL 2 binaries - packages: - - bc - - curl - - gdal-bin - - jags - - libcurl4-openssl-dev - - libgdal-dev - - libgl1-mesa-dev - - libglu1-mesa-dev - - libgmp-dev - - libhdf5-dev - - liblapack-dev - - libnetcdf-dev - - libproj-dev - - libudunits2-dev - - netcdf-bin - - pandoc - - python-dev - - tcl - - tcl-dev - - udunits-bin - # R package binaries from c2d4u - - r-bioc-biocinstaller - - r-cran-ape - - r-cran-curl - - r-cran-data.table - - r-cran-devtools - - r-cran-dplyr - - r-cran-gap - - r-cran-ggplot2 - - r-cran-httr - - r-cran-igraph - - r-cran-lme4 - - r-cran-matrixstats - - r-cran-mcmcpack - - r-cran-raster - - r-cran-rcpp - - r-cran-rcurl - - r-cran-redland - - r-cran-rjags - - r-cran-rncl - - r-cran-roxygen2 - - r-cran-rsqlite - # - r-cran-sf - - r-cran-shiny - - r-cran-sirt - - r-cran-testthat - - r-cran-tidyverse - - r-cran-xml - - r-cran-xml2 - - r-cran-xts - - -## notifications should go to slack -notifications: - slack: - # Slack token created by Chris Black, 2018-02-17 - secure: "DHHSNmiCf71SLa/FFSqx9oOnJjJt2GHYk7NsFIBb9ZY10RvQtIPfaoNxkPjqu9HLyZWJSFtg/uNKKplEHc6W80NoXyqoTvwOxTPjMaViXaCNqsmzjjR/JaCWT/oWGXyAw0VX3S8cwuIexlKQGgZwJpIzoVOZqUrDrHI/O17kZoM=" - email: - on_success: always - on_failure: always - -## list of services to be running -services: - - docker - -install: - - scripts/travis/install.sh - -before_script: - - scripts/travis/before_script.sh - -script: - - scripts/travis/script.sh - -after_script: - - scripts/travis/after_script.sh diff --git a/CHANGELOG.md b/CHANGELOG.md index 26f0adb40a8..e0ae7dab4b9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,110 @@ section for the next release. For more information about this file see also [Keep a Changelog](http://keepachangelog.com/) . +## [1.7.2] - 2021-10-04 + +### Due to dependencies, PEcAn is now using R 4.0.3 for Docker images. + +This is a major change: + +- Newer version of R +- Ubuntu 20.04 instead of Debian. + +### Fixed + +- Removed sender.py and now allow the submission of workflows from inside the rstudio container. +- Use TRAEFIK_FRONTEND_RULE in compose file and TRAEFIK_HOST in env.example, using TRAEFIK_HOST everywhere now. Make sure TRAEFIK_HOST is used in .env +- Use initial biomass pools for Sorghum and Setaria #2495, #2496 +- PEcAn.DB::betyConnect() is now smarter, and will try to use either config.php or environment variables to create a connection. It has switched to use db.open helper function (#2632). +- PEcAn.utils::tranformstats() assumed the statistic names column of its input was a factor. It now accepts character too, and returns the same class given as input (#2545). +- fixed and added tests for `get.rh` function in PEcAn.data.atmosphere +- Invalid .zenodo.json that broke automatic archiving on Zenodo ([b56ef53](https://github.com/PecanProject/pecan/commit/b56ef53888d73904c893b9e8c8cfaeedd7b1edbe)) +- Fixed a filehandle leak in multi-year runs of PEcAn.BIOCRO::met2model.BIOCRO: It was only closing the last input file it processed (#2485). +- Fix issue with cruncep download: use netcdf subset (ncss) method instead of opendap (#2424). +- The `parse` option to `PEcAn.utils::read_web_config` had no effect when `expand` was TRUE (#2421). +- Fixed a typo that made `PEcAn.DB::symmetric_setdiff` falsely report no differences (#2428). +- sipnet2netcdf will now only extract the data for the year requested (#2187) +- Fixed Priors vignette (#2439). +- When building sipnet model would not set correct model version +- Update pecan/depends docker image to have latest Roxygen and devtools. +- Update ED docker build, will now build version 2.2.0 and git +- Do not override meta-analysis settings random-effects = FALSE https://github.com/PecanProject/pecan/pull/2625 +- model2netcdf.ED2 no longer detecting which varibles names `-T-` files have based on ED2 version (#2623) +- Changed docker-compose.yml to use user & group IDs of the operating system user (#2572) +- gSSURGO file download now added as inputs into BETY through extract_soil_gssurgo (#2666) +- ensure Tleaf converted to K for temperature corrections in PEcAn.photosynthesis::fitA (#2726) +- fix bug in summarize.result to output stat, which is needed to turn on RE in the meta-analysis (#2753) +- ensure that control treatments always receives the random effect index of 1; rename madata.Rdata to jagged.data.Rdata and include database ids and names useful for calculating parameter estimates by treatment (#2756) +- ensure that existing meta-analysis results can be used for pfts with cultivars (#2761) +- Major code cleanup by GSoC student @moki1202, fixing many check warnings across 10 packages + (#2771, #2773, #2774, #2775, #2805, #2815, #2826, #2830, #2857) + +### Changed + +- Removed deprecated mstmip_vars and mstmip_local; now all functions use the combined standard_vars.csv +- RabbitMQ is set to be 3.8 since the 3.9 version can no longer be configured with environment variables. +- Removed old api, now split into rpecanapi and apps/api. +- Replaced `tmvtnorm` package with `TruncatedNormal` package for speed up per #2621. +- Continuous integration changes: Added experimental GitHub Actions CI builds (#2544), streamlined Travis CI builds, added a fourth R version (second-newest old release; currently R 3.5) to Travis test matrix (#2592). +- Functions that update database entries no longer pass `created_at` or `updated_at` timestamps. The database now updates these itself and ensures they are consistently in UTC (#1083). +- `PEcAn.DB::insert_table` now uses `DBI::dbAppendTable` internally instead of manually constructed SQL (#2552). +- Rebuilt documentation using Roxygen 7. Readers get nicer formatting of usage sections, writers get more flexible behavior when inheriting parameters and less hassle when maintaining namespaces (#2524). +- Renamed functions that looked like S3 methods but were not: + * PEcAn.priors: `plot.posterior.density`->`plot_posterior.density`, `plot.prior.density`->`plot_prior.density`, `plot.trait`->`plot_trait` (#2439). + * PEcAn.visualization: `plot.netcdf`->`plot_netcdf` (#2526). + * PEcAn.assim.sequential: `Remote.Sync.launcher` -> `Remote_Sync_launcher` (#2652) +- Stricter package checking: `make check` and CI builds will now fail if `R CMD check` returns any ERRORs or any "newly-added" WARNINGs or NOTEs. "Newly-added" is determined by strict string comparison against a check result saved 2019-09-03; messages that exist in the reference result do not break the build but will be fixed as time allows in future refactorings (#2404). +- No longer writing an arbitrary num for each PFT, this was breaking ED runs potentially. +- The pecan/data container has no longer hardcoded path for postgres +- PEcAn.JULES: Removed dependency on `ncdf4.helpers` package, which has been removed from CRAN (#2511). +- data.remote: Arguments to the function `call_MODIS()` have been changed (issue #2519). +- Changed precipitaion downscale in `PEcAn.data.atmosphere::download.NOAA_GEFS_downscale`. Precipitation was being downscaled via a spline which was causing fake rain events. Instead the 6 hr precipitation flux values from GEFS are preserved with 0's filling in the hours between. +- Changed `dbfile.input.insert` to work with inputs (i.e soils) that don't have start and end dates associated with them +- Default behavior for `stop_on_error` is now `TRUE` for non-ensemble runs; i.e., workflows that run only one model simulation (or omit the `ensemble` XML group altogether) will fail if the model run fails. For ensemble runs, the old behavior is preserved; i.e., workflows will continue even if one of the model runs failed. This behavior can also be manually controlled by setting the new `run -> stop_on_error` XML tag to `TRUE` or `FALSE`. +- Several functions have been moved out of `PEcAn.utils` into other packages (#2830, #2857): + * `ensemble.filename`, `get.results`, `runModule.get.results`, `read.sa.output`, `sensitivity.filename`, + and `write.sa.configs` have been moved to `PEcAn.uncertainty`. + * `create.base.plot`, `dhist`, `plot_data` and `theme_border` have been moved to `PEcAn.visualizaton`. + +### Added + +- BioCro can export Aboveground Biomass (#2790) +- Functionality for generating the same ensemble parameter sets with randtoolbox functions. +- Functionality for joint sampling from the posteriors using randtoolbox functions. +- BASGRA-SDA couplers. +- Now creates docker images during a PR, when merged it will push them to docker hub and github packages +- New functionality to the PEcAn API to GET information about PFTs, formats & sites, submit workflows in XML or JSON formats & download relevant inputs/outputs/files related to runs & workflows (#2674 #2665 #2662 #2655) +- Functions to send/receive messages to/from rabbitmq. +- Documentation in [DEV-INTRO.md](DEV-INTRO.md) on development in a docker environment (#2553) +- PEcAn API that can be used to talk to PEcAn servers. Endpoints to GET the details about the server that user is talking to, PEcAn models, workflows & runs. Authetication enabled. (#2631) +- New versioned ED2IN template: ED2IN.2.2.0 (#2143) (replaces ED2IN.git) +- model_info.json and Dockerfile to template (#2567) +- Dockerize BASGRA_N model. +- Basic coupling for models BASGRA_N and STICS. +- PEcAn.priors now exports functions `priorfig` and `plot_densities` (#2439). +- Models monitoring container for Docker now shows a webpage with models it has seen +- Added small container to check if certain services are up, used as initi container for kubernetes +- Documentation how to run ED using singularity +- PEcAn.DB gains new function `get_postgres_envvars`, which tries to look up connection parameters from Postgres environment variables (if they are set) and return them as a list ready to be passed to `db.open`. It should be especially useful when writing tests that need to run on systems with many different database configurations (#2541). +- New shiny application to show database synchronization status (shiny/dbsync) +- Ability to run with [MERRA-2 meteorology](https://gmao.gsfc.nasa.gov/reanalysis/MERRA-2/) (reanalysis product based on GEOS-5 model) +- Ability to run with ICOS Ecosystem products + +### Removed + +- Removed travis integration +- Removed the sugarcane and db folders from web, this removes the simple DB editor in the web folder. (#2532) +- Removed ED2IN.git (#2599) 'definitely going to break things for people' - but they can still use PEcAn <=1.7.1 +- Database maintenance scripts `vacuum.bety.sh` and `reindex.bety.sh` have been moved to the [BeTY database repository](https://github.com/PecanProject/bety) (#2563). +- Scripts `dump.pgsql.sh` and `dump.mysql.sh` have been deleted. See the ["BeTY database administration"](https://pecanproject.github.io/pecan-documentation/develop/database.html) chapter of the PEcAn documentation for current recommendations (#2563). +- Old dependency management scripts `check.dependencies.sh`, `update.dependencies.sh`, and `install_deps.R` have been deleted. Use `generate_dependencies.R` and the automatic dependency handling built into `make install` instead (#2563). +- Deprecated copies of functions previously moved to other packages have been removed from `PEcAn.utils` (#2830): + * `do_conversions` and `runModule.run.write.configs`, `run.write.configs`. These are now in `PEcAn.workflow` + * `get.ensemble.samples`, `read.ensemble.output`, `write.ensemble.configs`. These are now in `PEcAn.uncertainty` + * `logger.debug`, `logger.error`, `logger.getLevel`, `logger.info`, `logger.setLevel`, + `logger.setOutputFile`, `logger.setQuitOnSevere`, `logger.setWidth`, `logger.severe`, `logger.warn`. + These are now in `PEcAn.logger` + ## [1.7.1] - 2018-09-12 ### Fixed diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 5a33606f509..34688f50491 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -12,7 +12,7 @@ New functionality is typically directed toward modules to provide a slimmer PEcA Generally, new model should be added to the models folder and new modules should be added to the modules folder. Exceptions include code that is reused in many models or modules and wrapper functions that call specific implementations in models; these can be placed in the core packages. -If you are unsure of whether your contribution should be implemented as a model, module or part of PEcAn Core, you may visit [Chat Room](https://join.slack.com/t/pecanproject/shared_invite/enQtMzkyODUyMjQyNTgzLTYyZTZiZWQ4NGE1YWU3YWIyMTVmZjEyYzA3OWJhYTZmOWQwMDkwZGU0Mjc4Nzk0NGYwYTIyM2RiZmMyNjg5MTE) or ask on the pecan-develop mailing list for advice. +If you are unsure of whether your contribution should be implemented as a model, module or part of PEcAn Core, you may visit [Chat Room](https://join.slack.com/t/pecanproject/shared_invite/enQtMzkyODUyMjQyNTgzLWEzOTM1ZjhmYWUxNzYwYzkxMWVlODAyZWQwYjliYzA0MDA0MjE4YmMyOTFhMjYyMjYzN2FjODE4N2Y4YWFhZmQ) or ask on the pecan-develop mailing list for advice. ## Creating Issues diff --git a/DEBUGING.md b/DEBUGING.md index 9401c70f5c7..b62f71558d6 100644 --- a/DEBUGING.md +++ b/DEBUGING.md @@ -8,15 +8,18 @@ with the development of PEcAn. # ---------------------------------------------------------------------- options(warn = 1, keep.source = TRUE, error = quote({ - status.end("ERROR") + # Need all these try() calls to make sure all wrapup steps are + # executed, even if some steps generate errors of their own + + try(status.end("ERROR")) + + try(db.print.connections()) + try(cat("Environment:\n", file=stderr())); - db.print.connections() - cat("Environment:\n", file=stderr()); - # TODO: setup option for dumping to a file (?) # Set `to.file` argument to write this to a file for post-mortem debugging - dump.frames(); # writes to last.dump - + try(dump.frames()); # writes to last.dump + # # Debugging in R # http://www.stats.uwo.ca/faculty/murdoch/software/debuggingR/index.shtml @@ -33,12 +36,12 @@ options(warn = 1, keep.source = TRUE, error = # geterrmessage # # Output based on the debugger function definition. - - n <- length(last.dump) - calls <- names(last.dump) - cat(paste(" ", 1L:n, ": ", calls, sep = ""), sep = "\n", file=stderr()) - cat("\n", file=stderr()) - + + try({ + n <- length(last.dump) + calls <- names(last.dump) + cat(paste(" ", 1L:n, ": ", calls, sep = ""), sep = "\n", file=stderr()) + cat("\n", file=stderr())}) if (!interactive()) { q() } diff --git a/DEV-INTRO.md b/DEV-INTRO.md index b1881ba44f4..b9aebd31222 100644 --- a/DEV-INTRO.md +++ b/DEV-INTRO.md @@ -1,59 +1,347 @@ -PEcAn Development -================= +# PEcAn Development -Directory Structure -------------------- +This is a minimal guide to getting started with PEcAn development under Docker. You can find more information about docker in the [pecan documentation](https://pecanproject.github.io/pecan-documentation/master/docker-index.html). -### pecan/ +## Requirements and Recommendations -* modules/ Contains the modules that make up PEcAn -* web/ The PEcAn web app to start a run and view outputs. -* models/ Code to create the model specific configurations. -* documentation/ Documentation about what PEcAn is and how to use it. +Docker is the primary software requirement; it handles all of the other software dependencies. This has been tested on Ubuntu 18.04 and above, MacOS Catalina, and Windows 10 with Windows Subsystem for Linux 2. -### Modules (R packages) +- Software (installation instructions below): + - Docker version 19 + - Docker-compose version 1.26 + - Git (optional until you want to make major changes) +- Hardware + - 100 GB storage (minimum 50 GB) + - 16 GB RAM (minimum 8 GB) -* General -** all -** utils -** db -* Analysis -** modules/meta.analysis -** modules/uncertainty" -** modules/data.land -** modules/data.atmosphere -** modules/assim.batch -** modules/assim.sequential -** modules/priors -* Model Interfaces -** models/ed -** models/sipnet -** models/biocro +## Git Repository and Workflow +We recommend following the the [gitflow](https://nvie.com/posts/a-successful-git-branching-model/) workflow and working in your own [fork of the PEcAn repsitory](https://help.github.com/en/github/getting-started-with-github/fork-a-repo). See the [PEcAn developer guide](book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/01_using-git.Rmd) for further details. In the `/scripts` folder there is a script called [syncgit.sh](scripts/syncgit.sh) that will help with synchronizing your fork with the official repository. -#### List of modules +To clone the PEcAn repository: -Installing PEcAn ----------------- +```sh +git clone git@github.com:pecanproject/pecan +cd pecan +# alternatively, if you haven't set up ssh keys with GitHub +# git clone https://github.com/PecanProject/pecan +``` + +## Developing in Docker + +The use of Docker in PEcAn is described in detail in the [PEcAn documentation](https://pecanproject.github.io/pecan-documentation/master/docker-index.html). This is intended as a quick start. + +### Installing Docker + +To install Docker and docker-compose, see the docker documentation: +- Docker Desktop in [Mac OSX](https://docs.docker.com/docker-for-mac/install/) or [Windows](https://docs.docker.com/docker-for-windows/install/) +- Docker (e.g. [Ubuntu](https://docs.docker.com/compose/install/)) and [docker-compose](https://docs.docker.com/compose/install/) on your linux operating system. + +_Note for Linux users:_ add your user to the docker group. This will prevent you from having to use `sudo` to start the docker containers, and makes sure that any file that is written to a mounted volume is owned by you. This can be done using +```sh +# for linux users +sudo adduser ${USER} docker`. +``` + +### Deploying PEcAn in Docker + +To get started with development in docker we need to bring up the docker stack first. In the main pecan folder you will find the [docker-compose.yml](docker-compose.yml) file that can be used to bring up the pecan stack. There is also the [docker-compose.dev.yaml](docker-compose.dev.yaml) file that adds additional containers, and changes some services to make it easier for development. + +By default docker-compose will use the files `docker-compose.yml` and `docker-compose.override.yml`. We will use the default `docker-compose.yml` file from PEcAn. The `docker-compose.override.yml` file can be used to configure it for your specific environment, in our case we will use it to setup the docker environment for development. Copy the `docker-compose.dev.yml` file to `docker-compose.override.yml` to start working with your own override file, i.e. : + +For Linux/MacOSX + +``` +cp docker-compose.dev.yml docker-compose.override.yml +``` + +For Windows + +``` +copy docker-compose.dev.yml docker-compose.override.yml +``` + +You can now use the command `docker-compose` to work with the containers setup for development. **The rest of this document assumes you have done this step.** + +### First time setup + +The steps in this section only need to be done the first time you start working with the stack in docker. After this is done you can skip these steps. You can find more detail about the docker commands in the [pecan documentation](https://pecanproject.github.io/pecan-documentation/master/docker-index.html). + +* setup .env file +* create folders to hold the data +* load the postgresql database +* load some test data +* copy all R packages (optional but recommended) +* setup for web folder development (optional) + +#### .env file + +You can copy the [`docker/env.example`](docker/env.example) file as .env in your pecan folder. The variables we want to modify are: + +For Linux/MacOSX + +```sh +cp docker/env.example .env +``` + +For Windows + +``` +copy docker/env.example .env +``` + +* `COMPOSE_PROJECT_NAME` set this to pecan, the prefix for all containers +* `PECAN_VERSION` set this to develop, the docker image we start with + +Both of these variables should also be uncommented by removing the # preceding them. At the end you should see the following if you run the following command `egrep -v '^(#|$)' .env`. If you have a windows system, you will need to set the variable PWD as well, and for linux you will need to set UID and GID (for rstudio). + +For Linux + +``` +echo "COMPOSE_PROJECT_NAME=pecan" >> .env +echo "PECAN_VERSION=develop" >> .env +echo "UID=$(id -u)" >> .env +echo "GID=$(id -g)" >> .env +``` + +For MacOSX + +``` +echo "COMPOSE_PROJECT_NAME=pecan" >> .env +echo "PECAN_VERSION=develop" >> .env +``` + +For Windows: + +``` +echo "COMPOSE_PROJECT_NAME=pecan" >> .env +echo "PECAN_VERSION=develop" >> .env +echo "PWD=%CD%" >> .env +``` + +Once you have setup `docker-compose.override.yml` and the `.env` files, it is time to pull all docker images that will be used. Doing this will make sure you have the latest version of those images on your local system. + +``` +docker-compose pull +``` -### Virtual Machine +#### folders (optional) -* Fastest way to get started -* see PEcAn demo ... +The goal of the development is to share the development folder with your container, whilst minimizing the latency. What this will do is setup the folders to allow for your pecan folder to be shared, and keep the rest of the folders managed by docker. Some of this is based on a presentation done during [DockerCon 2020](https://docker.events.cube365.net/docker/dockercon/content/Videos/92BAM7vob5uQ2spZf). In this talk it is recommended to keep the database on the filesystem managed by docker, as well as any other folders that are not directly modified on the host system (not using the docker managed volumes could lead to a large speed loss when reading/writing to the disk). The `docker-compose.override.yml` can be modified to copy all the data to the local filesystem, you will need to comment out the appropriate blocks. If you are sharing more than the pecan home directory you will need to make sure that these folder exist. As from the video, it is recommended to keep these folders outside of the actual pecan folder to allow for better caching capabilities of the docker system. -### Installing from source +If you have commented out the volumes in `docker-compose.override.yml` you will need to create the folders. Assuming you have not modified the values, you can do this with: -#### From GitHub +``` +mkdir -p $HOME/volumes/pecan/{lib,pecan,portainer,postgres,rabbitmq,traefik} +``` + + +The following volumes are specified: + +- **pecan_home** : is the checked out folder of PEcAn. This is shared with the executor and rstudio container allowing you to share and compile PEcAn. (defaults to current folder) +- **pecan_web** : is the checked out web folder of PEcAn. This is shared with the web container allowing you to share and modify the PEcAn web app. (defaults to web folder in the current folder) +- **pecan_lib** : holds all the R packages for the specific version of PEcAn and R. This folder will be shared amongst all other containers, and will contain the compiled PEcAn code. (defaults to managed by docker, or $HOME/volumes/pecan/lib) +- **pecan** this holds all the data, such as workflows and any downloaded data. (defaults to managed by docker, or $HOME/volumes/pecan/pecan) +- **traefik** holds persisent data for the web proxy, that directs incoming traffic to the correct container. (defaults to managed by docker, or $HOME/volumes/pecan/traefik) +- **postgres** holds the actual database data. If you want to backup the database, you can stop the postgres container, zip up the folder. (defaults to managed by docker, or $HOME/volumes/pecan/postgres) +- **rabbitmq** holds persistent information of the message broker (rabbitmq). (defaults to managed by docker, or $HOME/volumes/pecan/rabbitmq) +- **portainer** if you enabled the portainer service this folder is used to hold persistent data for this service. You will need to enable this service. (defaults to managed by docker, or $HOME/volumes/pecan/portainer) + +These folders will hold all the persistent data for each of the respective containers and can grow. For example the postgres database is multiple GB. The pecan folder will hold all data produced by the workflows, including any downloaded data, and can grow to many giga bytes. + +#### Postgresql database + +First we bring up postgresql (we will start RabbitMQ as well since it takes some time to start): ``` -library(devtools) -install_github("pecan", "PEcAnProject") +docker-compose up -d postgres rabbitmq ``` -#### "Makefile" +This will start postgresql and rabbitmq. We need to wait for a few minutes (you can look at the logs using `docker-compose logs postgres`) to see if it is ready. +Once the database has finished starting up we will initialize the database. Now you can load the database using the following commands. The first command will make sure we have the latest version of the image, the second command will actually load the information into the database. + +``` +docker pull pecan/db +docker run --rm --network pecan_pecan pecan/db ``` -./scripts/build.sh -install # installs all R packages -./scripts/build.sh -h # list other options -``` \ No newline at end of file + +Once that is done we create two users for BETY, first user is the guest user that you can use to login in the BETY interface. The second user is a user with admin rights. + +``` +docker-compose run --rm bety user guestuser guestuser "Guest User" guestuser@example.com 4 4 +docker-compose run --rm bety user carya illinois "Carya Demo User" carya@example.com 1 1 +``` + +#### Load example data + +Once the database is loaded we can add some example data, some of the example runs and runs for the ED model, assume some of this data is available. This can take some time, but all the data needed will be copied to the `/data` folder in the pecan containers. As with the database we first pull the latest version of the image, and then execute the image to copy all the data: + +``` +docker pull pecan/data:develop +docker run -ti --rm --network pecan_pecan --volume pecan_pecan:/data --env FQDN=docker pecan/data:develop +``` + +Linux & Mac + +```bash +# Change ownership of /data directory in pecan volume to the current user +docker run -ti --rm --network pecan_pecan --volume pecan_pecan:/data pecan/data:develop chown -R "$(id -u).$(id -g)" /data + +docker run -ti --user="$(id -u)" --rm --network pecan_pecan --volume pecan_pecan:/data --env FQDN=docker pecan/data:develop +``` + +#### Copy R packages (optional but recommended) + +Next copy the R packages from a container to volume `pecan_lib`. This is not really needed, but will speed up the process of the first compilation. Later we will put our newly compiled code here as well. This folder is shared with all PEcAn containers, allowing you to compile the code in one place, and have the compiled code available in all other containers. For example modify the code for a model, allows you to compile the code in rstudio container, and see the results in the model container. + +You can copy all the data using the following command. This will copy all compiled packages to your local machine. + +``` +docker run -ti --rm -v pecan_lib:/rlib pecan/base:develop cp -a /usr/local/lib/R/site-library/. /rlib/ +``` + +#### Copy web config file (optional) + +If you want to use the web interface, you will need to: + +1. Uncomment the web section from the `docker-compose.override.yml` file. This section includes three lines at the top of the file, just under the `services` section. Uncomment the lines that start `web:`, ` volumes:`, and `- pecan_web:`. +2. Then copy the config.php from the docker/web folder. You can do this using + +For Linux/MacOSX + +``` +cp docker/web/config.docker.php web/config.php +``` + +For Windows + +``` +copy docker\web\config.docker.php web\config.php +``` + +### PEcAn Development + +To begin development we first have to bring up the full PEcAn stack. This assumes you have done once the steps above. You don't need to stop any running containers, you can use the following command to start all containers. At this point you have PEcAn running in docker. + +``` +docker-compose up -d +``` + +The current folder (most likely your clone of the git repository) is mounted in some containers as `/pecan`, and in the case of rstudio also in your home folder as `pecan`. You can see which containers exactly in `docker-compose.override.yml`. + +You can now modify the code on your local machine, or you can use [rstudio](http://localhost:8000) in the docker stack. Once you made changes to the code you can compile the code either in the terminal of rstudio (`cd pecan && make`) or using `./scripts/compile.sh` from your machine (latter is nothing more than a shell script that runs `docker-compose exec executor sh -c 'cd /pecan && make'`. + +The compiled code is written to `/usr/local/lib/R/site-library` which is mapped to `volumes/lib` on your machine. This same folder is mounted in many other containers, allowing you to share the same PEcAn modules in all containers. Now if you change a module, and compile all other containers will see and use this new version of your module. + +To compile the PEcAn code you can use the make command in either the rstudio container, or in the executor container. The script [`compile.sh`](sripts/compile.sh) will run make inside the executor container. + +### Workflow Submission + +You can submit your workflow either in the executor container or in rstudio container. For example to run the `docker.sipnet.xml` workflow located in the tests folder you can use: + +``` +docker-compose exec executor bash +# inside the container +cd /pecan/tests +R CMD ../web/workflow.R docker.sipnet.xml +``` + +A better way of doing this is developed as part of GSOC, in which case you can leverage of the restful interface defined, or using the new R PEcAn API package. + +# Directory Structure + +Following are the main folders inside the pecan repository. + +### base (R packages) + +These are the core packages of PEcAn. Most other packages will depend on the packages in this folder. + +### models (R packages) + +Each subfolder contains the required pieces to run the model in PEcAn + +### modules (R packages) + +Contains packages that either do analysis, or download and convert different data products. + +### web (PHP + javascript) + +The Pecan web application + +### shiny (R + shiny) + +Each subfolder is its own shiny application. + +### book_source (RMarkdown) + +The PEcAn documentation that is compiled and uploaded to the PEcAn webpage. + +### docker + +Some of the docker build files. The Dockerfiles for each model are placed in the models folder. + +### scripts + +Small scripts that are used as part of the development and installation of PEcAn. + +# Advanced Development Options + +## Reset all containers/database + +If you want to start from scratch and remove all old data, but keep your pecan checked out folder, you can remove the folders where you have written the data (see `folders` below). You will also need to remove any of the docker managed volumes. To see all volumes you can do `docker volume ls -q -f name=pecan`. If you are sure, you can either remove them one by one, or remove them all at once using the command below. **THIS DESTROYS ALL DATA IN DOCKER MANAGED VOLUMES.**. + +``` +docker volume rm $(docker volume ls -q -f name=pecan) +``` + +If you changed the docker-compose.override.yml file to point to a location on disk for some of the containers (instead of having them managed by docker) you will need to actually delete the data on your local disk, docker will NOT do this. + +## Reset the lib folder + +If you want to reset the pecan lib folder that is mounted across all machines, for example when there is a new version of PEcAn or a a new version of R, you will need to delete the volume pecan_lib, and repopulate it. To delete the volume use the following command, and then look at "copy R packages" to copy the data again. + +``` +docker-compose down +docker rm pecan_lib +``` + +## Linux and User permissions + +(On Mac OSX and Windows files should automatically be owned by the user running the docker-compose commands). + +If you use mounted folders, make sure that these folders are writable by the containers. Docker on Linux will try to preserve the file permissions. To do this it might be necessary for the folders to have rw permissions. This can be done by using `chmod 777 $HOME/volumes/pecan/{lib,pecan,portainer,postgres,rabbitmq,traefik}`. + +This will leverage of NFS to mount the file system in your local docker image, changing the files to owned by the user specified in the export file. Try to limit this to only your PEcAn folder since this will allow anybody on this system to get access to the exported folder as you! + +First install nfs server: + +``` +apt-get install nfs-kernel-server +``` + +Next export your home directory: + +``` +echo -e "$PWD\t127.0.0.1(rw,no_subtree_check,all_squash,anonuid=$(id -u),anongid=$(id -g))" | sudo tee -a /etc/exports +``` + +And export the filesystem. + +``` +sudo exportfs -va +``` + +At this point you have exported your home directory, only to your local machine. All files written to that exported filesystem will be owned by you (`id -u`) and your primary group (`id -g`). + +Finally we can modify the `docker-compose.override.yml` file to allow for writing files to your PEcAn folder as you: + +``` +volumes: + pecan_home: + driver_opts: + type: "nfs" + device: ":${PWD}" + o: "addr=127.0.0.1" +``` diff --git a/Makefile b/Makefile index dffd51f08af..0fd902f08f3 100644 --- a/Makefile +++ b/Makefile @@ -2,8 +2,8 @@ NCPUS ?= 1 BASE := logger utils db settings visualization qaqc remote workflow -MODELS := biocro clm45 dalec dvmdostem ed fates gday jules linkages \ - lpjguess maat maespa preles sipnet template +MODELS := basgra biocro clm45 dalec dvmdostem ed fates gday jules linkages \ + lpjguess maat maespa preles sipnet stics template MODULES := allometry assim.batch assim.sequential benchmark \ data.atmosphere data.hydrology data.land \ @@ -44,6 +44,45 @@ MODELS_D := $(MODELS:%=.doc/%) MODULES_D := $(MODULES:%=.doc/%) ALL_PKGS_D := $(BASE_D) $(MODULES_D) $(MODELS_D) +SETROPTIONS = "options(Ncpus = ${NCPUS})" + + +### Macros + +# Generates a list of all files and subdirectories at any depth inside its argument +recurse_dir = $(foreach d, $(wildcard $1*), $(call recurse_dir, $d/) $d) + +# Filters a list from recurse_dir to remove paths that are directories +# Caveat: Really only removes *direct parents* of other paths *in the list*: +# $(call drop_dirs,a a/b a/b/c) => 'a/b/c', +# but $(call drop_dirs,a a/b d d/e/f) => 'a/b d d/e/f' +# For output from recurse_dir this removes all dirs, but in other cases beware. +drop_parents = $(filter-out $(patsubst %/,%,$(dir $1)), $1) + +# Generates a list of regular files at any depth inside its argument +files_in_dir = $(call drop_parents, $(call recurse_dir, $1)) + +# HACK: assigning to `deps` is an ugly workaround for circular dependencies in utils pkg. +# When these are fixed, can go back to simple `dependencies = TRUE` +depends_R_pkg = ./scripts/time.sh "depends ${1}" Rscript -e ${SETROPTIONS} \ + -e "deps <- if (grepl('(base/utils|modules/benchmark)', '$(1)')) { c('Depends', 'Imports', 'LinkingTo') } else { TRUE }" \ + -e "devtools::install_deps('$(strip $(1))', dependencies = deps, upgrade=FALSE)" +install_R_pkg = ./scripts/time.sh "install ${1}" Rscript \ + -e ${SETROPTIONS} \ + -e "devtools::install('$(strip $(1))', upgrade=FALSE)" +check_R_pkg = ./scripts/time.sh "check ${1}" Rscript scripts/check_with_errors.R $(strip $(1)) +test_R_pkg = ./scripts/time.sh "test ${1}" Rscript \ + -e "devtools::test('$(strip $(1))'," \ + -e "stop_on_failure = TRUE," \ + -e "stop_on_warning = FALSE)" # TODO: Raise bar to stop_on_warning = TRUE when we can + +doc_R_pkg = ./scripts/time.sh "document ${1}" Rscript -e "devtools::document('"$(strip $(1))"')" + +depends = .doc/$(1) .install/$(1) .check/$(1) .test/$(1) + + +### Rules + .PHONY: all install check test document shiny all: install document @@ -54,7 +93,9 @@ check: $(ALL_PKGS_C) .check/base/all test: $(ALL_PKGS_T) .test/base/all shiny: $(SHINY_I) -depends = .doc/$(1) .install/$(1) .check/$(1) .test/$(1) +# Render the PEcAn bookdown documentation +book: + cd ./book_source && make build # Make the timestamp directories if they don't exist yet .doc .install .check .test .shiny_depends $(call depends,base) $(call depends,models) $(call depends,modules): @@ -80,54 +121,47 @@ include Makefile.depends clean: rm -rf .install .check .test .doc find modules/rtm/src \( -name \*.mod -o -name \*.o -o -name \*.so \) -delete + find models/basgra/src \( -name \*.mod -o -name \*.o -o -name \*.so \) -delete .install/devtools: | .install - + ./scripts/time.sh "${1}" Rscript -e "if(!requireNamespace('devtools', quietly = TRUE)) install.packages('devtools', repos = 'http://cran.rstudio.com', Ncpus = ${NCPUS})" + + ./scripts/time.sh "devtools ${1}" Rscript -e ${SETROPTIONS} -e "if(!requireNamespace('devtools', quietly = TRUE)) install.packages('devtools')" echo `date` > $@ .install/roxygen2: | .install - + ./scripts/time.sh "${1}" Rscript -e "if(!requireNamespace('roxygen2', quietly = TRUE)) install.packages('roxygen2', repos = 'http://cran.rstudio.com', Ncpus = ${NCPUS})" + + ./scripts/time.sh "roxygen2 ${1}" Rscript -e ${SETROPTIONS} -e "if(!requireNamespace('roxygen2', quietly = TRUE)) install.packages('roxygen2')" echo `date` > $@ .install/testthat: | .install - + ./scripts/time.sh "${1}" Rscript -e "if(!requireNamespace('testthat', quietly = TRUE)) install.packages('testthat', repos = 'http://cran.rstudio.com', Ncpus = ${NCPUS})" + + ./scripts/time.sh "testthat ${1}" Rscript -e ${SETROPTIONS} -e "if(!requireNamespace('testthat', quietly = TRUE)) install.packages('testthat')" echo `date` > $@ .install/mockery: | .install - + ./scripts/time.sh "${1}" Rscript -e "if(!requireNamespace('mockery', quietly = TRUE)) install.packages('mockery', repos = 'http://cran.rstudio.com', Ncpus = ${NCPUS})" + + ./scripts/time.sh "mockery ${1}" Rscript -e ${SETROPTIONS} -e "if(!requireNamespace('mockery', quietly = TRUE)) install.packages('mockery')" echo `date` > $@ -# HACK: assigning to `deps` is an ugly workaround for circular dependencies in utils pkg. -# When these are fixed, can go back to simple `dependencies = TRUE` -depends_R_pkg = ./scripts/time.sh "${1}" Rscript -e " \ - deps <- if (grepl('base/utils', '$(1)')) { c('Depends', 'Imports', 'LinkingTo') } else { TRUE }; \ - devtools::install_deps('$(strip $(1))', Ncpus = ${NCPUS}, dependencies = deps, upgrade=FALSE);" -install_R_pkg = ./scripts/time.sh "${1}" Rscript -e "devtools::install('$(strip $(1))', Ncpus = ${NCPUS}, upgrade=FALSE);" -check_R_pkg = ./scripts/time.sh "${1}" Rscript scripts/check_with_errors.R $(strip $(1)) -test_R_pkg = ./scripts/time.sh "${1}" Rscript -e "devtools::test('"$(strip $(1))"', stop_on_failure = TRUE, stop_on_warning = FALSE)" # TODO: Raise bar to stop_on_warning = TRUE when we can -doc_R_pkg = ./scripts/time.sh "${1}" Rscript -e "devtools::document('"$(strip $(1))"')" - $(ALL_PKGS_I) $(ALL_PKGS_C) $(ALL_PKGS_T) $(ALL_PKGS_D): | .install/devtools .install/roxygen2 .install/testthat .SECONDEXPANSION: -.doc/%: $$(wildcard %/**/*) $$(wildcard %/*) | $$(@D) +.doc/%: $$(call files_in_dir, %) | $$(@D) +ifeq ($(CI),) # skipped on CI because we start the run by bulk-installing all deps + $(call depends_R_pkg, $(subst .doc/,,$@)) +endif $(call doc_R_pkg, $(subst .doc/,,$@)) echo `date` > $@ -.install/%: $$(wildcard %/**/*) $$(wildcard %/*) .doc/% | $$(@D) +.install/%: $$(call files_in_dir, %) .doc/% | $$(@D) + $(call install_R_pkg, $(subst .install/,,$@)) echo `date` > $@ -.check/%: $$(wildcard %/**/*) $$(wildcard %/*) | $$(@D) +.check/%: $$(call files_in_dir, %) | $$(@D) + $(call check_R_pkg, $(subst .check/,,$@)) echo `date` > $@ -.test/%: $$(wildcard %/**/*) $$(wildcard %/*) | $$(@D) +.test/%: $$(call files_in_dir, %) | $$(@D) $(call test_R_pkg, $(subst .test/,,$@)) echo `date` > $@ # Install dependencies declared by Shiny apps -.shiny_depends/%: $$(wildcard %/**/*) $$(wildcard %/*) | $$(@D) +.shiny_depends/%: $$(call files_in_dir, %) | $$(@D) Rscript scripts/install_shiny_deps.R $(subst .shiny_depends/,shiny/,$@) echo `date` > $@ diff --git a/Makefile.depends b/Makefile.depends index e574d22a767..659c1c6a62b 100644 --- a/Makefile.depends +++ b/Makefile.depends @@ -2,32 +2,33 @@ $(call depends,base/all): | .install/base/db .install/base/settings .install/modules/meta.analysis .install/base/logger .install/base/utils .install/modules/uncertainty .install/modules/data.atmosphere .install/modules/data.land .install/modules/data.remote .install/modules/assim.batch .install/modules/emulator .install/modules/priors .install/modules/benchmark .install/base/remote .install/base/workflow .install/models/ed .install/models/sipnet .install/models/biocro .install/models/dalec .install/models/linkages .install/modules/allometry .install/modules/photosynthesis $(call depends,base/db): | .install/base/logger .install/base/remote .install/base/utils $(call depends,base/logger): | -$(call depends,base/qaqc): | .install/base/logger +$(call depends,base/qaqc): | .install/base/logger .install/models/biocro .install/models/ed .install/models/sipnet .install/base/utils $(call depends,base/remote): | .install/base/logger $(call depends,base/settings): | .install/base/db .install/base/logger .install/base/remote .install/base/utils -$(call depends,base/utils): | .install/base/logger .install/base/remote .install/modules/emulator +$(call depends,base/utils): | .install/base/logger .install/base/remote $(call depends,base/visualization): | .install/base/db .install/base/logger .install/base/utils $(call depends,base/workflow): | .install/modules/data.atmosphere .install/modules/data.land .install/base/db .install/base/logger .install/base/remote .install/base/settings .install/modules/uncertainty .install/base/utils $(call depends,modules/allometry): | .install/base/logger .install/base/db $(call depends,modules/assim.batch): | .install/modules/benchmark .install/base/db .install/modules/emulator .install/base/logger .install/modules/meta.analysis .install/base/remote .install/base/settings .install/modules/uncertainty .install/base/utils -$(call depends,modules/assim.sequential): | .install/base/logger .install/base/remote -$(call depends,modules/benchmark): | .install/modules/data.land .install/base/db .install/base/logger .install/base/remote .install/base/settings .install/base/utils +$(call depends,modules/assim.sequential): | .install/base/db .install/base/logger .install/base/remote .install/base/settings .install/base/utils .install/modules/benchmark +$(call depends,modules/benchmark): | .install/base/db .install/base/logger .install/base/remote .install/base/settings .install/base/utils .install/modules/data.land $(call depends,modules/data.atmosphere): | .install/base/db .install/base/logger .install/base/remote .install/base/utils $(call depends,modules/data.hydrology): | .install/base/logger .install/base/utils -$(call depends,modules/data.land): | .install/base/db .install/base/utils .install/base/logger .install/base/remote .install/base/settings -$(call depends,modules/data.remote): | .install/base/logger .install/base/remote +$(call depends,modules/data.land): | .install/modules/benchmark .install/modules/data.atmosphere .install/base/db .install/base/logger .install/base/remote .install/base/settings .install/base/utils .install/base/visualization +$(call depends,modules/data.remote): | .install/base/db .install/base/utils .install/base/logger .install/base/remote $(call depends,modules/emulator): | .install/base/logger -$(call depends,modules/meta.analysis): | .install/base/utils .install/base/db .install/base/logger .install/base/settings .install/modules/priors -$(call depends,modules/photosynthesis): | .install/base/logger -$(call depends,modules/priors): | .install/base/utils .install/base/logger +$(call depends,modules/meta.analysis): | .install/base/utils .install/base/db .install/base/logger .install/base/settings +$(call depends,modules/photosynthesis): | +$(call depends,modules/priors): | .install/base/utils .install/base/logger .install/modules/meta.analysis .install/base/visualization $(call depends,modules/rtm): | .install/base/logger .install/modules/assim.batch .install/base/utils .install/models/ed -$(call depends,modules/uncertainty): | .install/base/utils .install/modules/priors .install/base/db .install/modules/emulator .install/base/logger +$(call depends,modules/uncertainty): | .install/base/utils .install/modules/priors .install/base/db .install/modules/emulator .install/base/logger .install/base/settings +$(call depends,models/basgra): | .install/base/logger .install/modules/data.atmosphere .install/base/utils $(call depends,models/biocro): | .install/base/logger .install/base/remote .install/base/utils .install/base/settings .install/modules/data.atmosphere .install/modules/data.land .install/base/db $(call depends,models/cable): | .install/base/logger .install/base/utils $(call depends,models/clm45): | .install/base/logger .install/base/utils $(call depends,models/dalec): | .install/base/logger .install/base/remote .install/base/utils $(call depends,models/dvmdostem): | .install/base/utils -$(call depends,models/ed): | .install/base/utils .install/modules/data.atmosphere .install/base/logger .install/base/remote .install/base/settings +$(call depends,models/ed): | .install/modules/data.atmosphere .install/modules/data.land .install/base/logger .install/base/remote .install/base/settings .install/base/utils $(call depends,models/fates): | .install/base/utils .install/base/logger .install/base/remote $(call depends,models/gday): | .install/base/utils .install/base/logger .install/base/remote $(call depends,models/jules): | .install/base/utils .install/base/logger .install/base/remote @@ -37,3 +38,5 @@ $(call depends,models/maat): | .install/modules/data.atmosphere .install/base/lo $(call depends,models/maespa): | .install/modules/data.atmosphere .install/base/logger .install/base/remote .install/base/utils $(call depends,models/preles): | .install/base/utils .install/base/logger .install/modules/data.atmosphere .install/base/utils $(call depends,models/sipnet): | .install/modules/data.atmosphere .install/base/logger .install/base/remote .install/base/utils +$(call depends,models/stics): | .install/base/settings .install/base/db .install/base/logger .install/base/utils .install/base/remote +$(call depends,models/template): | .install/base/db .install/base/logger .install/base/utils diff --git a/README.md b/README.md index cda6d76c292..ea55705e702 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -[![Build Status](https://travis-ci.org/PecanProject/pecan.svg?branch=master)](https://travis-ci.org/PecanProject/pecan) +[![GitHub Actions CI](https://github.com/PecanProject/pecan/workflows/CI/badge.svg)](https://github.com/PecanProject/pecan/actions) [![Slack](https://img.shields.io/badge/slack-login-green.svg)](https://pecanproject.slack.com/) -[![Slack](https://img.shields.io/badge/slack-join_chat-green.svg)](https://join.slack.com/t/pecanproject/shared_invite/enQtMzkyODUyMjQyNTgzLTYyZTZiZWQ4NGE1YWU3YWIyMTVmZjEyYzA3OWJhYTZmOWQwMDkwZGU0Mjc4Nzk0NGYwYTIyM2RiZmMyNjg5MTE) +[![Slack](https://img.shields.io/badge/slack-join_chat-green.svg)](https://join.slack.com/t/pecanproject/shared_invite/enQtMzkyODUyMjQyNTgzLWEzOTM1ZjhmYWUxNzYwYzkxMWVlODAyZWQwYjliYzA0MDA0MjE4YmMyOTFhMjYyMjYzN2FjODE4N2Y4YWFhZmQ) [![DOI](https://zenodo.org/badge/4469/PecanProject/pecan.svg)](https://zenodo.org/badge/latestdoi/4469/PecanProject/pecan) @@ -22,15 +22,18 @@ PEcAn is not itself an ecosystem model, and it can be used to with a variety of ## Documentation -Consult our [Documentation](https://pecanproject.github.io/pecan-documentation/) for full documentation of the PEcAn Project. +Consult documentation of the PEcAn Project; either the [lastest stable development](https://pecanproject.github.io/pecan-documentation/develop/) branch, the latest [release](https://pecanproject.github.io/pecan-documentation/master/). Documentation from [earlier releases is here](https://pecanproject.github.io/documentation.html). ## Getting Started -See ["Getting Started"](https://pecanproject.github.io/pecan-documentation/getting-started.html) on the PEcAn. +See our ["Tutorials Page"](https://pecanproject.github.io/tutorials.html) that provides self-guided tutorials, links to vignettes, and an overview presentation. ### Installation -Complete instructions on how to install PEcAn can be found in the [documentation here](https://pecanproject.github.io/pecan-documentation/appendix.html). To get PEcAn up and running you will need to have [R](http://www.r-project.org) as well as [PostgreSQL](http://www.postgresql.org) installed. You can also [download a Virtual Machine](http://opensource.ncsa.illinois.edu/projects/artifacts.php?key=PECAN) which has all the components as well as PEcAn installed. To run this Virtual Machine you will need to have [VirtualBox](http://virtualbox.org) installed +Complete instructions on how to install PEcAn can be found in the [documentation here](https://pecanproject.github.io/pecan-documentation/develop/pecan-manual-setup.html). To get PEcAn up and running you can use one of three methods: +1. Run a [Virtual Machine](https://pecanproject.github.io/pecan-documentation/develop/pecan-manual-setup.html#install-vm). This is recommended for students and new users, and provides a consistent, tested environment for each release. +2. Use [Docker](https://pecanproject.github.io/pecan-documentation/develop/pecan-manual-setup.html#install-docker). This is recommended, especially for development and production deployment. +3. Install all of the components individually on your own Linux or MacOS computer or server. This is called a ['native install'](https://pecanproject.github.io/pecan-documentation/develop/pecan-manual-setup.html#install-native), but is more challenging and has relatively few advantages over using Docker. ### Website @@ -44,14 +47,16 @@ The demo instance only allows for runs at pecan.ncsa.illinois.edu. Once you have ## Publications -* LeBauer, D.S., D. Wang, K. Richter, C. Davidson, and M.C. Dietze (2013). Facilitating feedbacks between field measurements and ecosystem models. Ecological Monographs. [doi:10.1890/12-0137.1](http://dx.doi.org/10.1890/12-0137.1) -* Wang, D, D.S. LeBauer, and M.C. Dietze (2013). Predicting yields of short-rotation hybrid poplar (Populus spp.) for the contiguous US through model-data synthesis. Ecological Applications [doi:10.1890/12-0854.1](http://dx.doi.org/10.1890/12-0854.1) -* Dietze, M.C., D.S LeBauer, and R. Kooper (2013). On improving the communication between models and data. Plant, Cell, & Environment [doi:10.1111/pce.12043](http://dx.doi.org/10.1111/pce.12043) +* LeBauer, D.S., D. Wang, K. Richter, C. Davidson, and M.C. Dietze (2013). Facilitating feedbacks between field measurements and ecosystem models. Ecological Monographs. [doi:10.1890/12-0137.1](https://doi.org/10.1890/12-0137.1) +* Wang, D, D.S. LeBauer, and M.C. Dietze (2013). Predicting yields of short-rotation hybrid poplar (Populus spp.) for the contiguous US through model-data synthesis. Ecological Applications [doi:10.1890/12-0854.1](https://doi.org/10.1890/12-0854.1) +* Dietze, M.C., D.S LeBauer, and R. Kooper (2013). On improving the communication between models and data. Plant, Cell, & Environment [doi:10.1111/pce.12043](https://doi.org/10.1111/pce.12043) * Dietze, Michael C., Shawn P. Serbin, Carl Davidson, Ankur R. Desai, Xiaohui Feng, Ryan Kelly, Rob Kooper et al. "A quantitative assessment of a terrestrial biosphere model's data needs across North American biomes." Journal of Geophysical Research: Biogeosciences 119, no. 3 (2014): 286-300. -* Viskari, Toni, Brady Hardiman, Ankur R. Desai, and Michael C. Dietze. "Model-data assimilation of multiple phenological observations to constrain and predict leaf area index." (2015) [doi:10.1890/14-0497.1](http://dx.doi.org/10.1890/14-0497.1) +* Viskari, Toni, Brady Hardiman, Ankur R. Desai, and Michael C. Dietze. "Model-data assimilation of multiple phenological observations to constrain and predict leaf area index." (2015) [doi:10.1890/14-0497.1](https://doi.org/10.1890/14-0497.1) * Shiklomanov. A, MC Dietze, T Viskari, PA Townsend, SP Serbin. 2016 "Quantifying the influences of spectral resolution on uncertainty in leaf trait estimates through a Bayesian approach to RTM inversion" Remote Sensing of the Environment 183: 226-238 * LeBauer, David, Rob Kooper, Patrick Mulrooney, Scott Rohde, Dan Wang, Stephen P. Long, and Michael C. Dietze. "BETYdb: a yield, trait, and ecosystem service database applied to second‐generation bioenergy feedstock production." GCB Bioenergy (2017). +A extensive list of publications that apply PEcAn or are informed by our work on [Google Scholar](https://scholar.google.com/citations?hl=en&user=HWhxBY4AAAAJ). + ## Acknowledgements The PEcAn project is supported by the National Science Foundation (ABI #1062547, ABI #1458021, DIBBS #1261582, ARC #1023477, EF #1318164, EF #1241894, EF #1241891), NASA Terrestrial Ecosystems, the Energy Biosciences Institute, Department of Energy (ARPA-E awards #DE-AR0000594 and DE-AR0000598), and an Amazon AWS in Education Grant. diff --git a/api/.Rbuildignore b/api/.Rbuildignore deleted file mode 100644 index 91114bf2f2b..00000000000 --- a/api/.Rbuildignore +++ /dev/null @@ -1,2 +0,0 @@ -^.*\.Rproj$ -^\.Rproj\.user$ diff --git a/api/.gitignore b/api/.gitignore deleted file mode 100644 index 807ea251739..00000000000 --- a/api/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -.Rproj.user -.Rhistory -.RData diff --git a/api/DESCRIPTION b/api/DESCRIPTION deleted file mode 100644 index b9fdc9019cf..00000000000 --- a/api/DESCRIPTION +++ /dev/null @@ -1,22 +0,0 @@ -Package: pecanapi -Title: R API for Dockerized remote PEcAn instances -Version: 1.7.1 -Date: 2019-09-05 -Authors@R: person("Alexey", "Shiklomanov", email = "alexey.shiklomanov@gmail.coim", role = c("aut", "cre")) -Description: Start PEcAn workflows, and analyze their outputs from within an R session. -Depends: R (>= 3.5.1) -Imports: - bit64, - DBI, - httr, - jsonlite, - XML, - RPostgres -Suggests: - magrittr, - ncdf4 -License: FreeBSD + file LICENSE -Encoding: UTF-8 -LazyData: true -RoxygenNote: 6.1.0 -Roxygen: list(markdown = TRUE) diff --git a/api/NAMESPACE b/api/NAMESPACE deleted file mode 100644 index f3c15e990c4..00000000000 --- a/api/NAMESPACE +++ /dev/null @@ -1,24 +0,0 @@ -# Generated by roxygen2: do not edit by hand - -export(add_database) -export(add_pft) -export(add_pft_list) -export(add_rabbitmq) -export(add_workflow) -export(dbfile_url) -export(get_model_id) -export(get_next_workflow_id) -export(insert_new_workflow) -export(list_runs) -export(output_url) -export(prepared_query) -export(prepared_statement) -export(run_dap) -export(run_url) -export(search_models) -export(search_pfts) -export(search_sites) -export(submit_workflow) -export(thredds_dap_url) -export(watch_workflow) -export(workflow_output) diff --git a/api/R/add_database.R b/api/R/add_database.R deleted file mode 100644 index 9919e70d946..00000000000 --- a/api/R/add_database.R +++ /dev/null @@ -1,42 +0,0 @@ -#' Add PEcAn database information to settings list -#' -#' @param settings Input settings list (list) -#' @param host Database server hostname (character, default = `pecanapi.db_hostname`) -#' @param user Database user name (character, default = option `pecanapi.db_username`)) -#' @param password Database password (character, default = option `pecanapi.db_password`) -#' @param dbname Database name (character, default = option `pecanapi.db_dbname`) -#' @param driver Database driver (character, default = option `pecanapi.db_driver`) -#' @param dbfiles Path to `dbfiles` directory (character, default = -#' option `pecanapi.db_dbfiles`) -#' @param write Whether or not to write to the database (logical, -#' default = option `pecanapi.db_write`) -#' @param overwrite Whether or not to overwrite any already existing -#' input settings (logical, default = `FALSE`) -#' @param ... Additional named PEcAn database configuration tags -#' @return Updated settings list with database information included -#' @author Alexey Shiklomanov -#' @export -add_database <- function(settings, - host = getOption("pecanapi.db_hostname"), - user = getOption("pecanapi.db_user"), - password = getOption("pecanapi.db_password"), - dbname = getOption("pecanapi.db_dbname"), - driver = getOption("pecanapi.db_driver"), - dbfiles = getOption("pecanapi.db_dbfiles"), - write = getOption("pecanapi.db_write"), - overwrite = FALSE, - ...) { - bety_list <- list( - host = host, - user = user, - password = password, - dbname = dbname, - driver = driver, - write = write, - ... - ) - db_list <- list(database = list(bety = bety_list, dbfiles = dbfiles)) - new_settings <- modifyList(settings, db_list) - if (!overwrite) new_settings <- modifyList(new_settings, settings) - new_settings -} diff --git a/api/R/add_pft.R b/api/R/add_pft.R deleted file mode 100644 index 4a74e0f7562..00000000000 --- a/api/R/add_pft.R +++ /dev/null @@ -1,45 +0,0 @@ -#' Add a PFT or list of PFTs to a settings object -#' -#' @param settings Input PEcAn settings list -#' @param name PFT name (character) -#' @param pfts Either a character vector of PFT names, or a list of -#' PFT objects (which must each include an element named "name") -#' @param ... Additional arguments for modifying the PFT. -#' @return Updated settings list with PFTs added -#' @author Alexey Shiklomanov -#' @examples -#' settings <- list() -#' add_pft(settings, "Optics.Temperate_Early_Hardwood") -#' add_pft_list(settings, sprintf("Temperate_%s_Hardwood", c("Early", "Mid", "Late"))) -#' add_pft_list( -#' settings, -#' list(list(name = "deciduous", num = 3), -#' list(name = "coniferous", num = 6)) -#' ) -#' if (require("magrittr")) { -#' list() %>% -#' add_pft("early_hardwood") %>% -#' add_pft("mid_hardwood") %>% -#' add_pft("late_hardwood") -#' } -#' @export -add_pft <- function(settings, name, ...) { - pft_list <- settings[["pfts"]] - new_pft <- list(name = name, ...) - settings[["pfts"]] <- c(pft_list, list(pft = new_pft)) - settings -} - -#' @rdname add_pft -#' @export -add_pft_list <- function(settings, pfts, ...) { - for (pft in pfts) { - if (is.character(pfts)) { - settings <- add_pft(settings, pft, ...) - } else { - args <- c(list(settings = settings), pft) - settings <- do.call(add_pft, args) - } - } - settings -} diff --git a/api/R/add_rabbitmq.R b/api/R/add_rabbitmq.R deleted file mode 100644 index cdda204dd8c..00000000000 --- a/api/R/add_rabbitmq.R +++ /dev/null @@ -1,65 +0,0 @@ -#' Add RabbitMQ configuration -#' -#' @inheritParams add_workflow -#' @param model_queue Name of RabbitMQ model queue (character, default -#' = `NULL`). This should be in the form `modelname_modelrevision`. -#' If this is `NULL`, this function will try to figure it out based -#' on the model ID in the settings object, which requires access to -#' the database (i.e. `con` must not be `NULL`). -#' @param con Database connection object (default = `NULL`). Ignored -#' unless `model_queue` is `NULL`. -#' @param rabbitmq_user Username for RabbitMQ server (character, -#' default = option `pecanapi.rabbitmq_user`) -#' @param rabbitmq_password Password for RabbitMQ server (character, -#' default = option `pecanapi.rabbitmq_password`) -#' @param rabbitmq_service Name of RabbitMQ `docker-compose` service -#' (character, default = option `pecanapi.rabbitmq_service`) -#' @param rabbitmq_service_port RabbitMQ service port (numeric or -#' character, default = option `pecanapi.rabbitmq_service_port`). -#' Note that this is internal to the Docker stack, _not_. The only -#' reason this should be changed is if you changed low-level -#' RabbitMQ settings in the `docker-compose.yml` file -#' @param rabbitmq_vhost RabbitMQ vhost (character, default = option -#' `pecanapi.rabbitmq_vhost`). The only reason this should be -#' changed is if you change the low-level RabbitMQ setup in the -#' `docker-compose.yml` file. -#' @return Modified settings list with RabbitMQ configuration added. -#' @author Alexey Shiklomanov -#' @export -add_rabbitmq <- function(settings, - model_queue = NULL, - con = NULL, - rabbitmq_user = getOption("pecanapi.rabbitmq_user"), - rabbitmq_password = getOption("pecanapi.rabbitmq_password"), - rabbitmq_service = getOption("pecanapi.rabbitmq_service"), - rabbitmq_service_port = getOption("pecanapi.rabbitmq_service_port"), - rabbitmq_vhost = getOption("pecanapi.rabbitmq_vhost"), - overwrite = FALSE) { - if (is.null(model_queue) && is.null(settings[["rabbitmq"]][["queue"]])) { - # Deduce model queue from settings and database - if (is.null(con)) { - stop("Database connection object (`con`) required to automatically determine model queue.") - } - model_id <- settings[["model"]][["id"]] - if (is.null(model_id)) { - stop("Settings list must include model ID to automatically determine model queue.") - } - model_dat <- prepared_query(con, ( - "SELECT model_name, revision FROM models WHERE id = $1" - ), list(model_id)) - if (!nrow(model_dat) > 0) stop("Multiple models found. Unable to automatically determine model queue.") - model_queue <- paste(model_dat[["model_name"]], model_dat[["revision"]], sep = "_") - } - - rabbitmq_settings <- list( - uri = sprintf("amqp://%s:%s@%s:%d/%s", - rabbitmq_user, rabbitmq_password, - rabbitmq_service, rabbitmq_service_port, rabbitmq_vhost), - queue = model_queue - ) - new_settings <- modifyList(settings, list(host = list(rabbitmq = rabbitmq_settings))) - if (!overwrite) { - new_settings <- modifyList(new_settings, settings) - } - new_settings -} diff --git a/api/R/add_workflow.R b/api/R/add_workflow.R deleted file mode 100644 index 8f9023c6360..00000000000 --- a/api/R/add_workflow.R +++ /dev/null @@ -1,31 +0,0 @@ -#' Add information from workflow data frame into settings list. -#' -#' @param settings Partially completed PEcAn `settings` list. -#' @param workflow_df Workflow `data.frame`, such as that returned by -#' [insert_new_workflow], or from running query `SELECT * FROM -#' workflows` -#' @param overwrite Whether or not to overwrite existing `settings` -#' tags (logical; default = `FALSE`) -#' @return PEcAn settings list with workflow information added -#' @author Alexey Shiklomanov -#' @export -add_workflow <- function(settings, workflow_df, overwrite = FALSE) { - workflow_settings <- list( - workflow = list(id = workflow_df[["id"]]), - outdir = workflow_df[["folder"]], - model = list(id = workflow_df[["model_id"]]), - run = list( - site = list(id = workflow_df[["site_id"]], - met.start = workflow_df[["start_date"]], - met.end = workflow_df[["end_date"]]), - start.date = workflow_df[["start_date"]], - end.date = workflow_df[["end_date"]] - ), - info = list(notes = workflow_df[["notes"]]) - ) - new_settings <- modifyList(settings, workflow_settings) - if (!overwrite) { - new_settings <- modifyList(new_settings, settings) - } - new_settings -} diff --git a/api/R/get_model_id.R b/api/R/get_model_id.R deleted file mode 100644 index 892450f6242..00000000000 --- a/api/R/get_model_id.R +++ /dev/null @@ -1,37 +0,0 @@ -#' Retrieve database ID of a particular version of a model -#' -#' @param con Database connection object (Pqconnection) -#' @param name Model name (character) -#' @param revision Model version/revision (character) -#' @param multi_action Action to take if multiple models found -#' (character). Must be one of "first", "last" (default), "all", or "error". -#' @return Model ID, as `integer64` -#' @author Alexey Shiklomanov -#' @export -get_model_id <- function(con, name, revision, multi_action = "last") { - qry <- DBI::dbSendQuery(con, paste( - "SELECT id FROM models WHERE model_name = $1 and revision = $2 ORDER BY id DESC" - )) - res <- DBI::dbBind(qry, list(name, revision)) - on.exit(DBI::dbClearResult(res)) - id <- DBI::dbFetch(res)[["id"]] - if (length(id) == 0) { - stop("Model ", name, " with revision ", revision, " not found.") - } - if (length(id) > 1) { - warning("Multiple models with name ", name, " and revision ", revision, "found. ", - "Returning ", multi_action, " result.") - if (multi_action == "first") { - id <- head(id, 1) - } else if (multi_action == "last") { - id <- tail(id, 1) - } else if (multi_action == "all") { - # Return all IDs -- leave as is - } else if (multi_action == "error") { - stop("Multiple models found, and 'error' action selected.") - } else { - stop("Unknown multi_action: ", multi_action) - } - } - id -} diff --git a/api/R/insert_new_workflow.R b/api/R/insert_new_workflow.R deleted file mode 100644 index ac0ee5dd5ec..00000000000 --- a/api/R/insert_new_workflow.R +++ /dev/null @@ -1,105 +0,0 @@ -#' Insert a new workflow into PEcAn database, returning the workflow -#' as a `data.frame` -#' -#' @inheritParams prepared_query -#' @param site_id Site ID from `sites` table (numeric) -#' @param model_id Model ID from `models` table (numeric) -#' @param start_date Model run start date (character or POSIX) -#' @param end_date Model run end date (character or POSIX) -#' @param user_id User ID from `users` table (default = option -#' `pecanapi.user_id`). Note that this option is _not set by -#' default_, and this function will not run without a set `user_id`. -#' @param hostname Workflow server hostname (character; default = -#' option `pecanapi.workflow_hostname`) -#' @param folder_prefix Output directory prefix (character; default = -#' option `pecanapi.workflow_prefix`). Workflow ID will be appended -#' to the end with `paste0` -#' @param params Additional workflow parameters, stored in -#' `workflows.params` (character or NULL (default)) -#' @param notes Additional workflow notes, stored in `workflows.notes` -#' (character or NULL (default)) -#' @return `data.frame` containing new workflow(s), including all -#' columns from `workflows` table. -#' @author Alexey Shiklomanov -#' @export -insert_new_workflow <- function(con, - site_id, - model_id, - start_date, - end_date, - user_id = getOption("pecanapi.user_id"), - hostname = getOption("pecanapi.workflow_hostname"), - folder_prefix = getOption("pecanapi.workflow_prefix"), - params = NULL, - notes = NULL) { - if (is.null(notes)) notes <- "" - if (is.null(params)) params <- "" - if (is.null(user_id)) { - stop("API-based inserts into the workflows table are not allowed without a user ID. ", - "Either pass the user_id directly, or set it via `options(pecanapi.user_id = )`") - } - stopifnot( - # Must be scalar - length(folder_prefix) == 1, - length(user_id) <= 1, - length(con) == 1, - # Must be RPostgres connection for prepared queries - class(con) == "PqConnection" - ) - lens <- lengths(list(site_id, model_id, start_date, end_date)) - n_workflow <- max(lens) - if (!all(lens == 1 | lens == n_workflow)) { - stop( - "All inputs must be either the same length or length 1. ", - "You provided the following: ", - paste(sprintf("%s (%s)", c("site_id", "model_id", "start_date", "end_date"), lens), - collapse = ", ") - ) - } - id <- bit64::integer64() - for (i in seq_len(n_workflow)) { - id[i] <- get_next_workflow_id(con)[[1]] - } - stopifnot(length(id) >= 1) - folder <- paste0(folder_prefix, id) - query_string <- paste( - "INSERT INTO workflows", - "(id, site_id, model_id, folder,", - "hostname, start_date, end_date, params,", - "notes,", - "user_id,", - "advanced_edit)", - "VALUES", - "($1, $2, $3, $4,", - "$5, $6, $7, $8,", - "$9,", - "$10,", - "false)", - "RETURNING *" - ) - params <- list(id, site_id, model_id, folder, - hostname, start_date, end_date, params, - notes, user_id) - prepared_query(con, query_string, params) -} - -#' Get current workflow ID and update internal workflow ID PostgreSQL -#' sequence -#' -#' The `workflows` table has an internal -#' [sequence](https://www.postgresql.org/docs/9.6/sql-createsequence.html) -#' that keeps track of and automatically updates the workflow ID -#' (that's why inserting into the table without explicitly setting a -#' workflow ID is a safe and robust operation). This function is a -#' wrapper around the -#' [`nextval` function](https://www.postgresql.org/docs/9.6/functions-sequence.html), -#' which retrieves the current value of the sequence _and_ augments -#' the sequence by 1. -#' -#' @inheritParams prepared_query -#' @return Workflow ID, as numeric/base64 integer -#' @author Alexey Shiklomanov -#' @export -get_next_workflow_id <- function(con) { - DBI::dbGetQuery(con, "SELECT nextval('workflows_id_seq')")[[1]] -} diff --git a/api/R/list_runs.R b/api/R/list_runs.R deleted file mode 100644 index 0fef629806e..00000000000 --- a/api/R/list_runs.R +++ /dev/null @@ -1,15 +0,0 @@ -#' List all runs associated with a particular workflow -#' -#' @inheritParams prepared_query -#' @param workflow_id ID of target workflow (character or numeric) -#' @return Runs `data.frame` subset to rows containing specific workflow -#' @author Alexey Shiklomanov -#' @export -list_runs <- function(con, workflow_id) { - prepared_query(con, paste( - "SELECT runs.* FROM runs", - "INNER JOIN ensembles ON (runs.ensemble_id = ensembles.id)", - "INNER JOIN workflows ON (ensembles.workflow_id = workflows.id)", - "WHERE workflows.id = $1" - ), list(workflow_id)) -} diff --git a/api/R/prepared_query.R b/api/R/prepared_query.R deleted file mode 100644 index c8ce91b1892..00000000000 --- a/api/R/prepared_query.R +++ /dev/null @@ -1,83 +0,0 @@ -#' Execute a PostgreSQL prepared query or statement -#' -#' This provides a safe and efficient way of executing a query or -#' statement with a list of parameters to be substituted. -#' -#' A prepared statement consists of a template query (`query`), which -#' is compiled prior to execution, and a series of parameters -#' (`params`) that are passed into the relevant spots in the template -#' query. In R's `DBI` database interface, this uses three statements: -#' [DBI::dbSendQuery] to create the template query, [DBI::dbBind] to -#' bind parameters to that query, and [DBI::dbFetch] to retrieve the -#' results. Statements ([DBI::dbSendStatement]) work the same way, -#' except there are no results to fetch with [DBI::dbFetch]. -#' -#' Prepared statements have several important advantages. First of -#' all, they are automatically and efficiently vectorized, meaning -#' that it is possible to build a single query and run it against a -#' vector of parameters. Second, they automatically enforce strict -#' type checking and quoting of inputs, meaning that they are secure -#' against SQL injection attacks and input mistakes (e.g. giving a -#' character when the table expects a number). -#' -#' @param con Database connection, as created by [RPostgres::dbConnect] -#' @param query Query template (character, length 1) -#' @param params Query parameters (unnamed list) -#' @return For `prepared_query`, the query result as a `data.frame`. -#' `prepared_statement` exits silently on success. -#' @author Alexey Shiklomanov -#' @examples -#' \dontrun{ -#' prepared_query(con, paste( -#' "SELECT id, folder FROM workflows", -#' "WHERE user_id = $1" -#' ), list(my_user_id)) -#' -#' prepared_statement(con, paste( -#' "INSERT INTO workflows (id, site_id, model_id, folder)", -#' "VALUES ($1, $2, $3, $4)" -#' ), list(workflow_id, my_site_id, my_model_id, my_folder)) -#' -#' # Note that queries and statements are automatically vectorized -#' # The below query will execute two searches, and return the results -#' # of both in one data.frame -#' prepared_query(con, paste( -#' "SELECT * FROM dbfiles", -#' "WHERE file_name ILIKE $1", -#' ), list(c("%cruncep%", "%gfdl%"))) -#' -#' # Similarly, this will create two workflows, all with the same -#' model_id (1) but different site_ids (33, 67) -#' prepared_statement(con, paste( -#' "INSERT INTO workflows (site_id, model_id)", -#' "VALUES ($1, $2)" -#' ), list(c(33, 67), 1)) -#' -#'} -#' @export -prepared_query <- function(con, query, params) { - stopifnot( - class(con) == "PqConnection", - is.character(query), - length(query) == 1, - is.list(params) - ) - qry <- DBI::dbSendQuery(con, query) - res <- DBI::dbBind(qry, params) - on.exit(DBI::dbClearResult(res)) - DBI::dbFetch(res) -} - -#' @rdname prepared_query -#' @export -prepared_statement <- function(con, query, params) { - stopifnot( - class(con) == "PqConnection", - is.character(query), - length(query) == 1, - is.list(params) - ) - qry <- DBI::dbSendStatement(con, query) - res <- DBI::dbBind(qry, params) - on.exit(DBI::dbClearResult(res)) -} diff --git a/api/R/search.R b/api/R/search.R deleted file mode 100644 index bcf1583b1a2..00000000000 --- a/api/R/search.R +++ /dev/null @@ -1,85 +0,0 @@ -#' Search for sites or models -#' -#' @inheritParams prepared_query -#' @param name Model/PFT (depending on function) name search string (character) -#' @param sitename Model name search string (character) -#' @param definition PFT definition search string (character) -#' @param modeltype Model type search string (character) -#' @param revision Model version search string (character) -#' @param auto_pct Logical. If `TRUE` (default), automatically -#' surround search strings in `%`. If this is `FALSE`, you should -#' explicitly specify `"%%"` for one or both other arguments. -#' @param ignore.case Logical. If `TRUE` (default) use -#' case-insensitive search (SQL `ILIKE` operator); otherwise, use -#' case-sensitive search (SQL `LIKE` operator). -#' @return Bety `models` table (`data.frame`) subset to matching model -#' name or version -#' @author Alexey Shiklomanov -#' @examples -#' \dontrun{ -#' search_models(con, "SIPNET") -#' -#' # Partial match -#' search_models(con, "ED") -#' search_models(con, modeltype = "ED") -#' search_sites(con, "UMBS") -#' search_pfts(con, "early", modeltype = "ED") -#' -#' # Case sensitivity -#' search_models(con, "ed") -#' search_models(con, "ed", ignore.case = FALSE) -#' -#' # Starts with UMBS -#' search_sites(con, "UMBS%", auto_pct = FALSE) -#' -#' # SQL wildcards can still be used inside search strings. -#' search_pfts(con, "early%hardwood") -#' } -#' @rdname search -#' @export -search_models <- function(con, name = "", revision = "", modeltype = "", auto_pct = TRUE, ignore.case = TRUE) { - if (auto_pct) { - name <- paste0("%", name, "%") - revision <- paste0("%", revision, "%") - modeltype <- paste0("%", modeltype, "%") - } - like <- "LIKE" - if (ignore.case) like <- "ILIKE" - prepared_query(con, paste( - "SELECT models.*, modeltypes.name AS modeltype FROM models", - "INNER JOIN modeltypes ON (models.modeltype_id = modeltypes.id)", - "WHERE model_name", like, "$1 AND revision", like, "$2 AND modeltypes.name", like, "$3" - ), list(name, revision, modeltype)) -} - -#' @rdname search -#' @export -search_sites <- function(con, sitename = "", auto_pct = TRUE, ignore.case = TRUE) { - if (auto_pct) { - sitename <- paste0("%", sitename, "%") - } - like <- "LIKE" - if (ignore.case) like <- "ILIKE" - prepared_query(con, paste( - "SELECT * FROM sites WHERE sitename", like, "$1" - ), list(sitename)) -} - -#' @rdname search -#' @export -search_pfts <- function(con, name = "", definition = "", modeltype = "", auto_pct = TRUE, ignore.case = TRUE) { - if (auto_pct) { - name <- paste0("%", name, "%") - definition <- paste0("%", definition, "%") - modeltype <- paste0("%", modeltype, "%") - } - like <- "LIKE" - if (ignore.case) like <- "ILIKE" - prepared_query(con, paste( - "SELECT pfts.id AS id, pfts.name AS name, pfts.definition AS definition, pfts.pft_type AS pft_type,", - "modeltypes.name AS modeltype, modeltypes.id AS modeltype_id", - "FROM pfts INNER JOIN modeltypes", - "ON (pfts.modeltype_id = modeltypes.id)", - "WHERE pfts.name", like, "$1 AND pfts.definition", like, "$2 AND modeltypes.name", like, "$3" - ), list(name, definition, modeltype)) -} diff --git a/api/R/submit_workflow.R b/api/R/submit_workflow.R deleted file mode 100644 index 043c83488a9..00000000000 --- a/api/R/submit_workflow.R +++ /dev/null @@ -1,111 +0,0 @@ -#' Post complete settings list as RabbitMQ message -#' -#' @param settings PEcAn settings list object -#' @param rabbitmq_hostname RabbitMQ server hostname (character. -#' Default = `"localhost"`) -#' @param rabbitmq_port RabbitMQ server port (character or numeric. -#' Default = option `pecanapi.docker_port`) -#' @param rabbitmq_user RabbitMQ user name (character. Default = -#' option `pecanapi.rabbitmq_user`) -#' @param rabbitmq_password RabbitMQ password (character. Default = -#' option `pecanapi.rabbitmq_password`) -#' @param rabbitmq_prefix Complete RabbitMQ API prefix. If `NULL` -#' (default), this is constructed from the other arguments. If this -#' argument is not `NULL`, it overrides all other arguments except -#' `httr_auth` and `settings`. -#' @param httr_auth Whether or not to use [httr::authenticate] to -#' generate CURL authentication (default = `TRUE`). If `FALSE`, you -#' must pass the authentication as part of the RabbitMQ hostname or prefix. -#' @param https Whether or not to use `https`. If `FALSE`, use `http`. -#' Default = option `pecanapi.docker_https` -#' @return Curl `POST` output, parsed by [httr::content] -#' @author Alexey Shiklomanov -#' @export -submit_workflow <- function(settings, - rabbitmq_hostname = getOption("pecanapi.docker_hostname"), - rabbitmq_frontend = getOption("pecanapi.docker_rabbitmq_frontend"), - rabbitmq_port = getOption("pecanapi.docker_port"), - rabbitmq_user = getOption("pecanapi.rabbitmq_user"), - rabbitmq_password = getOption("pecanapi.rabbitmq_password"), - rabbitmq_prefix = NULL, - httr_auth = TRUE, - https = getOption("pecanapi.docker_https")) { - if (is.numeric(rabbitmq_port)) rabbitmq_port <- as.character(rabbitmq_port) - # Create xml object - settings_xml <- listToXML(settings, "pecan") - settings_xml_string <- XML::toString.XMLNode(settings_xml) - settings_json <- jsonlite::toJSON( - list(pecan_xml = settings_xml_string, folder = settings[["outdir"]]), - auto_unbox = TRUE -) - bod_raw <- list( - properties = list(delivery_mode = 2), - routing_key = "pecan", - payload = settings_json, - payload_encoding = "string" - ) - auth <- NULL - if (httr_auth) { - auth <- httr::authenticate(rabbitmq_user, rabbitmq_password) - } - bod <- jsonlite::toJSON(bod_raw, auto_unbox = TRUE) - if (is.null(rabbitmq_prefix)) { - httpstring <- "http" - if (https) httpstring <- "https" - base_url <- sprintf("%s://%s:%s", httpstring, rabbitmq_hostname, rabbitmq_port) - rabbitmq_prefix <- paste0(base_url, rabbitmq_frontend) - } - result <- httr::POST( - paste0(rabbitmq_prefix, "/api/exchanges/%2F//publish"), - auth, - body = bod - ) - follow_url <- sprintf("%s/pecan/05-running.php?workflowid=%s", - base_url, as.character(settings[["workflow"]][["id"]])) - message("Follow workflow progress from your browser at:\n", follow_url) - httr::content(result) -} - -#' Convert List to XML -#' -#' Can convert list or other object to an xml object using xmlNode -#' @param item object to be converted. Despite the function name, need not actually be a list -#' @param tag xml tag -#' @return xmlNode -#' @author David LeBauer, Carl Davidson, Rob Kooper -listToXML <- function(item, tag) { - - # just a textnode, or empty node with attributes - if (typeof(item) != "list") { - if (length(item) > 1) { - xml <- XML::xmlNode(tag) - for (name in names(item)) { - XML::xmlAttrs(xml)[[name]] <- item[[name]] - } - return(xml) - } else { - return(XML::xmlNode(tag, item)) - } - } - - # create the node - if (identical(names(item), c("text", ".attrs"))) { - # special case a node with text and attributes - xml <- XML::xmlNode(tag, item[["text"]]) - } else { - # node with child nodes - xml <- XML::xmlNode(tag) - for (i in seq_along(item)) { - if (is.null(names(item)) || names(item)[i] != ".attrs") { - xml <- XML::append.xmlNode(xml, listToXML(item[[i]], names(item)[i])) - } - } - } - - # add attributes to node - attrs <- item[[".attrs"]] - for (name in names(attrs)) { - XML::xmlAttrs(xml)[[name]] <- attrs[[name]] - } - return(xml) -} # listToXML diff --git a/api/R/thredds_fileserver.R b/api/R/thredds_fileserver.R deleted file mode 100644 index 9d6c332ccba..00000000000 --- a/api/R/thredds_fileserver.R +++ /dev/null @@ -1,76 +0,0 @@ -#' Build URL for output file hosted on THREDDS fileServer -#' -#' @param workflow_id ID of target workflow (numeric or character) -#' @param target Target path, relative to workflow directory (character) -#' @param ... Additional arguments to [thredds_fs_url] -#' @return THREDDS http fileServer URL (character) -#' @author Alexey Shiklomanov -#' @export -output_url <- function(workflow_id, target, ...) { - workflow_id <- as.character(workflow_id) - prefix_url <- sprintf("%s/outputs/PEcAn_%s", thredds_fs_url(...), workflow_id) - file.path(prefix_url, target) -} - -#' Build a THREDDS fileServer URL for a specific output file from a -#' specific run -#' -#' @inheritParams output_url -#' @param target Target file path, relative to output directory of -#' specific run (as specified by `run_id`) -#' @param run_id Run ID (numeric or character). If `NULL`, try to use -#' the run listed in the `runs.txt` file. If multiple runs are -#' available, throw a warning and use the first one. -#' @param ... Additional arguments to [thredds_fs_url] -#' @return HTTP fileServer URL of a particular run output file (character) -#' @author Alexey Shiklomanov -#' @export -run_url <- function(workflow_id, target, run_id = NULL, ...) { - if (is.null(run_id)) run_id <- get_run_id(workflow_id, ...) - new_target <- file.path("out", as.character(run_id), target) - output_url(workflow_id, new_target, ...) -} - -#' Get a run ID from the `runs.txt` file -#' -#' @inheritParams output_url -#' @return A single output ID (integer64) -#' @author Alexey Shiklomanov -get_run_id <- function(workflow_id, ...) { - run_id <- bit64::as.integer64(readLines(output_url(workflow_id, "run/runs.txt", ...))) - if (length(run_id) > 1) { - warning("Multiple runs found. Selecting first run.") - run_id <- head(run_id, 1) - } - run_id -} - -#' Build a THREDDS fileServer URL for a specific dbfile -#' -#' @param target Target file path, relative to `dbfiles` root folder (character) -#' @param ... Additional arguments to [thredds_fs_url] -#' @return THREDDS HTTP fileServer URL to dbfile (character) -#' @author Alexey Shiklomanov -#' @export -dbfile_url <- function(target, ...) { - file.path(thredds_fs_url(...), "dbfiles", target) -} - -#' Create a THREDDS fileServer URL prefix -#' -#' @param hostname THREDDS server hostname (default = "localhost") -#' @param port THREDDS server port (default = 8000) -#' @param https Logical. If `TRUE`, use https, otherwise use http -#' (default = `FALSE`). -#' @return THREDDS fileServer URL prefix (character) -#' @author Alexey Shiklomanov -thredds_fs_url <- function(hostname = getOption("pecanapi.docker_hostname"), - port = getOption("pecanapi.docker_port"), - https = getOption("pecanapi.docker_https")) { - httpstring <- if (https) "https" else "http" - port <- as.character(port) - sprintf( - "%s://%s:%s/thredds/fileServer", - httpstring, hostname, port - ) -} diff --git a/api/R/thredds_opendap.R b/api/R/thredds_opendap.R deleted file mode 100644 index 0086a0808eb..00000000000 --- a/api/R/thredds_opendap.R +++ /dev/null @@ -1,36 +0,0 @@ -#' Create a THREDDS OpenDAP access URL to a PEcAn file -#' -#' @param target Full path to target (character) relative to THREDDS -#' root. For outputs, this should start with "outputs/", and for -#' dbfiles, "dbfiles/". -#' @inheritParams thredds_fs_url -#' @return OpenDAP URL to target file (character) -#' @author Alexey Shiklomanov -#' @export -thredds_dap_url <- function(target, - hostname = getOption("pecanapi.docker_hostname"), - port = getOption("pecanapi.docker_port"), - https = getOption("pecanapi.docker_https")) { - httpstring <- if (https) "https" else "http" - port <- as.character(port) - prefix_url <- sprintf("%s://%s:%s/thredds/dodsC", httpstring, hostname, port) - file.path(prefix_url, target) -} - -#' Create a THREDDS OpenDAP access URL to a specific model output file -#' -#' @inheritParams run_url -#' @return OpenDAP URL to target file (character) -#' @author Alexey Shiklomanov -#' @export -run_dap <- function(workflow_id, target, run_id = NULL, ...) { - if (is.null(run_id)) run_id <- get_run_id(workflow_id, ...) - new_target <- file.path( - "outputs", - paste0("PEcAn_", workflow_id), - "out", - run_id, - target -) - thredds_dap_url(new_target, ...) -} diff --git a/api/R/watch_progress.R b/api/R/watch_progress.R deleted file mode 100644 index 99b17daaf16..00000000000 --- a/api/R/watch_progress.R +++ /dev/null @@ -1,36 +0,0 @@ -#' Retrieve the current output of a workflow given its ID -#' -#' @param workflow_id Workflow ID (character or numeric) -#' @param ... Additional arguments to [output_url] -#' @return Workflow output, as character vector with one item per line -#' in `workflow.Rout` (as returned by `readLines`). -#' @author Alexey Shiklomanov -#' @export -workflow_output <- function(workflow_id, ...) { - readLines(output_url(workflow_id, "workflow.Rout", ...)) -} - -#' Continuously monitor the progress of a workflow until it completes. -#' To exit early, send an interrupt signal (Control-C). -#' -#' @inheritParams workflow_output -#' @param nlines Print the last N lines (numeric, default = 10) -#' @param sleep Number of seconds to sleep between status updates -#' (numeric, default = 3) -#' @return If successful -#' @author Alexey Shiklomanov -#' @export -watch_workflow <- function(workflow_id, nlines = 10, sleep = 3, ...) { - repeat { - output <- tryCatch( - workflow_output(workflow_id, ...), - error = function(e) "Unable to access workflow output" - ) - out_sub <- tail(output, nlines) - message(paste(out_sub, collapse = "\n"), "\n----------------\n") - if (any(grepl("PEcAn Workflow Complete", output))) { - return(invisible(NULL)) - } - Sys.sleep(sleep) - } -} diff --git a/api/R/zzz.R b/api/R/zzz.R deleted file mode 100644 index e7f3349a054..00000000000 --- a/api/R/zzz.R +++ /dev/null @@ -1,96 +0,0 @@ -#' Package-specific options -#' -#' To minimize the number of changes that have to happen for scripts -#' using `pecanapi` to be shared across machines, most -#' Docker/RabbitMQ/database-related configurations can be configured -#' via `options`. All options take the form `pecanapi.optionname`, -#' where `optionname` is the specific option. Note that these values -#' are used only as default function arguments, and can be substituted -#' for any individual function call by passing the appropriate argument. -#' -#' The following options (prefixed with `pecanapi.`) are used by -#' `pecanapi`. To see the default values, just call `options()` with -#' no arguments. These are sorted in order of decreasing likelihood of -#' needing to be set by the user (first options are most likely to be -#' changed across different systems): -#' -#' -`pecanapi.user_id` -- The User ID to associate with all workflows -#' created by this package. This is the only option that _must_ be set -#' by the user -- it is set to `NULL` by default, which will cause -#' many of the functions in the `pecanapi` to fail. -#' -#' - `docker_hostname`, `docker_port` -- The hostname and port of the -#' Docker service. You can check that these values work by browsing to -#' `docker_hostname:docker_port` (by default, `localhost:8000`) in a -#' web browser. -#' -#' - `docker_rabbitmq_frontend` -- The "frontend rule" for RabbitMQ. -#' By default, this is `/rabbitmq`, meaning that the RabbitMQ console -#' is accessible at `localhost:8000/rabbitmq` (adjusted for whatever -#' combination of `docker_hostname` and `docker_port` you are using). -#' -#' `docker_https` -- (Logical) If `TRUE`, all URLs use `https` access. -#' By default, this is `FALSE`. -#' -#' - `db_hostname` -- The name of the PostgreSQL container service -#' inside the PEcAn stack. This is the same as its service name in -#' `docker-compose.yml`. This is the hostname used by the `executor` -#' service to access the database, and which is written into each -#' `pecan.xml` file. -#' -#' - `db_user`, `db_password`, `db_dbname`, `db_driver`, `db_write` -- -#' These correspond to the `user`, `password`, `dbname`, `driver`, and -#' `write` tags in the `database/bety` part of the PEcAn XML. -#' -#' - `rabbitmq_user`, `rabbitmq_password` -- The RabbitMQ -#' authentication credentials. These are set in the -#' `docker-compose.yml` file, under the `rabbitmq` service. -#' -#' - `rabbitmq_service`, `rabbitmq_service_port`, `rabbitmq_vhost` -- -#' The name, internal port, and `vhost` of the RabbitMQ service. -#' Unless you are making major changes to the guts of -#' `docker-compose.yml`, you shouldn't change these values (i.e. they -#' should be the same on most machines). -#' -#' - `workflow_hostname` -- The hostname passed to the `host` section -#' of the `pecan.xml`. By default, this is "docker". -#' -#' - `workflow_prefix` -- The location and directory prefix for -#' storing workflow outputs. By default, this is -#' `/data/workflows/PEcAn_`. The workflow ID will be appended directly -#' to this value. -#' @name pecanapi_options -NULL - -.onLoad <- function(libname, packagename) { - op <- options() - api_opts <- list( - pecanapi.user_id = NULL, - # Docker options (submit_workflow) - pecanapi.docker_hostname = "localhost", - pecanapi.docker_port = 8000, - pecanapi.docker_rabbitmq_frontend = "/rabbitmq", - pecanapi.docker_https = FALSE, - # Database settings (add_database) - pecanapi.db_hostname = "postgres", - pecanapi.db_user = "bety", - pecanapi.db_password = "bety", - pecanapi.db_dbname = "bety", - pecanapi.db_driver = "PostgreSQL", - pecanapi.db_dbfiles = "/data/dbfiles", - pecanapi.db_write = TRUE, - # Workflow options (insert_new_workflow) - pecanapi.workflow_hostname = "docker", - pecanapi.workflow_prefix = "/data/workflows/PEcAn_", - # RabbitMQ options (add_rabbitmq) - pecanapi.rabbitmq_user = "guest", - pecanapi.rabbitmq_password = "guest", - pecanapi.rabbitmq_service = "rabbitmq", - pecanapi.rabbitmq_service_port = 5672, - pecanapi.rabbitmq_vhost = "%2F" - ) - toset <- !(names(api_opts) %in% names(op)) - if (any(toset)) options(api_opts[toset]) - - invisible() -} diff --git a/api/inst/test_sipnet.R b/api/inst/test_sipnet.R deleted file mode 100644 index 7a1942b3c3e..00000000000 --- a/api/inst/test_sipnet.R +++ /dev/null @@ -1,44 +0,0 @@ -library(pecanapi) -import::from(magrittr, "%>%") - -options(pecanapi.user_id = 99000000002) - -# Establish database connection -con <- DBI::dbConnect( - RPostgres::Postgres(), - user = "bety", - password = "bety", - host = "localhost", - port = 5432 -) - -model_id <- get_model_id(con, "SIPNET", "136") -all_umbs <- search_sites(con, "umbs%disturbance") -site_id <- subset(all_umbs, !is.na(mat))[["id"]] -workflow <- insert_new_workflow(con, site_id, model_id, - start_date = "2004-01-01", - end_date = "2004-12-31") -workflow_id <- workflow[["id"]] - -settings <- list() %>% - add_workflow(workflow) %>% - add_database() %>% - add_pft("temperate.deciduous") %>% - add_rabbitmq(con = con) %>% - modifyList(list( - meta.analysis = list(iter = 3000, random.effects = FALSE), - run = list(inputs = list(met = list(source = "CRUNCEP", output = "SIPNET", method = "ncss"))), - ensemble = list(size = 1, variable = "NPP") - )) - -submit_workflow(settings) - -watch_workflow(workflow_id) -output <- workflow_output(workflow_id) - -sipnet_out <- ncdf4::nc_open(run_dap(workflow_id, "2004.nc")) -gpp <- ncdf4::ncvar_get(sipnet_out, "GPP") -time <- ncdf4::ncvar_get(sipnet_out, "time") -ncdf4::nc_close(sipnet_out) - -plot(time, gpp, type = "l") diff --git a/api/man/add_database.Rd b/api/man/add_database.Rd deleted file mode 100644 index 0d1c6c2244d..00000000000 --- a/api/man/add_database.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_database.R -\name{add_database} -\alias{add_database} -\title{Add PEcAn database information to settings list} -\usage{ -add_database(settings, host = getOption("pecanapi.db_hostname"), - user = getOption("pecanapi.db_user"), - password = getOption("pecanapi.db_password"), - dbname = getOption("pecanapi.db_dbname"), - driver = getOption("pecanapi.db_driver"), - dbfiles = getOption("pecanapi.db_dbfiles"), - write = getOption("pecanapi.db_write"), overwrite = FALSE, ...) -} -\arguments{ -\item{settings}{Input settings list (list)} - -\item{host}{Database server hostname (character, default = \code{pecanapi.db_hostname})} - -\item{user}{Database user name (character, default = option \code{pecanapi.db_username}))} - -\item{password}{Database password (character, default = option \code{pecanapi.db_password})} - -\item{dbname}{Database name (character, default = option \code{pecanapi.db_dbname})} - -\item{driver}{Database driver (character, default = option \code{pecanapi.db_driver})} - -\item{dbfiles}{Path to \code{dbfiles} directory (character, default = -option \code{pecanapi.db_dbfiles})} - -\item{write}{Whether or not to write to the database (logical, -default = option \code{pecanapi.db_write})} - -\item{overwrite}{Whether or not to overwrite any already existing -input settings (logical, default = \code{FALSE})} - -\item{...}{Additional named PEcAn database configuration tags} -} -\value{ -Updated settings list with database information included -} -\description{ -Add PEcAn database information to settings list -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/add_pft.Rd b/api/man/add_pft.Rd deleted file mode 100644 index eeae71df17a..00000000000 --- a/api/man/add_pft.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_pft.R -\name{add_pft} -\alias{add_pft} -\alias{add_pft_list} -\title{Add a PFT or list of PFTs to a settings object} -\usage{ -add_pft(settings, name, ...) - -add_pft_list(settings, pfts, ...) -} -\arguments{ -\item{settings}{Input PEcAn settings list} - -\item{name}{PFT name (character)} - -\item{...}{Additional arguments for modifying the PFT.} - -\item{pfts}{Either a character vector of PFT names, or a list of -PFT objects (which must each include an element named "name")} -} -\value{ -Updated settings list with PFTs added -} -\description{ -Add a PFT or list of PFTs to a settings object -} -\examples{ -settings <- list() -add_pft(settings, "Optics.Temperate_Early_Hardwood") -add_pft_list(settings, sprintf("Temperate_\%s_Hardwood", c("Early", "Mid", "Late"))) -add_pft_list( - settings, - list(list(name = "deciduous", num = 3), - list(name = "coniferous", num = 6)) -) -if (require("magrittr")) { - list() \%>\% - add_pft("early_hardwood") \%>\% - add_pft("mid_hardwood") \%>\% - add_pft("late_hardwood") -} -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/add_rabbitmq.Rd b/api/man/add_rabbitmq.Rd deleted file mode 100644 index b0cab4587b8..00000000000 --- a/api/man/add_rabbitmq.Rd +++ /dev/null @@ -1,58 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_rabbitmq.R -\name{add_rabbitmq} -\alias{add_rabbitmq} -\title{Add RabbitMQ configuration} -\usage{ -add_rabbitmq(settings, model_queue = NULL, con = NULL, - rabbitmq_user = getOption("pecanapi.rabbitmq_user"), - rabbitmq_password = getOption("pecanapi.rabbitmq_password"), - rabbitmq_service = getOption("pecanapi.rabbitmq_service"), - rabbitmq_service_port = getOption("pecanapi.rabbitmq_service_port"), - rabbitmq_vhost = getOption("pecanapi.rabbitmq_vhost"), - overwrite = FALSE) -} -\arguments{ -\item{settings}{Partially completed PEcAn \code{settings} list.} - -\item{model_queue}{Name of RabbitMQ model queue (character, default -= \code{NULL}). This should be in the form \code{modelname_modelrevision}. -If this is \code{NULL}, this function will try to figure it out based -on the model ID in the settings object, which requires access to -the database (i.e. \code{con} must not be \code{NULL}).} - -\item{con}{Database connection object (default = \code{NULL}). Ignored -unless \code{model_queue} is \code{NULL}.} - -\item{rabbitmq_user}{Username for RabbitMQ server (character, -default = option \code{pecanapi.rabbitmq_user})} - -\item{rabbitmq_password}{Password for RabbitMQ server (character, -default = option \code{pecanapi.rabbitmq_password})} - -\item{rabbitmq_service}{Name of RabbitMQ \code{docker-compose} service -(character, default = option \code{pecanapi.rabbitmq_service})} - -\item{rabbitmq_service_port}{RabbitMQ service port (numeric or -character, default = option \code{pecanapi.rabbitmq_service_port}). -Note that this is internal to the Docker stack, \emph{not}. The only -reason this should be changed is if you changed low-level -RabbitMQ settings in the \code{docker-compose.yml} file} - -\item{rabbitmq_vhost}{RabbitMQ vhost (character, default = option -\code{pecanapi.rabbitmq_vhost}). The only reason this should be -changed is if you change the low-level RabbitMQ setup in the -\code{docker-compose.yml} file.} - -\item{overwrite}{Whether or not to overwrite existing \code{settings} -tags (logical; default = \code{FALSE})} -} -\value{ -Modified settings list with RabbitMQ configuration added. -} -\description{ -Add RabbitMQ configuration -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/add_workflow.Rd b/api/man/add_workflow.Rd deleted file mode 100644 index 7b442f37d9e..00000000000 --- a/api/man/add_workflow.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_workflow.R -\name{add_workflow} -\alias{add_workflow} -\title{Add information from workflow data frame into settings list.} -\usage{ -add_workflow(settings, workflow_df, overwrite = FALSE) -} -\arguments{ -\item{settings}{Partially completed PEcAn \code{settings} list.} - -\item{workflow_df}{Workflow \code{data.frame}, such as that returned by -\link{insert_new_workflow}, or from running query \code{SELECT * FROM workflows}} - -\item{overwrite}{Whether or not to overwrite existing \code{settings} -tags (logical; default = \code{FALSE})} -} -\value{ -PEcAn settings list with workflow information added -} -\description{ -Add information from workflow data frame into settings list. -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/dbfile_url.Rd b/api/man/dbfile_url.Rd deleted file mode 100644 index 97f593ce7cf..00000000000 --- a/api/man/dbfile_url.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/thredds_fileserver.R -\name{dbfile_url} -\alias{dbfile_url} -\title{Build a THREDDS fileServer URL for a specific dbfile} -\usage{ -dbfile_url(target, ...) -} -\arguments{ -\item{target}{Target file path, relative to \code{dbfiles} root folder (character)} - -\item{...}{Additional arguments to \link{thredds_fs_url}} -} -\value{ -THREDDS HTTP fileServer URL to dbfile (character) -} -\description{ -Build a THREDDS fileServer URL for a specific dbfile -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/get_model_id.Rd b/api/man/get_model_id.Rd deleted file mode 100644 index 457c7155157..00000000000 --- a/api/man/get_model_id.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_model_id.R -\name{get_model_id} -\alias{get_model_id} -\title{Retrieve database ID of a particular version of a model} -\usage{ -get_model_id(con, name, revision, multi_action = "last") -} -\arguments{ -\item{con}{Database connection object (Pqconnection)} - -\item{name}{Model name (character)} - -\item{revision}{Model version/revision (character)} - -\item{multi_action}{Action to take if multiple models found -(character). Must be one of "first", "last" (default), "all", or "error".} -} -\value{ -Model ID, as \code{integer64} -} -\description{ -Retrieve database ID of a particular version of a model -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/get_next_workflow_id.Rd b/api/man/get_next_workflow_id.Rd deleted file mode 100644 index b8030f92060..00000000000 --- a/api/man/get_next_workflow_id.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/insert_new_workflow.R -\name{get_next_workflow_id} -\alias{get_next_workflow_id} -\title{Get current workflow ID and update internal workflow ID PostgreSQL -sequence} -\usage{ -get_next_workflow_id(con) -} -\arguments{ -\item{con}{Database connection, as created by \link[RPostgres:dbConnect]{RPostgres::dbConnect}} -} -\value{ -Workflow ID, as numeric/base64 integer -} -\description{ -The \code{workflows} table has an internal -\href{https://www.postgresql.org/docs/9.6/sql-createsequence.html}{sequence} -that keeps track of and automatically updates the workflow ID -(that's why inserting into the table without explicitly setting a -workflow ID is a safe and robust operation). This function is a -wrapper around the -\href{https://www.postgresql.org/docs/9.6/functions-sequence.html}{nextval function}, -which retrieves the current value of the sequence \emph{and} augments -the sequence by 1. -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/get_run_id.Rd b/api/man/get_run_id.Rd deleted file mode 100644 index dbdc0c80918..00000000000 --- a/api/man/get_run_id.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/thredds_fileserver.R -\name{get_run_id} -\alias{get_run_id} -\title{Get a run ID from the \code{runs.txt} file} -\usage{ -get_run_id(workflow_id, ...) -} -\arguments{ -\item{workflow_id}{ID of target workflow (numeric or character)} - -\item{...}{Additional arguments to \link{thredds_fs_url}} -} -\value{ -A single output ID (integer64) -} -\description{ -Get a run ID from the \code{runs.txt} file -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/insert_new_workflow.Rd b/api/man/insert_new_workflow.Rd deleted file mode 100644 index b5b4d3850a9..00000000000 --- a/api/man/insert_new_workflow.Rd +++ /dev/null @@ -1,52 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/insert_new_workflow.R -\name{insert_new_workflow} -\alias{insert_new_workflow} -\title{Insert a new workflow into PEcAn database, returning the workflow -as a \code{data.frame}} -\usage{ -insert_new_workflow(con, site_id, model_id, start_date, end_date, - user_id = getOption("pecanapi.user_id"), - hostname = getOption("pecanapi.workflow_hostname"), - folder_prefix = getOption("pecanapi.workflow_prefix"), params = NULL, - notes = NULL) -} -\arguments{ -\item{con}{Database connection, as created by \link[RPostgres:dbConnect]{RPostgres::dbConnect}} - -\item{site_id}{Site ID from \code{sites} table (numeric)} - -\item{model_id}{Model ID from \code{models} table (numeric)} - -\item{start_date}{Model run start date (character or POSIX)} - -\item{end_date}{Model run end date (character or POSIX)} - -\item{user_id}{User ID from \code{users} table (default = option -\code{pecanapi.user_id}). Note that this option is \emph{not set by -default}, and this function will not run without a set \code{user_id}.} - -\item{hostname}{Workflow server hostname (character; default = -option \code{pecanapi.workflow_hostname})} - -\item{folder_prefix}{Output directory prefix (character; default = -option \code{pecanapi.workflow_prefix}). Workflow ID will be appended -to the end with \code{paste0}} - -\item{params}{Additional workflow parameters, stored in -\code{workflows.params} (character or NULL (default))} - -\item{notes}{Additional workflow notes, stored in \code{workflows.notes} -(character or NULL (default))} -} -\value{ -\code{data.frame} containing new workflow(s), including all -columns from \code{workflows} table. -} -\description{ -Insert a new workflow into PEcAn database, returning the workflow -as a \code{data.frame} -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/listToXML.Rd b/api/man/listToXML.Rd deleted file mode 100644 index 8ce76805720..00000000000 --- a/api/man/listToXML.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/submit_workflow.R -\name{listToXML} -\alias{listToXML} -\title{Convert List to XML} -\usage{ -listToXML(item, tag) -} -\arguments{ -\item{item}{object to be converted. Despite the function name, need not actually be a list} - -\item{tag}{xml tag} -} -\value{ -xmlNode -} -\description{ -Can convert list or other object to an xml object using xmlNode -} -\author{ -David LeBauer, Carl Davidson, Rob Kooper -} diff --git a/api/man/list_runs.Rd b/api/man/list_runs.Rd deleted file mode 100644 index 6f8afcb1b95..00000000000 --- a/api/man/list_runs.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_runs.R -\name{list_runs} -\alias{list_runs} -\title{List all runs associated with a particular workflow} -\usage{ -list_runs(con, workflow_id) -} -\arguments{ -\item{con}{Database connection, as created by \link[RPostgres:dbConnect]{RPostgres::dbConnect}} - -\item{workflow_id}{ID of target workflow (character or numeric)} -} -\value{ -Runs \code{data.frame} subset to rows containing specific workflow -} -\description{ -List all runs associated with a particular workflow -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/output_url.Rd b/api/man/output_url.Rd deleted file mode 100644 index 91513363571..00000000000 --- a/api/man/output_url.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/thredds_fileserver.R -\name{output_url} -\alias{output_url} -\title{Build URL for output file hosted on THREDDS fileServer} -\usage{ -output_url(workflow_id, target, ...) -} -\arguments{ -\item{workflow_id}{ID of target workflow (numeric or character)} - -\item{target}{Target path, relative to workflow directory (character)} - -\item{...}{Additional arguments to \link{thredds_fs_url}} -} -\value{ -THREDDS http fileServer URL (character) -} -\description{ -Build URL for output file hosted on THREDDS fileServer -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/pecanapi_options.Rd b/api/man/pecanapi_options.Rd deleted file mode 100644 index 2157f7538eb..00000000000 --- a/api/man/pecanapi_options.Rd +++ /dev/null @@ -1,63 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/zzz.R -\name{pecanapi_options} -\alias{pecanapi_options} -\title{Package-specific options} -\description{ -To minimize the number of changes that have to happen for scripts -using \code{pecanapi} to be shared across machines, most -Docker/RabbitMQ/database-related configurations can be configured -via \code{options}. All options take the form \code{pecanapi.optionname}, -where \code{optionname} is the specific option. Note that these values -are used only as default function arguments, and can be substituted -for any individual function call by passing the appropriate argument. -} -\details{ -The following options (prefixed with \code{pecanapi.}) are used by -\code{pecanapi}. To see the default values, just call \code{options()} with -no arguments. These are sorted in order of decreasing likelihood of -needing to be set by the user (first options are most likely to be -changed across different systems): - --\code{pecanapi.user_id} -- The User ID to associate with all workflows -created by this package. This is the only option that \emph{must} be set -by the user -- it is set to \code{NULL} by default, which will cause -many of the functions in the \code{pecanapi} to fail. -\itemize{ -\item \code{docker_hostname}, \code{docker_port} -- The hostname and port of the -Docker service. You can check that these values work by browsing to -\code{docker_hostname:docker_port} (by default, \code{localhost:8000}) in a -web browser. -\item \code{docker_rabbitmq_frontend} -- The "frontend rule" for RabbitMQ. -By default, this is \code{/rabbitmq}, meaning that the RabbitMQ console -is accessible at \code{localhost:8000/rabbitmq} (adjusted for whatever -combination of \code{docker_hostname} and \code{docker_port} you are using). -} - -\code{docker_https} -- (Logical) If \code{TRUE}, all URLs use \code{https} access. -By default, this is \code{FALSE}. -\itemize{ -\item \code{db_hostname} -- The name of the PostgreSQL container service -inside the PEcAn stack. This is the same as its service name in -\code{docker-compose.yml}. This is the hostname used by the \code{executor} -service to access the database, and which is written into each -\code{pecan.xml} file. -\item \code{db_user}, \code{db_password}, \code{db_dbname}, \code{db_driver}, \code{db_write} -- -These correspond to the \code{user}, \code{password}, \code{dbname}, \code{driver}, and -\code{write} tags in the \code{database/bety} part of the PEcAn XML. -\item \code{rabbitmq_user}, \code{rabbitmq_password} -- The RabbitMQ -authentication credentials. These are set in the -\code{docker-compose.yml} file, under the \code{rabbitmq} service. -\item \code{rabbitmq_service}, \code{rabbitmq_service_port}, \code{rabbitmq_vhost} -- -The name, internal port, and \code{vhost} of the RabbitMQ service. -Unless you are making major changes to the guts of -\code{docker-compose.yml}, you shouldn't change these values (i.e. they -should be the same on most machines). -\item \code{workflow_hostname} -- The hostname passed to the \code{host} section -of the \code{pecan.xml}. By default, this is "docker". -\item \code{workflow_prefix} -- The location and directory prefix for -storing workflow outputs. By default, this is -\code{/data/workflows/PEcAn_}. The workflow ID will be appended directly -to this value. -} -} diff --git a/api/man/prepared_query.Rd b/api/man/prepared_query.Rd deleted file mode 100644 index 22958e4c996..00000000000 --- a/api/man/prepared_query.Rd +++ /dev/null @@ -1,76 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/prepared_query.R -\name{prepared_query} -\alias{prepared_query} -\alias{prepared_statement} -\title{Execute a PostgreSQL prepared query or statement} -\usage{ -prepared_query(con, query, params) - -prepared_statement(con, query, params) -} -\arguments{ -\item{con}{Database connection, as created by \link[RPostgres:dbConnect]{RPostgres::dbConnect}} - -\item{query}{Query template (character, length 1)} - -\item{params}{Query parameters (unnamed list)} -} -\value{ -For \code{prepared_query}, the query result as a \code{data.frame}. -\code{prepared_statement} exits silently on success. -} -\description{ -This provides a safe and efficient way of executing a query or -statement with a list of parameters to be substituted. -} -\details{ -A prepared statement consists of a template query (\code{query}), which -is compiled prior to execution, and a series of parameters -(\code{params}) that are passed into the relevant spots in the template -query. In R's \code{DBI} database interface, this uses three statements: -\link[DBI:dbSendQuery]{DBI::dbSendQuery} to create the template query, \link[DBI:dbBind]{DBI::dbBind} to -bind parameters to that query, and \link[DBI:dbFetch]{DBI::dbFetch} to retrieve the -results. Statements (\link[DBI:dbSendStatement]{DBI::dbSendStatement}) work the same way, -except there are no results to fetch with \link[DBI:dbFetch]{DBI::dbFetch}. - -Prepared statements have several important advantages. First of -all, they are automatically and efficiently vectorized, meaning -that it is possible to build a single query and run it against a -vector of parameters. Second, they automatically enforce strict -type checking and quoting of inputs, meaning that they are secure -against SQL injection attacks and input mistakes (e.g. giving a -character when the table expects a number). -} -\examples{ -\dontrun{ -prepared_query(con, paste( - "SELECT id, folder FROM workflows", - "WHERE user_id = $1" -), list(my_user_id)) - -prepared_statement(con, paste( - "INSERT INTO workflows (id, site_id, model_id, folder)", - "VALUES ($1, $2, $3, $4)" -), list(workflow_id, my_site_id, my_model_id, my_folder)) - -# Note that queries and statements are automatically vectorized -# The below query will execute two searches, and return the results -# of both in one data.frame -prepared_query(con, paste( - "SELECT * FROM dbfiles", - "WHERE file_name ILIKE $1", -), list(c("\%cruncep\%", "\%gfdl\%"))) - -# Similarly, this will create two workflows, all with the same - model_id (1) but different site_ids (33, 67) -prepared_statement(con, paste( - "INSERT INTO workflows (site_id, model_id)", - "VALUES ($1, $2)" -), list(c(33, 67), 1)) - -} -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/run_dap.Rd b/api/man/run_dap.Rd deleted file mode 100644 index d9d8fd6fdaa..00000000000 --- a/api/man/run_dap.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/thredds_opendap.R -\name{run_dap} -\alias{run_dap} -\title{Create a THREDDS OpenDAP access URL to a specific model output file} -\usage{ -run_dap(workflow_id, target, run_id = NULL, ...) -} -\arguments{ -\item{workflow_id}{ID of target workflow (numeric or character)} - -\item{target}{Target file path, relative to output directory of -specific run (as specified by \code{run_id})} - -\item{run_id}{Run ID (numeric or character). If \code{NULL}, try to use -the run listed in the \code{runs.txt} file. If multiple runs are -available, throw a warning and use the first one.} - -\item{...}{Additional arguments to \link{thredds_fs_url}} -} -\value{ -OpenDAP URL to target file (character) -} -\description{ -Create a THREDDS OpenDAP access URL to a specific model output file -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/run_url.Rd b/api/man/run_url.Rd deleted file mode 100644 index 38a34deb6c5..00000000000 --- a/api/man/run_url.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/thredds_fileserver.R -\name{run_url} -\alias{run_url} -\title{Build a THREDDS fileServer URL for a specific output file from a -specific run} -\usage{ -run_url(workflow_id, target, run_id = NULL, ...) -} -\arguments{ -\item{workflow_id}{ID of target workflow (numeric or character)} - -\item{target}{Target file path, relative to output directory of -specific run (as specified by \code{run_id})} - -\item{run_id}{Run ID (numeric or character). If \code{NULL}, try to use -the run listed in the \code{runs.txt} file. If multiple runs are -available, throw a warning and use the first one.} - -\item{...}{Additional arguments to \link{thredds_fs_url}} -} -\value{ -HTTP fileServer URL of a particular run output file (character) -} -\description{ -Build a THREDDS fileServer URL for a specific output file from a -specific run -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/search.Rd b/api/man/search.Rd deleted file mode 100644 index 5a823c49d80..00000000000 --- a/api/man/search.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/search.R -\name{search_models} -\alias{search_models} -\alias{search_sites} -\alias{search_pfts} -\title{Search for sites or models} -\usage{ -search_models(con, name = "", revision = "", modeltype = "", - auto_pct = TRUE, ignore.case = TRUE) - -search_sites(con, sitename = "", auto_pct = TRUE, ignore.case = TRUE) - -search_pfts(con, name = "", definition = "", modeltype = "", - auto_pct = TRUE, ignore.case = TRUE) -} -\arguments{ -\item{con}{Database connection, as created by \link[RPostgres:dbConnect]{RPostgres::dbConnect}} - -\item{name}{Model/PFT (depending on function) name search string (character)} - -\item{revision}{Model version search string (character)} - -\item{modeltype}{Model type search string (character)} - -\item{auto_pct}{Logical. If \code{TRUE} (default), automatically -surround search strings in \code{\%}. If this is \code{FALSE}, you should -explicitly specify \code{"\%\%"} for one or both other arguments.} - -\item{ignore.case}{Logical. If \code{TRUE} (default) use -case-insensitive search (SQL \code{ILIKE} operator); otherwise, use -case-sensitive search (SQL \code{LIKE} operator).} - -\item{sitename}{Model name search string (character)} - -\item{definition}{PFT definition search string (character)} -} -\value{ -Bety \code{models} table (\code{data.frame}) subset to matching model -name or version -} -\description{ -Search for sites or models -} -\examples{ -\dontrun{ -search_models(con, "SIPNET") - -# Partial match -search_models(con, "ED") -search_models(con, modeltype = "ED") -search_sites(con, "UMBS") -search_pfts(con, "early", modeltype = "ED") - -# Case sensitivity -search_models(con, "ed") -search_models(con, "ed", ignore.case = FALSE) - -# Starts with UMBS -search_sites(con, "UMBS\%", auto_pct = FALSE) - -# SQL wildcards can still be used inside search strings. -search_pfts(con, "early\%hardwood") -} -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/submit_workflow.Rd b/api/man/submit_workflow.Rd deleted file mode 100644 index 5e7fd97f636..00000000000 --- a/api/man/submit_workflow.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/submit_workflow.R -\name{submit_workflow} -\alias{submit_workflow} -\title{Post complete settings list as RabbitMQ message} -\usage{ -submit_workflow(settings, - rabbitmq_hostname = getOption("pecanapi.docker_hostname"), - rabbitmq_frontend = getOption("pecanapi.docker_rabbitmq_frontend"), - rabbitmq_port = getOption("pecanapi.docker_port"), - rabbitmq_user = getOption("pecanapi.rabbitmq_user"), - rabbitmq_password = getOption("pecanapi.rabbitmq_password"), - rabbitmq_prefix = NULL, httr_auth = TRUE, - https = getOption("pecanapi.docker_https")) -} -\arguments{ -\item{settings}{PEcAn settings list object} - -\item{rabbitmq_hostname}{RabbitMQ server hostname (character. -Default = \code{"localhost"})} - -\item{rabbitmq_port}{RabbitMQ server port (character or numeric. -Default = option \code{pecanapi.docker_port})} - -\item{rabbitmq_user}{RabbitMQ user name (character. Default = -option \code{pecanapi.rabbitmq_user})} - -\item{rabbitmq_password}{RabbitMQ password (character. Default = -option \code{pecanapi.rabbitmq_password})} - -\item{rabbitmq_prefix}{Complete RabbitMQ API prefix. If \code{NULL} -(default), this is constructed from the other arguments. If this -argument is not \code{NULL}, it overrides all other arguments except -\code{httr_auth} and \code{settings}.} - -\item{httr_auth}{Whether or not to use \link[httr:authenticate]{httr::authenticate} to -generate CURL authentication (default = \code{TRUE}). If \code{FALSE}, you -must pass the authentication as part of the RabbitMQ hostname or prefix.} - -\item{https}{Whether or not to use \code{https}. If \code{FALSE}, use \code{http}. -Default = option \code{pecanapi.docker_https}} -} -\value{ -Curl \code{POST} output, parsed by \link[httr:content]{httr::content} -} -\description{ -Post complete settings list as RabbitMQ message -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/thredds_dap_url.Rd b/api/man/thredds_dap_url.Rd deleted file mode 100644 index ae4e884039e..00000000000 --- a/api/man/thredds_dap_url.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/thredds_opendap.R -\name{thredds_dap_url} -\alias{thredds_dap_url} -\title{Create a THREDDS OpenDAP access URL to a PEcAn file} -\usage{ -thredds_dap_url(target, hostname = getOption("pecanapi.docker_hostname"), - port = getOption("pecanapi.docker_port"), - https = getOption("pecanapi.docker_https")) -} -\arguments{ -\item{target}{Full path to target (character) relative to THREDDS -root. For outputs, this should start with "outputs/", and for -dbfiles, "dbfiles/".} - -\item{hostname}{THREDDS server hostname (default = "localhost")} - -\item{port}{THREDDS server port (default = 8000)} - -\item{https}{Logical. If \code{TRUE}, use https, otherwise use http -(default = \code{FALSE}).} -} -\value{ -OpenDAP URL to target file (character) -} -\description{ -Create a THREDDS OpenDAP access URL to a PEcAn file -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/thredds_fs_url.Rd b/api/man/thredds_fs_url.Rd deleted file mode 100644 index 10b9add60c0..00000000000 --- a/api/man/thredds_fs_url.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/thredds_fileserver.R -\name{thredds_fs_url} -\alias{thredds_fs_url} -\title{Create a THREDDS fileServer URL prefix} -\usage{ -thredds_fs_url(hostname = getOption("pecanapi.docker_hostname"), - port = getOption("pecanapi.docker_port"), - https = getOption("pecanapi.docker_https")) -} -\arguments{ -\item{hostname}{THREDDS server hostname (default = "localhost")} - -\item{port}{THREDDS server port (default = 8000)} - -\item{https}{Logical. If \code{TRUE}, use https, otherwise use http -(default = \code{FALSE}).} -} -\value{ -THREDDS fileServer URL prefix (character) -} -\description{ -Create a THREDDS fileServer URL prefix -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/watch_workflow.Rd b/api/man/watch_workflow.Rd deleted file mode 100644 index dbc309eefc0..00000000000 --- a/api/man/watch_workflow.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/watch_progress.R -\name{watch_workflow} -\alias{watch_workflow} -\title{Continuously monitor the progress of a workflow until it completes. -To exit early, send an interrupt signal (Control-C).} -\usage{ -watch_workflow(workflow_id, nlines = 10, sleep = 3, ...) -} -\arguments{ -\item{workflow_id}{Workflow ID (character or numeric)} - -\item{nlines}{Print the last N lines (numeric, default = 10)} - -\item{sleep}{Number of seconds to sleep between status updates -(numeric, default = 3)} - -\item{...}{Additional arguments to \link{output_url}} -} -\value{ -If successful -} -\description{ -Continuously monitor the progress of a workflow until it completes. -To exit early, send an interrupt signal (Control-C). -} -\author{ -Alexey Shiklomanov -} diff --git a/api/man/workflow_output.Rd b/api/man/workflow_output.Rd deleted file mode 100644 index c4bd32cdae4..00000000000 --- a/api/man/workflow_output.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/watch_progress.R -\name{workflow_output} -\alias{workflow_output} -\title{Retrieve the current output of a workflow given its ID} -\usage{ -workflow_output(workflow_id, ...) -} -\arguments{ -\item{workflow_id}{Workflow ID (character or numeric)} - -\item{...}{Additional arguments to \link{output_url}} -} -\value{ -Workflow output, as character vector with one item per line -in \code{workflow.Rout} (as returned by \code{readLines}). -} -\description{ -Retrieve the current output of a workflow given its ID -} -\author{ -Alexey Shiklomanov -} diff --git a/api/vignettes/pecanapi.Rmd b/api/vignettes/pecanapi.Rmd deleted file mode 100644 index bfcaf7577eb..00000000000 --- a/api/vignettes/pecanapi.Rmd +++ /dev/null @@ -1,302 +0,0 @@ ---- -title: Introduction to the PEcAn R API -author: Alexey Shiklomanov ---- - -# Introduction to the PEcAn R API {#pecanapi-vignette} - -```{r, include = FALSE, eval = TRUE} -op_default <- knitr::opts_chunk$get(default = TRUE) -knitr::opts_chunk$set(op_default) -``` - -## Introduction - -The PEcAn API package (`pecanapi`) is designed to allow users to submit PEcAn workflows directly from an R session. -The basic idea is that users build the PEcAn settings object via an R script (manually, or using the included helper functions) and then use the RabbitMQ API to send this object to a Dockerized PEcAn instance running on a local or remote machine. - -`pecanapi` is specifically designed to only depend on CRAN packages, and not on any PEcAn internal packages. -This makes it easy to install, and allows it to be used without needing to download and install PEcAn itself (which is large and has many complex R package and system dependencies). -It can be installed directly from GitHub as follows: - -```{r, eval = 2} -devtools::install_github("pecanproject/pecan", subdir = "api") -library(pecanapi) -``` - -This vignette covers the following major sections: - -- [Initial setup](#pecanapi-setup) goes over the configuration, both inside and outside R, required to make `pecanapi` work. -- [Registering a workflow](#pecanapi-workflow) goes over how to register a PEcAn workflow with the PEcAn database, including searching for the required site and model IDs -- [Building a settings object](#pecanapi-settings) covers how to configure a PEcAn workflow using the PEcAn settings list. -- Finally, [submitting a run](#pecanapi-submit) covers how to submit the complete settings object for execution. - -## Initial setup {#pecanapi-setup} - -This tutorial assumes you are running a Dockerized instance of PEcAn on your local machine (hostname `localhost`, port 8000). -To check this, open a browser and try to access `http://localhost:8000/pecan/`. -If you are trying to access a remote instance of PEcAn, you will need to substitute the hostname and port accordingly. - -To perform database operations, you will also need to have read access to the PEcAn database. -Note that the PEcAn database Docker container (`postgres`) does not provide this by default, so you will need to open port 5432 (the PostgreSQL default) to that container. -You can do this by creating a `docker-compose.override.yml` file with the following contents in the root directory of the PEcAn source code: - -```yml -version: "3" -services: - postgres: - ports: - - 5432:5432 -``` - -Here, the first port is the one used to access the database (can be any open port; most PostgreSQL applications assume 5432 by default), and the second is the port the database is actually running on (which will always be 5432). -After making this change, reload the `postgres` container by running `docker-compose up -d`. -To check that this works, open an R session and try to create a database connection object to the PEcAn database. - -```{r, eval = FALSE} -con <- DBI::dbConnect( - RPostgres::Postgres(), - user = "bety", - password = "bety", - host = "localhost", - port = 5432 -) -DBI::dbListTables(con)[1:5] -``` - -This code should print out five table names from the PEcAn database. -If it throws an error, you have a problem with your database connection. - -The rest of this tutorial assumes that you are using this same database connection object (`con`). - -In addition, any API operations that modify the database will not work unless a user ID is set. -To avoid having to manually specify the ID each time, we can set it via `options`: - -```{r, eval = FALSE} -options(pecanapi.user_id = 99000000002) -``` - -The `pecanapi` package has many other options that it uses for its default configuration, including the Docker server and RabbitMQ hostname and credentials. -To learn more about them, see `?pecanapi_options`. - -## Registering a workflow with the database {#pecanapi-workflow} - -For the PEcAn workflow to work, it needs to be registered with the PEcAn database. -In `pecanapi`, this is done via the `insert_new_workflow` function. - -Building a workflow requires two important pieces of information: the model and site IDs. -If you know these for your site and model, you can pass them directly into `insert_new_workflow`. -However, chances are you may have to look them up in the database first. -`pecanapi` provides several `search_*` utilities to make this easier. - -First, let's pick a model. -To list all models, we can run `search_models` with no arguments (other than the database connection object, `con`). - -```{r, eval = FALSE} -models <- search_models(con) -``` - -We can narrow down our search by model name, revision, or "type". - -```{r, eval = FALSE} -search_models(con, "ED") -search_models(con, "sipnet") -search_models(con, "ED", revision = "git") -``` - -Note that the search is case-insensitive by default, and searches before and after the input string. -See `?search_models` to learn how to toggle this behavior. -For the purposes of this tutorial, let's use the SIPNET model because it has low input requirements and runs very quickly. -Specifically, let's use the `136` version. -We could grab the model ID from the search results, but `pecanapi` also provides an additional helper function for retrieving model IDs if you know the exact name and revision. - -```{r, eval = FALSE} -model_id <- get_model_id(con, "SIPNET", "136") -model_id -``` - -We can repeat this process for sites with the `search_sites` function (though there is currently no `get_site_id` function). -Note the use of `%` as a wildcard (matches zero or more of any character, equivalent to the regular expression `.*`). -The two sites in the search below are largely identical, so we'll use the one with more site information (i.e. where `mat` is not `NA`). - -```{r, eval = FALSE} -all_umbs <- search_sites(con, "umbs%disturbance") -all_umbs -site_id <- subset(all_umbs, !is.na(mat))[["id"]] -``` - -With site and model IDs in hand, we are ready to create a workflow. - -```{r, eval = FALSE} -workflow <- insert_new_workflow(con, site_id, model_id, start_date = "2004-01-01", end_date = "2004-12-31") -workflow -``` - -The `insert_new_workflow` function inserts the workflow into the database and returns a `data.frame` containing the row that was inserted. - - -## Building a settings object {#pecanapi-settings} - -Now that we have a workflow registered, we need to configure it via the PEcAn settings list. -The PEcAn settings list is a nested list providing parameters for the various actions performed by the PEcAn workflow, including the trait meta-analysis, processing input files, and running models. -It can be created manually with a bunch of `list` calls. -However, this is tedious and error-prone, so `pecanapi` provides several utilities that facilitate this process. - -We start with a blank list. - -```{r} -settings <- list() -``` - -Let's start by adding the workflow we created in the previous section to this list. -This is done via the `add_workflow` function, which takes as input a workflow `data.frame` and adds the relevant fields to the right places in the settings list. - -```{r, eval = FALSE} -settings <- add_workflow(settings, workflow) -``` - -All `add_*` functions work by incrementally adding to an input settings object and returning a new modified settings object. -The first argument of these functions is always the settings list, which gives these functions a consistent syntax and makes it easy to string multiple settings modifications together using the `magrittr` pipe (`%>%`), similar to `tidyverse` tabular data manipulations. - -Let's continue by adding a basic database configuration to this settings list. - -```{r} -settings <- add_database(settings) -settings -``` - -The `add_database` function adds a sensible default configuration for the PEcAn database in the right place with the right names in the settings file. -These defaults can, of course, be modified in the function call (see `?add_database`), or, better yet, by setting package options, which is where most `add_*` functions get their defaults (see `?pecanapi_options`). - -Similarly, `add_rabbitmq` automatically adds the RabbitMQ configuration to the settings object. -Like `add_database`, it takes all of its defaults from `options` (see `?pecanapi_options`). - -```{r} -settings <- add_rabbitmq(settings) -settings -``` - -PFTs are added to the settings object with the `add_pft` function. -To search for PFTs, use the `search_pfts` function, which can take optional arguments for PFT name (`name`), description of its definition (`definition`), and model type (`modeltype`). - -```{r, eval = FALSE} -search_pfts(con, name = "deciduous", modeltype = "sipnet") -search_pfts(con, name = "tundra", modeltype = "ED") -``` - -As with `search_models` and `search_sites`, these functions are case insensitive and do partial matching by default. -The `add_pft` function adds individual PFTs by name. - -```{r} -settings <- add_pft(settings, "temperate.deciduous") -settings -``` - -This adds the `temperate.deciduous` PFT to the appropriate spot in the settings hierarchy. -Whereas `add_pft` adds a single PFT to the settings, `add_pft_list` can add a vector of PFTs. - -```{r} -settings <- add_pft_list(settings, c("temperate.coniferous", "miscanthus")) -settings -``` - -Like `add_database`, `add_pft` and `add_pft_list` can also take arbitrary additional configuration arguments via their `...` argument. -For `add_pft`, such arguments are passed only to that PFT, while for `add_pft_list`, they are shared between all PFTs. -For more details, see `?add_pft`. - -One final note is that, because the settings object is just a list, you can make arbitrary modifications to it via base R's `modifyList` function (indeed, many of the `pecanapi::add_*` functions use `modifyList` under the hood). - -```{r} -customization <- list( - meta.analysis = list(iter = 3000, random.effects = FALSE), - run = list( - inputs = list(met = list(source = "CRUNCEP", output = "SIPNET", method = "ncss")) - ) - ) -settings <- modifyList(settings, customization) -``` - -Note that `modifyList` operates recursively on nested lists, which makes it easy to modify settings at different levels of the list hierarchy. -For instance, below, we modify the previous settings object to make `random.effects = TRUE`, and change the download method of the `inputs` to OpenDAP, but keep all the other settings the same. - -```{r} -settings <- modifyList(settings, list( - meta.analysis = list(random.effects = TRUE), - run = list(inputs = list(met = list(method = "opendap"))) -)) -``` - -All of these steps can be chained together via `magrittr` pipes (`%>%`). - -```{r, eval = FALSE} -library(magrittr) -settings <- list() %>% - add_workflow(workflow) %>% - add_database() %>% - add_rabbitmq() %>% - add_pft("temperate.deciduous") %>% - add_pft("temperate.coniferous") %>% - modifyList(list( - meta.analysis = list(iter = 3000, random.effects = FALSE), - run = list(inputs = list(met = list(source = "CRUNCEP", output = "SIPNET", method = "ncss"))), - host = list(rabbitmq = list( - uri = "amqp://guest:guest@rabbitmq:5672/%2F", - queue = "SIPNET_136" - )) - )) -``` - -## Submitting a run {#pecanapi-submit} - -Now that we have all the pieces, let's put them together into a single settings object. - -```{r, eval = FALSE} -settings <- list() %>% - add_workflow(workflow) %>% - add_database() %>% - add_pft("temperate.deciduous") %>% - modifyList(list( - meta.analysis = list(iter = 3000, random.effects = FALSE), - run = list(inputs = list(met = list(source = "CRUNCEP", output = "SIPNET", method = "ncss"))), - host = list(rabbitmq = list( - uri = "amqp://guest:guest@rabbitmq:5672/%2F", - queue = "SIPNET_136" - )) - )) -``` - -We can then submit these settings as a run via the `submit_workflow` function. -This function has only one required input -- the settings list -- but a number of optional arguments for specifying how to connect to the RabbitMQ API (see `?submit_workflow` for details). - -```{r, eval = FALSE} -submit_workflow(settings) -``` - -If the workflow was submitted successfully, this will return the HTTP response `routed = TRUE` as a named list. -Note that this only means that the RabbitMQ message was posted; the workflow can still crash for various reasons. -To see the status of the workflow, look at `docker-compose logs executor` or use the Portainer interface. - -## Processing output {#pecanapi-output} - -All of PEcAn's outputs as well as its database files (`dbfiles`) can be accessed remotely via the THREDDS data server. -You can explore these files by browsing to `localhost:8000/thredds/` in a browser (substituting hostname and port, accordingly). - -All files, regardless of file type, can be downloaded directly (via HTTP) through the THREDDS `fileServer` protocol. -In `pecanapi`, URLs for these files can be easily constructed via `output_url` for any workflow output and `run_url` for run-specific outputs. -For instance, to read the `workflow.Rout` file from the workflow we created earlier, you can do the following: - -```{r, eval = FALSE} -workflow_id <- workflow[["id"]] -readLines(workflow_id, "workflow.Rout") -``` - -Outputs in NetCDF format can also be accessed via the OpenDAP service, which allows remote variable selection and subsetting (meaning you can only download the outputs you need without needing to download the entire file). -These URLs are created via the `thredds_dap_url` (for a generic URL) or `run_dap` (to access outputs from a specific model run). - -```{r, eval = FALSE} -sipnet_out <- ncdf4::nc_open(run_dap(workflow_id, "2004.nc")) -gpp <- ncdf4::ncvar_get(sipnet_out, "GPP") -time <- ncdf4::ncvar_get(sipnet_out, "time") -ncdf4::nc_close(sipnet_out) -plot(time, gpp, type = "l") -``` diff --git a/apps/api/Dockerfile b/apps/api/Dockerfile new file mode 100644 index 00000000000..81a756fbee9 --- /dev/null +++ b/apps/api/Dockerfile @@ -0,0 +1,39 @@ +# this needs to be at the top, what version are we building +ARG IMAGE_VERSION="latest" + + +# -------------------------------------------------------------------------- +# PECAN FOR MODEL BASE IMAGE +# -------------------------------------------------------------------------- +FROM pecan/base:${IMAGE_VERSION} +LABEL maintainer="Tezan Sahu " + +EXPOSE 8000 + +# -------------------------------------------------------------------------- +# Variables to store in docker image (most of them come from the base image) +# -------------------------------------------------------------------------- + +# COMMAND TO RUN +RUN apt-get update \ + && apt-get install libsodium-dev -y \ + && rm -rf /var/lib/apt/lists/* \ + && Rscript -e "devtools::install_version('promises', '1.1.0')" \ + && Rscript -e "devtools::install_version('webutils', '1.1')" \ + && Rscript -e "install.packages('pool')" \ + && Rscript -e "devtools::install_github('rstudio/swagger')" \ + && Rscript -e "devtools::install_github('rstudio/plumber')" + +ENV AUTH_REQ="TRUE" \ + HOST_ONLY="FALSE" \ + PGHOST="postgres"\ + RABBITMQ_URI="amqp://guest:guest@rabbitmq/%2F"\ + DATA_DIR="/data/"\ + DBFILES_DIR="/data/dbfiles/" \ + SECRET_KEY_BASE="thisisnotasecret" + +WORKDIR /api/R + +CMD Rscript entrypoint.R + +COPY ./ /api diff --git a/apps/api/R/auth.R b/apps/api/R/auth.R new file mode 100644 index 00000000000..015ef9e314f --- /dev/null +++ b/apps/api/R/auth.R @@ -0,0 +1,86 @@ +library(dplyr) + +#* Obtain the encrypted password for a user +#* @param username Username, which is also the 'salt' +#* @param password Unencrypted password +#* @param secretkey Secret Key, which if NA, is set to 'notasecret' +#* @return Encrypted password +#* @author Tezan Sahu +get_crypt_pass <- function(username, password, secretkey = NA) { + secretkey <- if(is.na(secretkey)) "notasecret" else secretkey + dig <- secretkey + salt <- username + for (i in 1:10) { + dig <- digest::digest( + paste(dig, salt, password, secretkey, sep="--"), + algo="sha1", + serialize=FALSE + ) + } + return(dig) +} + + + +#* Check if the encrypted password for the user is valid +#* @param username Username +#* @param crypt_pass Encrypted password +#* @return TRUE if encrypted password is correct, else FALSE +#* @author Tezan Sahu +validate_crypt_pass <- function(username, crypt_pass) { + + res <- tbl(global_db_pool, "users") %>% + filter(login == username, + crypted_password == crypt_pass) %>% + collect() + + if (nrow(res) == 1) { + return(res$id) + } + + return(NA) +} + +#* Filter to authenticate a user calling the PEcAn API +#* @param req The request +#* @param res The response to be set +#* @return Appropriate response +#* @author Tezan Sahu +authenticate_user <- function(req, res) { + # Fix CORS issues + res$setHeader("Access-Control-Allow-Origin", "*") + + # If the API endpoint that do not require authentication + if ( + Sys.getenv("AUTH_REQ") == FALSE || + grepl("swagger", req$PATH_INFO, ignore.case = TRUE) || + grepl("openapi.json", req$PATH_INFO, fixed = TRUE) || + grepl("/api/ping", req$PATH_INFO, ignore.case = TRUE) || + grepl("/api/status", req$PATH_INFO, ignore.case = TRUE)) + { + req$user$userid <- NA + req$user$username <- "" + return(plumber::forward()) + } + + if (!is.null(req$HTTP_AUTHORIZATION)) { + # HTTP_AUTHORIZATION is of the form "Basic ", + # where the is contains : + auth_details <- strsplit(rawToChar(jsonlite::base64_dec(strsplit(req$HTTP_AUTHORIZATION, " +")[[1]][2])), ":")[[1]] + username <- auth_details[1] + password <- auth_details[2] + crypt_pass <- get_crypt_pass(username, password) + + userid <- validate_crypt_pass(username, crypt_pass) + + if(! is.na(userid)){ + req$user$userid <- userid + req$user$username <- username + return(plumber::forward()) + } + + } + + res$status <- 401 # Unauthorized + return(list(error="Authentication required")) +} diff --git a/apps/api/R/available-models.R b/apps/api/R/available-models.R new file mode 100644 index 00000000000..aa93e9db7ad --- /dev/null +++ b/apps/api/R/available-models.R @@ -0,0 +1,37 @@ +library(magrittr, include.only = "%>%") + +#' List models available on a specific machine +#' +#' @param machine_name Target machine hostname. Default = `"docker"` +#' @param machine_id Target machine ID. If `NA` (default), deduced from hostname. +#' @return `data.frame` of information on available models +#' @author Alexey Shiklomanov +#* @get / +availableModels <- function(machine_name = "docker", machine_id = NA) { + if (is.na(machine_id)) { + machines <- dplyr::tbl(global_db_pool, "machines") + machineid <- machines %>% + dplyr::filter(hostname == !!machine_name) %>% + dplyr::pull(id) + if (length(machineid) > 1) { + stop("Found ", length(machineid), " machines with name ", machine_name) + } + if (length(machineid) < 1) { + stop("Found no machines with name ", machine_name) + } + } + dbfiles <- dplyr::tbl(global_db_pool, "dbfiles") %>% + dplyr::filter(machine_id == !!machineid) + modelfiles <- dbfiles %>% + dplyr::filter(container_type == "Model") + models <- dplyr::tbl(global_db_pool, "models") + modeltypes <- dplyr::tbl(global_db_pool, "modeltypes") %>% + dplyr::select(modeltype_id = id, modeltype = name) + + modelfiles %>% + dplyr::select(dbfile_id = id, file_name, file_path, + model_id = container_id) %>% + dplyr::inner_join(models, c("model_id" = "id")) %>% + dplyr::inner_join(modeltypes, "modeltype_id") %>% + dplyr::collect() +} diff --git a/apps/api/R/entrypoint.R b/apps/api/R/entrypoint.R new file mode 100755 index 00000000000..5f1d8a3fb94 --- /dev/null +++ b/apps/api/R/entrypoint.R @@ -0,0 +1,80 @@ +#!/usr/bin/env Rscript + +#* This is the entry point to the PEcAn API. +#* All API endpoints (& filters) are mounted here +#* @author Tezan Sahu + +source("auth.R") +source("general.R") + +# Set up the global database pool +#.bety_params <- PEcAn.DB::get_postgres_envvars( +# host = "localhost", +# dbname = "bety", +# user = "bety", +# password = "bety", +# driver = "Postgres" +#) +# +#.bety_params$driver <- NULL +#.bety_params$drv <- RPostgres::Postgres() +#global_db_pool <- do.call(pool::dbPool, .bety_params) +global_db_pool <- PEcAn.DB::betyConnect() + +# redirect to trailing slash +plumber::options_plumber(trailingSlash=TRUE) + +# root router +root <- plumber::Plumber$new() +root$setSerializer(plumber::serializer_unboxed_json()) + +# Filter for authenticating users trying to hit the API endpoints +root$filter("require-auth", authenticate_user) + +# The /api/ping & /api/status are standalone API endpoints +# implemented using handle() because of restrictions of plumber +# to mount multiple endpoints on the same path (or subpath) +root$handle("GET", "/api/ping", ping) +root$handle("GET", "/api/status", status) + +# The endpoints mounted here are related to details of PEcAn models +models_pr <- plumber::Plumber$new("models.R") +root$mount("/api/models", models_pr) + +# The endpoints mounted here are related to details of PEcAn sites +sites_pr <- plumber::Plumber$new("sites.R") +root$mount("/api/sites", sites_pr) + +# The endpoints mounted here are related to details of PEcAn pfts +pfts_pr <- plumber::Plumber$new("pfts.R") +root$mount("/api/pfts", pfts_pr) + +# The endpoints mounted here are related to details of PEcAn formats +formats_pr <- plumber::Plumber$new("formats.R") +root$mount("/api/formats", formats_pr) + +# The endpoints mounted here are related to details of PEcAn inputs +inputs_pr <- plumber::Plumber$new("inputs.R") +root$mount("/api/inputs", inputs_pr) + +# The endpoints mounted here are related to details of PEcAn workflows +workflows_pr <- plumber::Plumber$new("workflows.R") +root$mount("/api/workflows", workflows_pr) + +# The endpoints mounted here are related to details of PEcAn runs +runs_pr <- plumber::Plumber$new("runs.R") +root$mount("/api/runs", runs_pr) + +# Available models +runs_pr <- plumber::Plumber$new("available-models.R") +root$mount("/api/availableModels", runs_pr) + +# set swagger documentation +root$setApiSpec("../pecanapi-spec.yml") + +# enable debug +root$setDebug(TRUE) + +# The API server is bound to 0.0.0.0 on port 8000 +# The Swagger UI for the API draws its source from the pecanapi-spec.yml file +root$run(host="0.0.0.0", port=8000) diff --git a/apps/api/R/formats.R b/apps/api/R/formats.R new file mode 100644 index 00000000000..d805fc48e7c --- /dev/null +++ b/apps/api/R/formats.R @@ -0,0 +1,80 @@ +library(dplyr) + +#' Retrieve the details of a PEcAn format, based on format_id +#' @param format_id Format ID (character) +#' @return Format details +#' @author Tezan Sahu +#* @get / +getFormat <- function(format_id, res){ + + Format <- tbl(global_db_pool, "formats") %>% + select(format_id = id, name, notes, header, mimetype_id) %>% + filter(format_id == !!format_id) + + Format <- tbl(global_db_pool, "mimetypes") %>% + select(mimetype_id = id, mimetype = type_string) %>% + inner_join(Format, by = "mimetype_id") %>% + select(-mimetype_id) + + qry_res <- Format %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Format not found")) + } + else { + # Convert the response from tibble to list + response <- list() + for(colname in colnames(qry_res)){ + response[colname] <- qry_res[colname] + } + + format_vars <- tbl(global_db_pool, "formats_variables") %>% + select(name, unit, format_id, variable_id) %>% + filter(format_id == !!format_id) + format_vars <- tbl(global_db_pool, "variables") %>% + select(variable_id = id, description, units) %>% + inner_join(format_vars, by="variable_id") %>% + mutate(unit = ifelse(unit %in% "", units, unit)) %>% + select(-variable_id, -format_id, -units) %>% + collect() + + response$format_variables <- format_vars + return(response) + } +} + +######################################################################### + +#' Search for PEcAn format(s) containing wildcards for filtering +#' @param format_name Format name search string (character) +#' @param mimetype Mime type search string (character) +#' @param ignore_case Logical. If `TRUE` (default) use case-insensitive search otherwise, use case-sensitive search +#' @return Formats subset matching the model search string +#' @author Tezan Sahu +#* @get / +searchFormats <- function(format_name="", mimetype="", ignore_case=TRUE, res){ + format_name <- URLdecode(format_name) + mimetype <- URLdecode(mimetype) + + Formats <- tbl(global_db_pool, "formats") %>% + select(format_id = id, format_name=name, mimetype_id) %>% + filter(grepl(!!format_name, format_name, ignore.case=ignore_case)) + + Formats <- tbl(global_db_pool, "mimetypes") %>% + select(mimetype_id = id, mimetype = type_string) %>% + inner_join(Formats, by = "mimetype_id") %>% + filter(grepl(!!mimetype, mimetype, ignore.case=ignore_case)) %>% + select(-mimetype_id) %>% + arrange(format_id) + + qry_res <- Formats %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Format(s) not found")) + } + else { + return(list(formats=qry_res, count = nrow(qry_res))) + } +} diff --git a/apps/api/R/general.R b/apps/api/R/general.R new file mode 100644 index 00000000000..5f5c9ec36b2 --- /dev/null +++ b/apps/api/R/general.R @@ -0,0 +1,29 @@ +#* Function to be executed when /api/ping endpoint is called +#* If successful connection to API server is established, this function will return the "pong" message +#* @return Mapping containing response as "pong" +#* @author Tezan Sahu +ping <- function(req){ + res <- list(request="ping", response="pong") + res +} + +#* Function to get the status & basic information about the Database Host +#* @return Details about the database host +#* @author Tezan Sahu +status <- function() { + ## helper function to obtain environment variables + get_env_var = function (item, default = "unknown") { + value = Sys.getenv(item) + if (value == "") default else value + } + + res <- list(host_details = PEcAn.DB::dbHostInfo(global_db_pool)) + res$host_details$authentication_required = get_env_var("AUTH_REQ") + + res$pecan_details <- list( + version = get_env_var("PECAN_VERSION"), + branch = get_env_var("PECAN_GIT_BRANCH"), + gitsha1 = get_env_var("PECAN_GIT_CHECKSUM") + ) + return(res) +} \ No newline at end of file diff --git a/apps/api/R/get.file.R b/apps/api/R/get.file.R new file mode 100644 index 00000000000..1d1fdeda9c3 --- /dev/null +++ b/apps/api/R/get.file.R @@ -0,0 +1,42 @@ +library(dplyr) + +#' Download a file associated with PEcAn +#' +#' @param filepath Absolute path to file on target machine +#' @param userid User ID associated with file (typically the same as the user +#' running the corresponding workflow) +#' @return Raw binary file contents +#' @author Tezan Sehu +get.file <- function(filepath, userid) { + # Check if the file path is valid + if(! file.exists(filepath)){ + return(list(status = "Error", message = "File not found")) + } + + # Check if the workflow for run after obtaining absolute path is owned by the user or not + parent_dir <- normalizePath(dirname(filepath)) + + run_id <- substr(parent_dir, stringi::stri_locate_last(parent_dir, regex="/")[1] + 1, stringr::str_length(parent_dir)) + + if(Sys.getenv("AUTH_REQ") == TRUE) { + + Run <- tbl(global_db_pool, "runs") %>% + filter(id == !!run_id) + Run <- tbl(global_db_pool, "ensembles") %>% + select(ensemble_id=id, workflow_id) %>% + full_join(Run, by="ensemble_id") %>% + filter(id == !!run_id) + user_id <- tbl(global_db_pool, "workflows") %>% + select(workflow_id=id, user_id) %>% full_join(Run, by="workflow_id") %>% + filter(id == !!run_id) %>% + pull(user_id) + + if(! user_id == userid) { + return(list(status = "Error", message = "Access forbidden")) + } + } + + # Read the data in binary form & return it + bin <- readBin(filepath,'raw', n = file.info(filepath)$size) + return(list(file_contents = bin)) +} diff --git a/apps/api/R/inputs.R b/apps/api/R/inputs.R new file mode 100644 index 00000000000..d1d9b270c20 --- /dev/null +++ b/apps/api/R/inputs.R @@ -0,0 +1,178 @@ +library(dplyr) + +#' Search for Inputs containing wildcards for filtering +#' @param model_id Model Id (character) +#' @param site_id Site Id (character) +#' @param offset +#' @param limit +#' @return Information about Inputs based on model & site +#' @author Tezan Sahu +#* @get / +searchInputs <- function(req, model_id=NA, site_id=NA, format_id=NA, host_id=NA, offset=0, limit=50, res){ + if (! limit %in% c(10, 20, 50, 100, 500)) { + res$status <- 400 + return(list(error = "Invalid value for parameter")) + } + + inputs <- tbl(global_db_pool, "inputs") %>% + select(input_name=name, id, site_id, format_id, start_date, end_date) + + inputs <- tbl(global_db_pool, "dbfiles") %>% + select(file_name, file_path, container_type, id=container_id, machine_id) %>% + inner_join(inputs, by = "id") %>% + filter(container_type == 'Input') %>% + select(-container_type) + + inputs <- tbl(global_db_pool, "machines") %>% + select(hostname, machine_id=id) %>% + inner_join(inputs, by='machine_id') + + inputs <- tbl(global_db_pool, "formats") %>% + select(format_id = id, format_name = name, mimetype_id) %>% + inner_join(inputs, by='format_id') + + inputs <- tbl(global_db_pool, "mimetypes") %>% + select(mimetype_id = id, mimetype = type_string) %>% + inner_join(inputs, by='mimetype_id') %>% + select(-mimetype_id) + + inputs <- tbl(global_db_pool, "sites") %>% + select(site_id = id, sitename) %>% + inner_join(inputs, by='site_id') + + if(! is.na(model_id)) { + inputs <- tbl(global_db_pool, "modeltypes_formats") %>% + select(tag, modeltype_id, format_id, input) %>% + inner_join(inputs, by='format_id') %>% + filter(input) %>% + select(-input) + + inputs <- tbl(global_db_pool, "models") %>% + select(model_id = id, modeltype_id, model_name, revision) %>% + inner_join(inputs, by='modeltype_id') %>% + filter(model_id == !!model_id) %>% + select(-modeltype_id, -model_id) + } + + if(! is.na(site_id)) { + inputs <- inputs %>% + filter(site_id == !!site_id) + } + + if(! is.na(format_id)) { + inputs <- inputs %>% + filter(format_id == !!format_id) + } + + if(! is.na(host_id)) { + inputs <- inputs %>% + filter(machine_id == !!host_id) + } + + qry_res <- inputs %>% + select(-site_id, -format_id, -machine_id) %>% + distinct() %>% + arrange(id) %>% + collect() + + if (nrow(qry_res) == 0 || as.numeric(offset) >= nrow(qry_res)) { + res$status <- 404 + return(list(error="Input(s) not found")) + } + else { + has_next <- FALSE + has_prev <- FALSE + if (nrow(qry_res) > (as.numeric(offset) + as.numeric(limit))) { + has_next <- TRUE + } + if (as.numeric(offset) != 0) { + has_prev <- TRUE + } + + qry_res <- qry_res[(as.numeric(offset) + 1):min((as.numeric(offset) + as.numeric(limit)), nrow(qry_res)), ] + + result <- list(inputs = qry_res) + result$count <- nrow(qry_res) + if(has_next){ + result$next_page <- paste0( + req$rook.url_scheme, "://", + req$HTTP_HOST, + "/api/workflows", + req$PATH_INFO, + substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]), + (as.numeric(limit) + as.numeric(offset)), + "&limit=", + limit + ) + } + if(has_prev) { + result$prev_page <- paste0( + req$rook.url_scheme, "://", + req$HTTP_HOST, + "/api/workflows", + req$PATH_INFO, + substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]), + max(0, (as.numeric(offset) - as.numeric(limit))), + "&limit=", + limit + ) + } + + return(result) + } +} + +################################################################################################# + +#' Download the input specified by the id +#' @param id Input id (character) +#' @param filename Optional filename specified if the id points to a folder instead of file (character) +#' If this is passed with an id that actually points to a file, this name will be ignored +#' @return Input file specified by user +#' @author Tezan Sahu +#* @serializer contentType list(type="application/octet-stream") +#* @get / +downloadInput <- function(input_id, filename="", req, res){ + db_hostid <- PEcAn.DB::dbHostInfo(global_db_pool)$hostid + + # This is just for temporary testing due to the existing issue in dbHostInfo() + db_hostid <- ifelse(db_hostid == 99, 99000000001, db_hostid) + + input <- tbl(global_db_pool, "dbfiles") %>% + select(file_name, file_path, container_id, machine_id, container_type) %>% + filter(machine_id == !!db_hostid) %>% + filter(container_type == "Input") %>% + filter(container_id == !!input_id) %>% + collect() + + if (nrow(input) == 0) { + res$status <- 404 + return() + } + else { + # Generate the full file path using the file_path & file_name + filepath <- paste0(input$file_path, "/", input$file_name) + + # If the id points to a directory, check if 'filename' within this directory has been specified + if(dir.exists(filepath)) { + # If no filename is provided, return 400 Bad Request error + if(filename == "") { + res$status <- 400 + return() + } + + # Append the filename to the filepath + filepath <- paste0(filepath, filename) + } + + # If the file doesn't exist, return 404 error + if(! file.exists(filepath)){ + res$status <- 404 + return() + } + + # Read the data in binary form & return it + bin <- readBin(filepath,'raw', n = file.info(filepath)$size) + return(bin) + } +} diff --git a/apps/api/R/models.R b/apps/api/R/models.R new file mode 100644 index 00000000000..1a74b54210e --- /dev/null +++ b/apps/api/R/models.R @@ -0,0 +1,67 @@ +library(dplyr) + +#' Retrieve the details of a PEcAn model, based on model_id +#' @param model_id Model ID (character) +#' @return Model details +#' @author Tezan Sahu +#* @get / +getModel <- function(model_id, res){ + + Model <- tbl(global_db_pool, "models") %>% + select(model_id = id, model_name, revision, modeltype_id) %>% + filter(model_id == !!model_id) + + Model <- tbl(global_db_pool, "modeltypes") %>% + select(modeltype_id = id, model_type = name) %>% + inner_join(Model, by = "modeltype_id") + + qry_res <- Model %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Model not found")) + } + else { + # Convert the response from tibble to list + response <- list() + for(colname in colnames(qry_res)){ + response[colname] <- qry_res[colname] + } + + inputs_req <- tbl(global_db_pool, "modeltypes_formats") %>% + filter(modeltype_id == bit64::as.integer64(qry_res$modeltype_id)) %>% + select(input=tag, required) %>% collect() + response$inputs <- jsonlite::fromJSON(gsub('(\")', '"', jsonlite::toJSON(inputs_req))) + return(response) + } +} + +######################################################################### + +#' Search for PEcAn model(s) containing wildcards for filtering +#' @param model_name Model name search string (character) +#' @param revision Model version/revision search string (character) +#' @param ignore_case Logical. If `TRUE` (default) use case-insensitive search otherwise, use case-sensitive search +#' @return Model subset matching the model search string +#' @author Tezan Sahu +#* @get / +searchModels <- function(model_name="", revision="", ignore_case=TRUE, res){ + model_name <- URLdecode(model_name) + revision <- URLdecode(revision) + + Models <- tbl(global_db_pool, "models") %>% + select(model_id = id, model_name, revision) %>% + filter(grepl(!!model_name, model_name, ignore.case=ignore_case)) %>% + filter(grepl(!!revision, revision, ignore.case=ignore_case)) %>% + arrange(model_id) + + qry_res <- Models %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Model(s) not found")) + } + else { + return(list(models=qry_res, count = nrow(qry_res))) + } +} diff --git a/apps/api/R/pfts.R b/apps/api/R/pfts.R new file mode 100644 index 00000000000..732340759aa --- /dev/null +++ b/apps/api/R/pfts.R @@ -0,0 +1,79 @@ +library(dplyr) + +#' Retrieve the details of a PEcAn PFT, based on pft_id +#' @param pft_id PFT ID (character) +#' @return PFT details +#' @author Tezan Sahu +#* @get / +getPfts <- function(pft_id, res){ + + pft <- tbl(global_db_pool, "pfts") %>% + select(pft_id = id, pft_name = name, definition, pft_type, modeltype_id) %>% + filter(pft_id == !!pft_id) + + pft <- tbl(global_db_pool, "modeltypes") %>% + select(modeltype_id = id, model_type = name) %>% + inner_join(pft, by = "modeltype_id") + + qry_res <- pft %>% + select(-modeltype_id) %>% + collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="PFT not found")) + } + else { + # Convert the response from tibble to list + response <- list() + for(colname in colnames(qry_res)){ + response[colname] <- qry_res[colname] + } + + return(response) + } +} + +######################################################################### + +#' Search for PFTs containing wildcards for filtering +#' @param pft_name PFT name search string (character) +#' @param pft_type PFT type (either 'plant' or 'cultivar') (character) +#' @param model_type Model type serch string (character) +#' @param ignore_case Logical. If `TRUE` (default) use case-insensitive search otherwise, use case-sensitive search +#' @return PFT subset matching the searc criteria +#' @author Tezan Sahu +#* @get / +searchPfts <- function(pft_name="", pft_type="", model_type="", ignore_case=TRUE, res){ + pft_name <- URLdecode(pft_name) + pft_type <- URLdecode(pft_type) + model_type <- URLdecode(model_type) + + if(! pft_type %in% c("", "plant", "cultivar")){ + res$status <- 400 + return(list(error = "Invalid pft_type")) + } + + pfts <- tbl(global_db_pool, "pfts") %>% + select(pft_id = id, pft_name = name, pft_type, modeltype_id) + + pfts <- tbl(global_db_pool, "modeltypes") %>% + select(modeltype_id = id, model_type = name) %>% + inner_join(pfts, by = "modeltype_id") + + qry_res <- pfts %>% + filter(grepl(!!pft_name, pft_name, ignore.case=ignore_case)) %>% + filter(grepl(!!pft_type, pft_type, ignore.case=ignore_case)) %>% + filter(grepl(!!model_type, model_type, ignore.case=ignore_case)) %>% + select(-modeltype_id) %>% + arrange(pft_id) %>% + collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="PFT(s) not found")) + } + else { + return(list(pfts=qry_res, count = nrow(qry_res))) + } +} diff --git a/apps/api/R/runs.R b/apps/api/R/runs.R new file mode 100644 index 00000000000..c9d0acb3b4a --- /dev/null +++ b/apps/api/R/runs.R @@ -0,0 +1,323 @@ +library(dplyr) +source("get.file.R") + +#' Get the list of runs (belonging to a particuar workflow) +#' @param workflow_id Workflow id (character) +#' @param offset +#' @param limit +#' @return List of runs (belonging to a particuar workflow) +#' @author Tezan Sahu +#* @get / +getRuns <- function(req, workflow_id=NA, offset=0, limit=50, res){ + if (! limit %in% c(10, 20, 50, 100, 500)) { + res$status <- 400 + return(list(error = "Invalid value for parameter")) + } + + Runs <- tbl(global_db_pool, "runs") %>% + select(id, model_id, site_id, parameter_list, ensemble_id, start_time, finish_time) + + Runs <- tbl(global_db_pool, "ensembles") %>% + select(runtype, ensemble_id=id, workflow_id) %>% + full_join(Runs, by="ensemble_id") + + if(! is.na(workflow_id)){ + Runs <- Runs %>% + filter(workflow_id == !!workflow_id) + } + + qry_res <- Runs %>% + arrange(id) %>% + collect() + + if (nrow(qry_res) == 0 || as.numeric(offset) >= nrow(qry_res)) { + res$status <- 404 + return(list(error="Run(s) not found")) + } + else { + has_next <- FALSE + has_prev <- FALSE + if (nrow(qry_res) > (as.numeric(offset) + as.numeric(limit))) { + has_next <- TRUE + } + if (as.numeric(offset) != 0) { + has_prev <- TRUE + } + qry_res <- qry_res[(as.numeric(offset) + 1):min((as.numeric(offset) + as.numeric(limit)), nrow(qry_res)), ] + result <- list(runs = qry_res) + result$count <- nrow(qry_res) + if(has_next){ + result$next_page <- paste0( + req$rook.url_scheme, "://", + req$HTTP_HOST, + "/api/runs", + req$PATH_INFO, + substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]), + (as.numeric(limit) + as.numeric(offset)), + "&limit=", + limit + ) + } + if(has_prev) { + result$prev_page <- paste0( + req$rook.url_scheme, "://", + req$HTTP_HOST, + "/api/runs", + req$PATH_INFO, + substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]), + max(0, (as.numeric(offset) - as.numeric(limit))), + "&limit=", + limit + ) + } + + return(result) + } +} + +################################################################################################# + +#' Get the details of the run specified by the id +#' @param run_id Run id (character) +#' @return Details of requested run +#' @author Tezan Sahu +#* @get / +getRunDetails <- function(req, run_id, res){ + + Runs <- tbl(global_db_pool, "runs") %>% + select(-outdir, -outprefix, -setting, -created_at, -updated_at) + + Runs <- tbl(global_db_pool, "ensembles") %>% + select(runtype, ensemble_id=id, workflow_id) %>% + full_join(Runs, by="ensemble_id") %>% + filter(id == !!run_id) + + qry_res <- Runs %>% collect() + + if(Sys.getenv("AUTH_REQ") == TRUE){ + user_id <- tbl(global_db_pool, "workflows") %>% + select(workflow_id=id, user_id) %>% full_join(Runs, by="workflow_id") %>% + filter(id == !!run_id) %>% + pull(user_id) + } + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Run with specified ID was not found")) + } + else { + + if(Sys.getenv("AUTH_REQ") == TRUE) { + # If user id of requested run does not match the caller of the API, return 403 Access forbidden + if(is.na(user_id) || user_id != req$user$userid){ + res$status <- 403 + return(list(error="Access forbidden")) + } + } + + # Convert the response from tibble to list + response <- list() + for(colname in colnames(qry_res)){ + response[colname] <- qry_res[colname] + } + + # If inputs exist on the host, add them to the response + indir <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", response$workflow_id, "/run/", run_id) + if(dir.exists(indir)){ + response$inputs <- getRunInputs(indir) + } + + # If outputs exist on the host, add them to the response + outdir <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", response$workflow_id, "/out/", run_id) + if(dir.exists(outdir)){ + response$outputs <- getRunOutputs(outdir) + } + + return(response) + } +} + +################################################################################################# + +#' Get the input file specified by user for a run +#' @param run_id Run id (character) +#' @param filename Name of the input file (character) +#' @return Input file specified by user for the run +#' @author Tezan Sahu +#* @serializer contentType list(type="application/octet-stream") +#* @get //input/ +getRunInputFile <- function(req, run_id, filename, res){ + + Run <- tbl(global_db_pool, "runs") %>% + filter(id == !!run_id) + + workflow_id <- tbl(global_db_pool, "ensembles") %>% + select(ensemble_id=id, workflow_id) %>% + full_join(Run, by="ensemble_id") %>% + filter(id == !!run_id) %>% + pull(workflow_id) + + inputpath <- paste0( Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", workflow_id, "/run/", run_id, "/", filename) + + result <- get.file(inputpath, req$user$userid) + if(is.null(result$file_contents)){ + if(result$status == "Error" && result$message == "Access forbidden") { + res$status <- 403 + return() + } + if(result$status == "Error" && result$message == "File not found") { + res$status <- 404 + return() + } + } + return(result$file_contents) +} + +################################################################################################# + +#' Get the output file specified by user for a run +#' @param run_id Run id (character) +#' @param filename Name of the output file (character) +#' @return Output file specified by user for the run +#' @author Tezan Sahu +#* @serializer contentType list(type="application/octet-stream") +#* @get //output/ +getRunOutputFile <- function(req, run_id, filename, res){ + + Run <- tbl(global_db_pool, "runs") %>% + filter(id == !!run_id) + + workflow_id <- tbl(global_db_pool, "ensembles") %>% + select(ensemble_id=id, workflow_id) %>% + full_join(Run, by="ensemble_id") %>% + filter(id == !!run_id) %>% + pull(workflow_id) + + outputpath <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", workflow_id, "/out/", run_id, "/", filename) + + result <- get.file(outputpath, req$user$userid) + if(is.null(result$file_contents)){ + if(result$status == "Error" && result$message == "Access forbidden") { + res$status <- 403 + return() + } + if(result$status == "Error" && result$message == "File not found") { + res$status <- 404 + return() + } + } + return(result$file_contents) +} + +################################################################################################# + +#' Plot the results obtained from a run +#' @param run_id Run id (character) +#' @param year the year this data is for +#' @param yvar the variable to plot along the y-axis. +#' @param xvar the variable to plot along the x-axis, by default time is used. +#' @param width the width of the image generated, default is 800 pixels. +#' @param height the height of the image generated, default is 600 pixels. +#' @return List of runs (belonging to a particuar workflow) +#' @author Tezan Sahu +#* @get //graph// +#* @serializer contentType list(type='image/png') + +plotResults <- function(req, run_id, year, y_var, x_var="time", width=800, height=600, res) { + # Get workflow_id for the run + Run <- tbl(global_db_pool, "runs") %>% + filter(id == !!run_id) + + workflow_id <- tbl(global_db_pool, "ensembles") %>% + select(ensemble_id=id, workflow_id) %>% + full_join(Run, by="ensemble_id") %>% + filter(id == !!run_id) %>% + pull(workflow_id) + + if(Sys.getenv("AUTH_REQ") == TRUE){ + user_id <- tbl(global_db_pool, "workflows") %>% + select(id, user_id) %>% + filter(id == !!workflow_id) %>% + pull(user_id) + } + + # Check if the data file exists on the host + datafile <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", workflow_id, "/out/", run_id, "/", year, ".nc") + if(! file.exists(datafile)){ + res$status <- 404 + return() + } + + if(Sys.getenv("AUTH_REQ") == TRUE) { + # If user id of requested run does not match the caller of the API, return 403 Access forbidden + if(is.na(user_id) || user_id != req$user$userid){ + res$status <- 403 + return(list(error="Access forbidden")) + } + } + + # Plot & return + filename <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/temp", stringi::stri_rand_strings(1, 10), ".png") + PEcAn.visualization::plot_netcdf(datafile, y_var, x_var, as.integer(width), as.integer(height), year=year, filename=filename) + img_bin <- readBin(filename,'raw',n = file.info(filename)$size) + file.remove(filename) + return(img_bin) +} + + +################################################################################################# + +#' Get the inputs of a run (if the files exist on the host) +#' @param indir Run input directory (character) +#' @return Input details of the run +#' @author Tezan Sahu + +getRunInputs <- function(indir){ + inputs <- list() + if(file.exists(paste0(indir, "/README.txt"))){ + inputs$info <- "README.txt" + } + all_files <- list.files(indir) + inputs$others <- all_files[!all_files %in% c("job.sh", "rabbitmq.out", "README.txt")] + return(inputs) +} + +################################################################################################# + +#' Get the outputs of a run (if the files exist on the host) +#' @param outdir Run output directory (character) +#' @return Output details of the run +#' @author Tezan Sahu + +getRunOutputs <- function(outdir){ + outputs <- list() + if(file.exists(paste0(outdir, "/logfile.txt"))){ + outputs$logfile <- "logfile.txt" + } + + if(file.exists(paste0(outdir, "/README.txt"))){ + outputs$info <- "README.txt" + } + + year_files <- list.files(outdir, pattern="*.nc$") + years <- stringr::str_replace_all(year_files, ".nc", "") + years_data <- c() + outputs$years <- list() + for(year in years){ + var_lines <- readLines(paste0(outdir, "/", year, ".nc.var")) + keys <- stringr::word(var_lines, 1) + values <- stringr::word(var_lines, 2, -1) + vars <- list() + for(i in 1:length(keys)){ + vars[keys[i]] <- values[i] + } + years_data <- c(years_data, list(list( + data = paste0(year, ".nc"), + variables = vars + ))) + } + for(i in 1:length(years)){ + outputs$years[years[i]] <- years_data[i] + } + return(outputs) +} diff --git a/apps/api/R/sites.R b/apps/api/R/sites.R new file mode 100644 index 00000000000..09b6abba4b2 --- /dev/null +++ b/apps/api/R/sites.R @@ -0,0 +1,57 @@ +library(dplyr) + +#' Retrieve the details of a PEcAn site, based on site_id +#' @param site_id Site ID (character) +#' @return Site details +#' @author Tezan Sahu +#* @get / +getSite <- function(site_id, res){ + + site <- tbl(global_db_pool, "sites") %>% + select(-created_at, -updated_at, -user_id, -geometry) %>% + filter(id == !!site_id) + + + qry_res <- site %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Site not found")) + } + else { + # Convert the response from tibble to list + response <- list() + for(colname in colnames(qry_res)){ + response[colname] <- qry_res[colname] + } + return(response) + } +} + +################################################################################################# + +#' Search for PEcAn sites containing wildcards for filtering +#' @param sitename Site name search string (character) +#' @param ignore_case Logical. If `TRUE` (default) use case-insensitive search otherwise, use case-sensitive search +#' @return Site subset matching the site search string +#' @author Tezan Sahu +#* @get / +searchSite <- function(sitename="", ignore_case=TRUE, res){ + sitename <- URLdecode(sitename) + + sites <- tbl(global_db_pool, "sites") %>% + select(id, sitename) %>% + filter(grepl(!!sitename, sitename, ignore.case=ignore_case)) %>% + arrange(id) + + + qry_res <- sites %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Site(s) not found")) + } + else { + return(list(sites=qry_res, count = nrow(qry_res))) + } +} diff --git a/apps/api/R/submit.workflow.R b/apps/api/R/submit.workflow.R new file mode 100644 index 00000000000..ace1c2896f7 --- /dev/null +++ b/apps/api/R/submit.workflow.R @@ -0,0 +1,269 @@ +library(dplyr) + +#* Submit a workflow sent as XML +#* @param workflowXmlString String containing the XML workflow from request body +#* @param userDetails List containing userid & username +#* @return ID & status of the submitted workflow +#* @author Tezan Sahu +submit.workflow.xml <- function(workflowXmlString, userDetails){ + + workflowXml <- XML::xmlParseString(stringr::str_replace(workflowXmlString, "\n", "")) + workflowList <- XML::xmlToList(workflowXml) + + return(submit.workflow.list(workflowList, userDetails)) +} + +################################################################################################# + +#* Submit a workflow sent as JSON +#* @param workflowJsonString String containing the JSON workflow from request body +#* @param userDetails List containing userid & username +#* @return ID & status of the submitted workflow +#* @author Tezan Sahu +submit.workflow.json <- function(workflowJsonString, userDetails){ + + workflowList <- jsonlite::fromJSON(workflowJsonString) + + return(submit.workflow.list(workflowList, userDetails)) +} + +################################################################################################# + +#* Submit a workflow (converted to list) +#* @param workflowList Workflow parameters expressed as a list +#* @param userDetails List containing userid & username +#* @return ID & status of the submitted workflow +#* @author Tezan Sahu +submit.workflow.list <- function(workflowList, userDetails) { + + # Set database details + workflowList$database <- list( + bety = PEcAn.DB::get_postgres_envvars( + host = "localhost", + dbname = "bety", + user = "bety", + password = "bety", + driver = "PostgreSQL" + ) + ) + + if (is.null(workflowList$model$id)) { + return(list(status = "Error", + error = "Must provide model ID.")) + } + + # Get model revision and type for the RabbitMQ queue + model_info <- dplyr::tbl(global_db_pool, "models") %>% + dplyr::filter(id == !!workflowList$model$id) %>% + dplyr::inner_join(dplyr::tbl(global_db_pool, "modeltypes"), + by = c("modeltype_id" = "id")) %>% + dplyr::collect() + + if (nrow(model_info) < 1) { + msg <- paste0("No models found with ID ", format(workflowList$model$id, scientific = FALSE)) + return(list(status = "Error", error = msg)) + } else if (nrow(model_info) > 1) { + msg <- paste0( + "Found multiple (", nrow(model_info), ") matching models for id ", + format(workflowList$model$id, scientific = FALSE), + ". This shouldn't happen! Check your database for errors." + ) + return(list(status = "Error", error = msg)) + } + + model_type <- model_info$name + model_revision <- model_info$revision + + # Fix RabbitMQ details + hostInfo <- PEcAn.DB::dbHostInfo(global_db_pool) + workflowList$host <- list( + rabbitmq = list( + uri = Sys.getenv("RABBITMQ_URI", "amqp://guest:guest@localhost/%2F"), + queue = paste0(model_type, "_", model_revision) + ) + ) + workflowList$host$name <- if(hostInfo$hostname == "") "localhost" else hostInfo$hostname + # Fix the info + workflowList$info$notes <- workflowList$info$notes + if(is.null(workflowList$info$userid)){ + workflowList$info$userid <- userDetails$userid + } + if(is.null(workflowList$info$username)){ + workflowList$info$username <- userDetails$username + } + if(is.null(workflowList$info$date)){ + workflowList$info$date <- Sys.time() + } + + # Add entry to workflows table in database + workflow_id <- insert.workflow(workflowList) + workflowList$workflow$id <- workflow_id + workflow_id_str <- format(workflow_id, scientific = FALSE) + + # Add entry to attributes table in database + insert.attribute(workflowList) + + # Fix the output directory + outdir <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", + workflow_id_str) + workflowList$outdir <- outdir + + # Create output diretory + dir.create(outdir, recursive=TRUE) + + # Modify the `dbfiles` path & create the directory if needed + workflowList$run$dbfiles <- Sys.getenv("DBFILES_DIR", "/data/dbfiles/") + if(! dir.exists(workflowList$run$dbfiles)){ + dir.create(workflowList$run$dbfiles, recursive = TRUE) + } + + # Convert settings list to XML & save it into outdir + workflowXml <- PEcAn.settings::listToXml(workflowList, "pecan") + XML::saveXML(workflowXml, paste0(outdir, "/pecan.xml")) + res <- file.copy("/work/workflow.R", outdir) + + # Post workflow to RabbitMQ + message <- list(folder = outdir, workflowid = workflow_id_str) + res <- PEcAn.remote::rabbitmq_post_message(workflowList$host$rabbitmq$uri, "pecan", message, "rabbitmq") + + if(res$routed){ + return(list(workflow_id = workflow_id_str, status = "Submitted successfully")) + } + else{ + return(list(status = "Error", message = "Could not submit to RabbitMQ")) + } + + +} + +################################################################################################# + +#* Insert the workflow into workflows table to obtain the workflow_id +#* @param workflowList List containing the workflow details +#* @return ID of the submitted workflow +#* @author Tezan Sahu +insert.workflow <- function(workflowList){ + + model_id <- workflowList$model$id + if(is.null(model_id)){ + model_id <- PEcAn.DB::get.id("models", c("model_name", "revision"), c(workflowList$model$type, workflowList$model$revision), global_db_pool) + } + + start_time <- Sys.time() + + workflow_df <- tibble::tibble( + "site_id" = bit64::as.integer64(workflowList$run$site$id), + "model_id" = bit64::as.integer64(model_id), + "folder" = "temp_dir", + "hostname" = "docker", + "start_date" = as.POSIXct(workflowList$run$start.date), + "end_date" = as.POSIXct(workflowList$run$end.date), + "advanced_edit" = FALSE, + "started_at" = start_time + ) + + if (! is.na(workflowList$info$userid)){ + workflow_df <- workflow_df %>% + tibble::add_column("user_id" = bit64::as.integer64(workflowList$info$userid)) + } + + # NOTE: Have to "checkout" a connection from the pool here to work with + # dbSendStatement and friends. We make sure to return the connection when the + # function exits (successfully or not). + #con <- pool::poolCheckout(global_db_pool) + #on.exit(pool::poolReturn(con), add = TRUE) + con <- global_db_pool + + insert_query <- glue::glue( + "INSERT INTO workflows ", + "({paste(colnames(workflow_df), collapse = ', ')}) ", + "VALUES ({paste0('$', seq_len(ncol(workflow_df)), collapse = ', ')}) ", + "RETURNING id" + ) + PEcAn.logger::logger.debug(insert_query) + workflow_id <- PEcAn.DB::db.query( + insert_query, con, + values = unname(as.list(workflow_df)) + )[["id"]] + + PEcAn.logger::logger.debug( + "Running workflow ID: ", + format(workflow_id, scientific = FALSE) + ) + + PEcAn.DB::db.query( + "UPDATE workflows SET folder = $1 WHERE id = $2", con, values = list( + file.path("data", "workflows", paste0("PEcAn_", format(workflow_id, scientific = FALSE))), + workflow_id + ) + ) + + return(workflow_id) +} + +################################################################################################# + +#* Insert the workflow into attributes table +#* @param workflowList List containing the workflow details +#* @author Tezan Sahu +insert.attribute <- function(workflowList){ + + # Create an array of PFTs + pfts <- c() + for(i in seq(length(workflowList$pfts))){ + pfts <- c(pfts, workflowList$pfts[i]$pft$name) + } + + # Obtain the model_id + model_id <- workflowList$model$id + if(is.null(model_id)){ + model_id <- PEcAn.DB::get.id("models", c("model_name", "revision"), c(workflowList$model$type, workflowList$model$revision), global_db_pool) + } + + # Fill in the properties + properties <- list( + start = as.POSIXct(workflowList$run$start.date), + end = as.POSIXct(workflowList$run$end.date), + pfts = pfts, + runs = if(is.null(workflowList$ensemble$size)) 1 else workflowList$ensemble$size, + modelid = model_id, + siteid = bit64::as.integer64(workflowList$run$site$id), + sitename = dplyr::tbl(global_db_pool, "sites") %>% filter(id == bit64::as.integer64(workflowList$run$site$id)) %>% pull(sitename), + #sitegroupid <- + lat = if(is.null(workflowList$run$site$lat)) "" else workflowList$run$site$lat, + lon = if(is.null(workflowList$run$site$lon)) "" else workflowList$run$site$lon, + email = if(is.na(workflowList$info$userid) || workflowList$info$userid == -1) "" else + dplyr::tbl(global_db_pool, "users") %>% filter(id == bit64::as.integer64(workflowList$info$userid)) %>% pull(email), + notes = if(is.null(workflowList$info$notes)) "" else workflowList$info$notes, + variables = workflowList$ensemble$variable + ) + + if(! is.null(workflowList$run$inputs$met$id)) { + properties$input_met <- workflowList$run$inputs$met$id + } + else if(! is.null(workflowList$run$inputs$met$source)) { + properties$input_met <- workflowList$run$inputs$met$source + } + + if(! is.null(workflowList$ensemble$parameters$method)) properties$parm_method <- workflowList$ensemble$parameters$method + if(! is.null(workflowList$sensitivity.analysis$quantiles)){ + sensitivity <- c() + for(i in seq(length(workflowList$sensitivity.analysis$quantiles))){ + sensitivity <- c(sensitivity, workflowList$sensitivity.analysis$quantiles[i]$sigma) + } + properties$sensitivity <- paste0(sensitivity, collapse=",") + } + # More variables can be added later + + # Insert properties into attributes table + value_json <- as.character(jsonlite::toJSON(properties, auto_unbox = TRUE)) + + # con <- pool::poolCheckout(global_db_pool) + # on.exit(pool::poolReturn(con), add = TRUE) + con <- global_db_pool + res <- DBI::dbSendStatement(con, + "INSERT INTO attributes (container_type, container_id, value) VALUES ($1, $2, $3)", + list("workflows", bit64::as.integer64(workflowList$workflow$id), value_json)) + + +} diff --git a/apps/api/R/workflows.R b/apps/api/R/workflows.R new file mode 100644 index 00000000000..44cb9196f18 --- /dev/null +++ b/apps/api/R/workflows.R @@ -0,0 +1,231 @@ +library(dplyr) +source("submit.workflow.R") + +#' Get the list of workflows (using a particular model & site, if specified) +#' @param model_id Model id (character) +#' @param site_id Site id (character) +#' @param offset +#' @param limit Max number of workflows to retrieve (default = 50) +#' @return List of workflows (using a particular model & site, if specified) +#' @author Tezan Sahu +#* @get / +getWorkflows <- function(req, model_id=NA, site_id=NA, offset=0, limit=50, res){ + if (! limit %in% c(10, 20, 50, 100, 500)) { + res$status <- 400 + return(list(error = "Invalid value for parameter")) + } + + Workflow <- tbl(global_db_pool, "workflows") %>% + select(-created_at, -updated_at, -params, -advanced_edit, -notes) + + if (!is.na(model_id)) { + Workflow <- Workflow %>% + filter(model_id == !!model_id) + } + + if (!is.na(site_id)) { + Workflow <- Workflow %>% + filter(site_id == !!site_id) + } + + qry_res <- Workflow %>% collect() + + if (nrow(qry_res) == 0 || as.numeric(offset) >= nrow(qry_res)) { + res$status <- 404 + return(list(error="Workflows not found")) + } + else { + has_next <- FALSE + has_prev <- FALSE + if (nrow(qry_res) > (as.numeric(offset) + as.numeric(limit))) { + has_next <- TRUE + } + if (as.numeric(offset) != 0) { + has_prev <- TRUE + } + + qry_res <- qry_res[(as.numeric(offset) + 1):min((as.numeric(offset) + as.numeric(limit)), nrow(qry_res)), ] + + result <- list(workflows = qry_res) + result$count <- nrow(qry_res) + if(has_next){ + result$next_page <- paste0( + req$rook.url_scheme, "://", + req$HTTP_HOST, + "/api/workflows", + req$PATH_INFO, + substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]), + (as.numeric(limit) + as.numeric(offset)), + "&limit=", + limit + ) + } + if(has_prev) { + result$prev_page <- paste0( + req$rook.url_scheme, "://", + req$HTTP_HOST, + "/api/workflows", + req$PATH_INFO, + substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]), + max(0, (as.numeric(offset) - as.numeric(limit))), + "&limit=", + limit + ) + } + + return(result) + } +} + +################################################################################################# + +#' Post a workflow for execution +#' @param req Request sent +#' @return ID & status of the submitted workflow +#' @author Tezan Sahu +#* @post / +submitWorkflow <- function(req, res){ + if(req$HTTP_CONTENT_TYPE == "application/xml") { + submission_res <- submit.workflow.xml(req$postBody, req$user) + } + else if(req$HTTP_CONTENT_TYPE == "application/json") { + submission_res <- submit.workflow.json(req$postBody, req$user) + } + else{ + res$status <- 415 + return(paste("Unsupported request content type:", req$HTTP_CONTENT_TYPE)) + } + + if(submission_res$status == "Error"){ + res$status <- 400 + return(submission_res) + } + res$status <- 201 + return(submission_res) +} + +################################################################################################# + +#' Get the of the workflow specified by the id +#' @param id Workflow id (character) +#' @return Details of requested workflow +#' @author Tezan Sahu +#* @get / +getWorkflowDetails <- function(id, req, res){ + Workflow <- tbl(global_db_pool, "workflows") %>% + select(id, model_id, site_id, folder, hostname, user_id) + + Workflow <- tbl(global_db_pool, "attributes") %>% + select(id = container_id, properties = value) %>% + full_join(Workflow, by = "id") %>% + filter(id == !!id) + + qry_res <- Workflow %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Workflow with specified ID was not found")) + } + else { + if(is.na(qry_res$properties)){ + res <- list( + id = id, + folder=qry_res$folder, + hostname=qry_res$hostname, + user_id=qry_res$user_id, + properties = list(modelid = qry_res$model_id, siteid = qry_res$site_id) + ) + } + else{ + res <- list( + id = id, + folder=qry_res$folder, + hostname=qry_res$hostname, + user_id=qry_res$user_id, + properties = jsonlite::parse_json(qry_res$properties[[1]]) + ) + } + + # Add the files for the workflow if they exist on disk + filesdir <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", id) + if(dir.exists(filesdir)){ + all_files <- list.files(filesdir) + res$files <- all_files[!all_files %in% c("out", "rabbitmq.out", "pft", "run", "STATUS")] + } + + return(res) + } +} + +################################################################################################# + +#' Get the of the workflow specified by the id +#' @param id Workflow id (character) +#' @return Details of requested workflow +#' @author Tezan Sahu +#* @get //status +getWorkflowStatus <- function(req, id, res){ + Workflow <- tbl(global_db_pool, "workflows") %>% + select(id, user_id) %>% + filter(id == !!id) + + + qry_res <- Workflow %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return(list(error="Workflow with specified ID was not found on this host")) + } + else { + # Check if the STATUS file exists on the host + statusfile <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", qry_res$id, "/STATUS") + if(! file.exists(statusfile)){ + res$status <- 404 + return(list(error="Workflow with specified ID was not found on this host")) + } + + wf_status <- readLines(statusfile) + wf_status <- stringr::str_replace_all(wf_status, "\t", " ") + return(list(workflow_id=id, status=wf_status)) + } +} + +################################################################################################# + +#' Get a specified file of the workflow specified by the id +#' @param id Workflow id (character) +#' @return Details of requested workflow +#' @author Tezan Sahu +#* @serializer contentType list(type="application/octet-stream") +#* @get //file/ +getWorkflowFile <- function(req, id, filename, res){ + Workflow <- tbl(global_db_pool, "workflows") %>% + select(id, user_id) %>% + filter(id == !!id) + + qry_res <- Workflow %>% collect() + + if (nrow(qry_res) == 0) { + res$status <- 404 + return() + } + else { + # Check if the requested file exists on the host + filepath <- paste0(Sys.getenv("DATA_DIR", "/data/"), "workflows/PEcAn_", id, "/", filename) + if(! file.exists(filepath)){ + res$status <- 404 + return() + } + + if(Sys.getenv("AUTH_REQ") == TRUE){ + if(qry_res$user_id != req$user$userid) { + res$status <- 403 + return() + } + } + + # Read the data in binary form & return it + bin <- readBin(filepath,'raw', n = file.info(filepath)$size) + return(bin) + } +} diff --git a/apps/api/README.md b/apps/api/README.md new file mode 100644 index 00000000000..828bca112a9 --- /dev/null +++ b/apps/api/README.md @@ -0,0 +1,20 @@ +# PEcAn RESTful API Server + +This folder contains the code & tests for PEcAn's RESTful API server. The API allows users to remotely interact with the PEcAn servers and leverage the functionalities provided by the PEcAn Project. It has been designed to follow common RESTful API conventions. Most operations are performed using the HTTP methods: `GET` (retrieve) & `POST` (create). + +#### For the most up-to-date documentation, you can visit the [PEcAn API Documentation](http://pecan-dev.ncsa.illinois.edu/swagger/). + +## Starting the PEcAn server: + +Follow the following steps to spin up the PEcAn API server locally: + +```bash +$ cd R +$ ./entrypoint.R +``` + +## Running the tests: + +```bash +$ ./test_pecanapi.sh +``` diff --git a/apps/api/pecanapi-spec.yml b/apps/api/pecanapi-spec.yml new file mode 100644 index 00000000000..b6ea7e3a757 --- /dev/null +++ b/apps/api/pecanapi-spec.yml @@ -0,0 +1,1281 @@ +openapi: 3.0.0 +servers: + - description: PEcAn API Server + url: https://pecan-dev.ncsa.illinois.edu + - description: PEcAn Development Server + url: https://pecan-tezan-rstudio.ncsa.illinois.edu/p/670121ec + - description: PEcAn API Test Server + url: https://pecan-tezan.ncsa.illinois.edu + - description: Localhost + url: http://127.0.0.1:8000 + +info: + title: PEcAn Project API + description: >- + This is the API for interacting with server(s) of the __PEcAn Project__. The Predictive Ecosystem Analyser (PEcAn) Project is an open source framework initiated to meet the demands for more accessible, transparent & repeatable modeling of ecosystems. Here's the link to [PEcAn's Github Repository](https://github.com/PecanProject/pecan).

+ PEcAn can be considered as an ecoinformatics toolbox combined with a set of workflows that wrap around ecosystem models that allow users to effectively perform data synthesis, propagation of uncertainty through a model & ecological predictions in an integrated fashion using a diverse repository of data & models. + version: "1.0.0" + contact: + email: "pecanproj@gmail.com" + license: + name: University of Illinois/NCSA Open Source License + url: https://opensource.org/licenses/NCSA +externalDocs: + description: Find out more about PEcAn Project + url: https://pecanproject.github.io/ + +tags: + - name: general + description: Related to the overall working on the API, details of PEcAn & the server + - name: workflows + description: Everything about PEcAn workflows + - name: runs + description: Everything about PEcAn runs + - name: models + description: Everything about PEcAn models + - name: sites + description: Everything about PEcAn sites + - name: formats + description: Everything about PEcAn formats + - name: pfts + description: Everything about PEcAn PFTs (Plant Functional Types) + - name: inputs + description: Everything about PEcAn inputs + +##################################################################################################################### +##################################################### API Endpoints ################################################# +##################################################################################################################### +security: + - basicAuth: [] + +paths: + + /api/ping: + get: + summary: Ping the server to check if it is live + tags: + - general + responses: + '200': + description: OK + content: + application/json: + schema: + type: object + properties: + req: + type: string + resp: + type: string + '403': + description: Access forbidden + '404': + description: Models not found + + /api/status: + get: + summary: Obtain general information about PEcAn & the details of the database host + tags: + - general + responses: + '200': + description: OK + content: + application/json: + schema: + type: object + properties: + pecan_details: + type: object + properties: + version: + type: string + branch: + type: string + gitsha1: + type: string + host_details: + type: object + properties: + hostid: + type: string + hostname: + type: string + start: + type: string + end: + type: string + sync_url: + type: string + sync_contact: + type: string + + '403': + description: Access forbidden + '404': + description: Models not found + + /api/models/{model_id}: + get: + tags: + - models + summary: Details of requested model + parameters: + - in: path + name: model_id + description: Model ID + required: true + schema: + type: string + responses: + '200': + description: Model Details + content: + application/json: + schema: + $ref: '#/components/schemas/Model' + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Model not found + + /api/models/: + get: + tags: + - models + summary: Search for model(s) using search pattern based on model name & revision + parameters: + - in: query + name: model_name + description: Search string for model name + required: false + schema: + type: string + - in: query + name: revision + description: Search string for revision + required: false + schema: + type: string + - in: query + name: ignore_case + description: Indicator of case sensitive or case insensitive search + required: false + schema: + type: string + default: "TRUE" + enum: + - "TRUE" + - "FALSE" + responses: + '200': + description: List of sites matching search pattern + content: + application/json: + schema: + type: object + properties: + models: + type: array + items: + type: object + properties: + model_id: + type: string + model_name: + type: string + revision: + type: string + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Model(s) not found + + /api/sites/{site_id}: + get: + tags: + - sites + summary: Details of a site + parameters: + - in: path + name: site_id + description: PEcAn site ID + required: true + schema: + type: string + responses: + '200': + description: Site Details + content: + application/json: + schema: + $ref: '#/components/schemas/Site' + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Site not found + + /api/sites/: + get: + tags: + - sites + summary: Search for sites using search pattern based on site name + parameters: + - in: query + name: sitename + description: Search string for site name + required: false + schema: + type: string + - in: query + name: ignore_case + description: Indicator of case sensitive or case insensitive search + required: false + schema: + type: string + default: "TRUE" + enum: + - "TRUE" + - "FALSE" + responses: + '200': + description: List of sites matching search pattern + content: + application/json: + schema: + type: object + properties: + sites: + type: array + items: + type: object + properties: + id: + type: string + sitename: + type: string + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Site(s) not found + + /api/pfts/{pft_id}: + get: + tags: + - pfts + summary: Details of a PFT + parameters: + - in: path + name: pft_id + description: PEcAn PFT ID + required: true + schema: + type: string + responses: + '200': + description: PFT Details + content: + application/json: + schema: + $ref: '#/components/schemas/PFT' + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: PFT not found + + /api/pfts/: + get: + tags: + - pfts + summary: Search for PFTs using search pattern matching + parameters: + - in: query + name: pft_name + description: Search string for PFT name + required: false + schema: + type: string + - in: query + name: pft_type + description: PFT Type + required: false + schema: + type: string + default: "" + enum: + - "plant" + - "cultivar" + - "" + - in: query + name: model_type + description: Search string for Model type + required: false + schema: + type: string + - in: query + name: ignore_case + description: Indicator of case sensitive or case insensitive search + required: false + schema: + type: string + default: "TRUE" + enum: + - "TRUE" + - "FALSE" + responses: + '200': + description: List of PFTs matching search pattern + content: + application/json: + schema: + type: object + properties: + pfts: + type: array + items: + type: object + properties: + pft_id: + type: string + pft_name: + type: string + pft_type: + type: string + model_type: + type: string + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Site(s) not found + + /api/formats/{format_id}: + get: + tags: + - formats + summary: Details of requested format + parameters: + - in: path + name: format_id + description: Format ID + required: true + schema: + type: string + responses: + '200': + description: Format Details + content: + application/json: + schema: + $ref: '#/components/schemas/Format' + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Model not found + + /api/formats/: + get: + tags: + - formats + summary: Search for format(s) using search pattern based on format name & mime type + parameters: + - in: query + name: format_name + description: Search string for format name + required: false + schema: + type: string + - in: query + name: mimetype + description: Search string for mime type + required: false + schema: + type: string + - in: query + name: ignore_case + description: Indicator of case sensitive or case insensitive search + required: false + schema: + type: string + default: "TRUE" + enum: + - "TRUE" + - "FALSE" + responses: + '200': + description: List of formats matching search pattern + content: + application/json: + schema: + type: object + properties: + models: + type: array + items: + type: object + properties: + format_id: + type: string + format_name: + type: string + mimetype: + type: string + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Model(s) not found + + + /api/inputs/: + get: + tags: + - inputs + summary: Search for the inputs + parameters: + - in: query + name: model_id + description: If provided, returns all inputs for the provided model_id + required: false + schema: + type: string + - in: query + name: site_id + description: If provided, returns all inputs for the provided site_id + required: false + schema: + type: string + - in: query + name: format_id + description: If provided, returns all inputs for the provided format_id + required: false + schema: + type: string + - in: query + name: host_id + description: If provided, returns all inputs for the provided host_id + required: false + schema: + type: string + - in: query + name: offset + description: The number of inputs to skip before starting to collect the result set. + schema: + type: integer + minimum: 0 + default: 0 + required: false + - in: query + name: limit + description: The number of inputs to return. + schema: + type: integer + default: 50 + enum: + - 10 + - 20 + - 50 + - 100 + - 500 + required: false + responses: + '200': + description: List of inputs + content: + application/json: + schema: + type: object + properties: + inputs: + type: array + items: + type: object + properties: + id: + type: string + filename: + type: string + file_path: + type: string + input_name: + type: string + mimetype: + type: string + format_name: + type: string + model_name: + type: string + revision: + type: string + sitename: + type: string + tag: + type: string + hostname: + type: string + start_date: + type: string + end_date: + type: string + count: + type: integer + next_page: + type: string + prev_page: + type: string + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Workflows not found + + /api/inputs/{input_id}: + get: + tags: + - inputs + summary: Download a desired PEcAn input file + parameters: + - in: path + name: input_id + description: ID of the PEcAn Input to be downloaded + required: true + schema: + type: string + - in: query + name: filename + description: Optional filename specified if the id points to a folder instead of file + required: false + schema: + type: string + responses: + '200': + description: Contents of the desired input file + content: + application/octet-stream: + schema: + type: string + format: binary + '400': + description: Bad request. Input ID points to directory & filename is not specified + '401': + description: Authentication required + '403': + description: Access forbidden + + /api/workflows/: + get: + tags: + - workflows + summary: Get the list of workflows + parameters: + - in: query + name: model_id + description: If provided, returns all workflows that use the provided model_id + required: false + schema: + type: string + - in: query + name: site_id + description: If provided, returns all workflows that use the provided site_id + required: false + schema: + type: string + - in: query + name: offset + description: The number of workflows to skip before starting to collect the result set. + schema: + type: integer + minimum: 0 + default: 0 + required: false + - in: query + name: limit + description: The number of workflows to return. + schema: + type: integer + default: 50 + enum: + - 10 + - 20 + - 50 + - 100 + - 500 + required: false + responses: + '200': + description: List of workflows + content: + application/json: + schema: + type: object + properties: + workflows: + type: array + items: + type: object + properties: + id: + type: string + folder: + type: string + started_at: + type: string + finished_at: + type: string + site_id: + type: integer + model_id: + type: integer + hostname: + type: string + start_date: + type: string + end_date: + type: string + user_id: + type: integer + count: + type: integer + next_page: + type: string + prev_page: + type: string + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Workflows not found + + post: + tags: + - workflows + summary: Submit a new PEcAn workflow + requestBody: + required: true + content: + application/xml: + schema: + $ref: '#/components/schemas/Workflow_POST' + application/json: + schema: + $ref: '#/components/schemas/Workflow_POST' + + responses: + '201': + description: Submitted workflow successfully + '401': + description: Authentication required + '415': + description: Unsupported request content type + + + /api/workflows/{id}: + get: + tags: + - workflows + summary: Get the details of a PEcAn Workflow + parameters: + - in: path + name: id + description: ID of the PEcAn Workflow + required: true + schema: + type: string + responses: + '200': + description: Details of the requested PEcAn Workflow + content: + application/json: + schema: + $ref: '#/components/schemas/Workflow_GET' + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Workflow with specified ID was not found + + /api/workflows/{id}/status: + get: + tags: + - workflows + summary: Get the status of a PEcAn Workflow execution + parameters: + - in: path + name: id + description: ID of the PEcAn Workflow + required: true + schema: + type: string + responses: + '200': + description: Status of the requested PEcAn Workflow + content: + application/json: + schema: + type: object + properties: + workflow_id: + type: string + status: + type: string + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Workflow with specified ID was not found + + /api/workflows/{id}/file/{filename}: + get: + tags: + - workflows + summary: Download a file from a specified PEcAn workflow + parameters: + - in: path + name: id + description: ID of the PEcAn Workflow + required: true + schema: + type: string + - in: path + name: filename + description: Name of file desired + required: true + schema: + type: string + responses: + '200': + description: Contents of the output file + content: + application/octet-stream: + schema: + type: string + format: binary + + '401': + description: Authentication required + '403': + description: Access forbidden + + /api/runs/: + get: + tags: + - runs + summary: Get the list of all runs for a specified PEcAn Workflow + parameters: + - in: query + name: workflow_id + description: ID of the PEcAn Workflow + required: false + schema: + type: string + - in: query + name: offset + description: The number of workflows to skip before starting to collect the result set. + schema: + type: integer + minimum: 0 + default: 0 + required: false + - in: query + name: limit + description: The number of workflows to return. + schema: + type: integer + default: 50 + enum: + - 10 + - 20 + - 50 + - 100 + - 500 + required: false + responses: + '200': + description: List of all runs for the requested PEcAn Workflow + content: + application/json: + schema: + type: object + properties: + runs: + type: array + items: + $ref: '#/components/schemas/Run' + count: + type: integer + next_page: + type: string + prev_page: + type: string + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Run(s) not found + + + /api/runs/{run_id}: + get: + tags: + - runs + summary: Get the details of a specified PEcAn run + parameters: + - in: path + name: run_id + description: ID of the PEcAn run + required: true + schema: + type: string + responses: + '200': + description: Details about the requested run + content: + application/json: + schema: + $ref: '#/components/schemas/Run' + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Run with specified ID was not found + + /api/runs/{run_id}/input/{filename}: + get: + tags: + - runs + summary: Get the details of a specified PEcAn run + parameters: + - in: path + name: run_id + description: ID of the PEcAn run + required: true + schema: + type: string + - in: path + name: filename + description: Name of input file desired + required: true + schema: + type: string + responses: + '200': + description: Contents of the input file + content: + application/octet-stream: + schema: + type: string + format: binary + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Input file not found on host + + /api/runs/{run_id}/output/{filename}: + get: + tags: + - runs + summary: Get the details of a specified PEcAn run + parameters: + - in: path + name: run_id + description: ID of the PEcAn run + required: true + schema: + type: string + - in: path + name: filename + description: Name of output file desired + required: true + schema: + type: string + responses: + '200': + description: Contents of the output file + content: + application/octet-stream: + schema: + type: string + format: binary + + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Output file not found on host + + /api/runs/{run_id}/graph/{year}/{y_var}: + get: + tags: + - runs + summary: Plot the desired variables for a run output + parameters: + - in: path + name: run_id + description: ID of the PEcAn run + required: true + schema: + type: string + - in: path + name: year + description: Year the plot is for + required: true + schema: + type: string + - in: path + name: y_var + description: Variable to plot along the Y-axis + required: true + schema: + type: string + - in: query + name: x_var + description: Variable to plot along the X-axis + required: true + schema: + type: string + default: time + - in: query + name: width + description: Width of the image generated + required: true + schema: + type: string + default: 800 + - in: query + name: height + description: Height of the image generated + required: true + schema: + type: string + default: 600 + responses: + '200': + description: Plot of the desired output variables obtained from a run + content: + image/png: + schema: + type: string + format: binary + '401': + description: Authentication required + '403': + description: Access forbidden + '404': + description: Run data not found +##################################################################################################################### +###################################################### Components ################################################### +##################################################################################################################### + +components: + schemas: + Model: + properties: + model_id: + type: string + model_name: + type: string + revision: + type: string + modeltype_id: + type: string + model_type: + type: string + inputs: + type: array + items: + type: object + properties: + input: + type: string + required: + type: boolean + + Run: + properties: + id: + type: string + workflow_id: + type: string + runtype: + type: string + ensemble_id: + type: string + model_id: + type: string + site_id: + type: string + parameter_list: + type: string + start_time: + type: string + finish_time: + type: string + started_at: + type: string + finished_at: + type: string + inputs: + type: object + properties: + info: + type: string + others: + type: array + items: + type: string + outputs: + type: object + properties: + logfile: + type: string + info: + type: string + years: + type: object + properties: + "": + type: object + properties: + data: + type: string + variables: + type: object + properties: + "": + type: string + + + Site: + properties: + id: + type: string + sitename: + type: string + city: + type: string + state: + type: string + country: + type: string + mat: + type: number + map: + type: number + soil: + type: string + som: + type: number + notes: + type: string + soilnotes: + type: string + greenhouse: + type: string + sand_pct: + type: number + time_zone: + type: string + + PFT: + properties: + pft_id: + type: string + pft_name: + type: string + pft_type: + type: string + definition: + type: string + model_type: + type: string + + Format: + properties: + format_id: + type: string + name: + type: string + notes: + type: string + header: + type: string + mimetype: + type: string + + Workflow_GET: + properties: + id: + type: string + folder: + type: string + hostname: + type: string + user_id: + type: string + "properties": + type: object + properties: + pfts: + type: array + items: + type: string + input_met: + type: string + modelid: + type: string + siteid: + type: string + sitename: + type: string + sitegroupid: + type: string + start: + type: string + end: + type: string + variables: + type: string + sensitivity: + type: string + email: + type: string + notes: + type: string + runs: + type: integer + example: 1 + pecan_edit: + type: string + status: + type: string + fluxusername: + type: string + input_poolinitcond: + type: string + files: + type: array + items: + type: string + + Workflow_POST: + type: object + xml: + name: pecan + properties: + pfts: + type: object + properties: + pft: + type: object + properties: + name: + type: string + example: temperate.coniferous + meta.analysis: + type: object + properties: + iter: + type: integer + example: 100 + random.effects: + type: boolean + example: "FALSE" + threshold: + type: number + example: 1.2 + update: + type: string + example: AUTO + ensemble: + type: object + properties: + size: + type: number + example: 10 + variable: + type: string + example: NPP + sensitivity.analysis: + type: object + properties: + quantiles: + type: object + properties: + sigma: + type: array + items: + type: integer + example: [-1, 1] + variable: + type: string + example: NPP + model: + type: object + properties: + "type": + type: string + example: SIPNET + revision: + type: string + example: r136 + run: + type: object + properties: + site: + type: object + properties: + id: + type: string + example: 772 + inputs: + type: object + properties: + met: + type: object + properties: + id: + type: string + example: "99000000003" + start.date: + type: string + example: "2002-01-01 00:00:00" + end.date: + type: string + example: "2002-12-31 00:00:00" + dbfiles: + type: string + example: pecan/dbfiles + securitySchemes: + basicAuth: + type: http + scheme: basic diff --git a/apps/api/test_pecanapi.sh b/apps/api/test_pecanapi.sh new file mode 100755 index 00000000000..59064c6b3e1 --- /dev/null +++ b/apps/api/test_pecanapi.sh @@ -0,0 +1,12 @@ +#!/bin/bash + +cd R; ./entrypoint.R 2>/dev/null & +PID=$! + +while ! curl --output /dev/null --silent http://localhost:8000 +do + sleep 1 && echo -n . +done + +cd ../tests; ./alltests.R +kill $PID \ No newline at end of file diff --git a/apps/api/tests/alltests.R b/apps/api/tests/alltests.R new file mode 100755 index 00000000000..ffd3c10d4f6 --- /dev/null +++ b/apps/api/tests/alltests.R @@ -0,0 +1,3 @@ +#!/usr/bin/env Rscript + +testthat::test_dir("./") \ No newline at end of file diff --git a/apps/api/tests/test.auth.R b/apps/api/tests/test.auth.R new file mode 100644 index 00000000000..20fe35ef213 --- /dev/null +++ b/apps/api/tests/test.auth.R @@ -0,0 +1,24 @@ +context("Testing authentication for API") + +test_that("Using correct username & password returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/models/", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Using incorrect username & password returns Status 401", { + res <- httr::GET( + "http://localhost:8000/api/models/", + httr::authenticate("carya", "wrong_password") + ) + expect_equal(res$status, 401) +}) + +test_that("Not using username & password returns Status 401", { + res <- httr::GET( + "http://localhost:8000/api/models/", + ) + expect_equal(res$status, 401) +}) \ No newline at end of file diff --git a/apps/api/tests/test.formats.R b/apps/api/tests/test.formats.R new file mode 100644 index 00000000000..6261b711bf5 --- /dev/null +++ b/apps/api/tests/test.formats.R @@ -0,0 +1,33 @@ +context("Testing all formats related endpoints") + +test_that("Calling /api/formats/ with valid parameters returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/formats/?format_name=ameriflux&mimetype=csv&ignore_case=TRUE", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/formats/ with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/formats/?format_name=random&mimetype=random&ignore_case=TRUE", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/formats/{format_id} returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/formats/19", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/formats/{format_id} with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/formats/0", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) \ No newline at end of file diff --git a/apps/api/tests/test.inputs.R b/apps/api/tests/test.inputs.R new file mode 100644 index 00000000000..cba2ee9e792 --- /dev/null +++ b/apps/api/tests/test.inputs.R @@ -0,0 +1,49 @@ +context("Testing all inputs related endpoints") + +test_that("Calling /api/inputs/ with valid parameters returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/inputs/?model_id=1000000022&site_id=676", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/inputs/ with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/inputs/?model_id=0&site_id=0", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/inputs/{input_id} with valid parameters returns Status 200", { + res <- httr::GET( + paste0("http://localhost:8000/api/inputs/", 99000000003), + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/inputs/{input_id} with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/inputs/0", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/inputs/{input_id}?filename={filename} with valid parameters returns Status 200", { + res <- httr::GET( + paste0("http://localhost:8000/api/inputs/295?filename=fraction.plantation"), + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/inputs/{input_id}?filename={filename} with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/inputs/295?filename=random", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 400) +}) diff --git a/apps/api/tests/test.models.R b/apps/api/tests/test.models.R new file mode 100644 index 00000000000..d1be63b006f --- /dev/null +++ b/apps/api/tests/test.models.R @@ -0,0 +1,33 @@ +context("Testing all models endpoints") + +test_that("Calling /api/models/ returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/models/?model_name=SIPNET&revision=ssr", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/models/ with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/models/?model_name=random&revision=random", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/models/{model_id} returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/models/1000000014", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/models/{model_id} with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/models/1", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) \ No newline at end of file diff --git a/apps/api/tests/test.pfts.R b/apps/api/tests/test.pfts.R new file mode 100644 index 00000000000..b4de5cbe393 --- /dev/null +++ b/apps/api/tests/test.pfts.R @@ -0,0 +1,33 @@ +context("Testing all PFTs endpoints") + +test_that("Calling /api/pfts/ returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/pfts/?pft_name=temperate&pft_type=plant&model_type=sipnet", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/pfts/ with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/pfts/?pft_name=random&model_type=random", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/pfts/{pft_id} returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/pfts/2000000045", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/pfts/{pft_id} with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/pfts/0", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) \ No newline at end of file diff --git a/apps/api/tests/test.ping.R b/apps/api/tests/test.ping.R new file mode 100644 index 00000000000..defd30bdb45 --- /dev/null +++ b/apps/api/tests/test.ping.R @@ -0,0 +1,6 @@ +context("Testing the /api/ping endpoint") + +test_that("Calling /api/ping returns Status 200", { + res <- httr::GET("http://localhost:8000/api/ping") + expect_equal(res$status, 200) +}) \ No newline at end of file diff --git a/apps/api/tests/test.runs.R b/apps/api/tests/test.runs.R new file mode 100644 index 00000000000..f88e8977f82 --- /dev/null +++ b/apps/api/tests/test.runs.R @@ -0,0 +1,83 @@ +context("Testing all runs endpoints") + +test_that("Calling /api/runs/ with a valid workflow id returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/?workflow_id=1000009172", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + + + +test_that("Calling /api/runs/{id} with a valid run id returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/1002042201", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/runs/ with a invalid workflow id returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/runs/?workflow_id=1000000000", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/runs/{id} with a invalid run id returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/runs/1000000000", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/runs/{run_id}/graph/{year}/{yvar}/ with valid inputs returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/99000000282/graph/2002/GPP", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/runs/{run_id}/graph/{year}/{yvar}/ with valid inputs returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/1000000000/graph/100/GPP", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/runs/{run_id}/input/{filename} with valid inputs returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/99000000282/input/sipnet.in", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/runs/{run_id}/input/{filename} with valid inputs returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/1000000000/input/randomfile", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/runs/{run_id}/output/{filename} with valid inputs returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/99000000282/output/2002.nc", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/runs/{run_id}/output/{filename} with valid inputs returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/runs/1000000000/output/randomfile", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) diff --git a/apps/api/tests/test.sites.R b/apps/api/tests/test.sites.R new file mode 100644 index 00000000000..a636390ab28 --- /dev/null +++ b/apps/api/tests/test.sites.R @@ -0,0 +1,33 @@ +context("Testing all sites endpoints") + +test_that("Calling /api/sites/ returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/sites/?sitename=washington", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/sites/ with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/sites/?sitename=random", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/sites/{site_id} returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/sites/676", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/sites/{site_id} with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/sites/0", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) \ No newline at end of file diff --git a/apps/api/tests/test.status.R b/apps/api/tests/test.status.R new file mode 100644 index 00000000000..ffd3ae54d34 --- /dev/null +++ b/apps/api/tests/test.status.R @@ -0,0 +1,6 @@ +context("Testing the /api/status endpoint") + +test_that("Calling /api/status returns Status 200", { + res <- httr::GET("http://localhost:8000/api/status") + expect_equal(res$status, 200) +}) \ No newline at end of file diff --git a/apps/api/tests/test.workflows.R b/apps/api/tests/test.workflows.R new file mode 100644 index 00000000000..fb650bbf732 --- /dev/null +++ b/apps/api/tests/test.workflows.R @@ -0,0 +1,92 @@ +context("Testing all workflows endpoints") + +test_that("Calling /api/workflows/ with valid parameters returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/workflows/?model_id=1000000022&site_id=676", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + + + +test_that("Calling /api/workflows/{id} with valid workflow id returns Status 200", { + res <- httr::GET( + "http://localhost:8000/api/workflows/1000009172", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/workflows/ with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/workflows/?model_id=1000000000&site_id=1000000000", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + + + +test_that("Calling /api/workflows/{id} with invalid workflow id returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/workflows/1000000000", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Submitting XML workflow to /api/workflows/ returns Status 201", { + xml_string <- paste0(xml2::read_xml("test_workflows/api.sipnet.xml")) + res <- httr::POST( + "http://localhost:8000/api/workflows/", + httr::authenticate("carya", "illinois"), + httr::content_type("application/xml"), + body = xml_string + ) + expect_equal(res$status, 201) +}) + +test_that("Submitting JSON workflow to /api/workflows/ returns Status 201", { + Sys.sleep(2) + json_workflow <- jsonlite::read_json("test_workflows/api.sipnet.json") + res <- httr::POST( + "http://localhost:8000/api/workflows/", + httr::authenticate("carya", "illinois"), + body = json_workflow, + encode='json' + ) + expect_equal(res$status, 201) +}) + +test_that("Calling /api/workflows/{id}/status with valid workflow id returns Status 200", { + res <- httr::GET( + paste0("http://localhost:8000/api/workflows/", 99000000031, "/status"), + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/workflows/{id}/status with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/workflows/0/status", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) + +test_that("Calling /api/workflows/{id}/file/{filename} with valid parameters returns Status 200", { + res <- httr::GET( + paste0("http://localhost:8000/api/workflows/", 99000000031, "/file/", "pecan.CONFIGS.xml"), + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 200) +}) + +test_that("Calling /api/workflows/{id}/file/{filename} with invalid parameters returns Status 404", { + res <- httr::GET( + "http://localhost:8000/api/workflows/0/file/randomfile.txt", + httr::authenticate("carya", "illinois") + ) + expect_equal(res$status, 404) +}) \ No newline at end of file diff --git a/apps/api/tests/test_workflows/api.sipnet.json b/apps/api/tests/test_workflows/api.sipnet.json new file mode 100644 index 00000000000..12652891885 --- /dev/null +++ b/apps/api/tests/test_workflows/api.sipnet.json @@ -0,0 +1,34 @@ +{ + "pfts": { + "pft": { + "name": "temperate.coniferous" + } + }, + "meta.analysis": { + "iter": 100, + "random.effects": "FALSE", + "threshold": 1.2, + "update": "AUTO" + }, + "ensemble": { + "size": 1, + "variable": "NPP" + }, + "model": { + "type": "SIPNET", + "revision": "r136" + }, + "run": { + "site": { + "id": 772 + }, + "inputs": { + "met": { + "id": "99000000003" + } + }, + "start.date": "2002-01-01 00:00:00", + "end.date": "2002-12-31 00:00:00", + "dbfiles": "pecan/dbfiles" + } +} \ No newline at end of file diff --git a/apps/api/tests/test_workflows/api.sipnet.xml b/apps/api/tests/test_workflows/api.sipnet.xml new file mode 100644 index 00000000000..903a11befb2 --- /dev/null +++ b/apps/api/tests/test_workflows/api.sipnet.xml @@ -0,0 +1,39 @@ + + + + + temperate.coniferous + + + + + 3000 + FALSE + 1.2 + AUTO + + + + 1 + NPP + + + + SIPNET + r136 + + + + + 772 + + + + 99000000003 + + + 2002-01-01 00:00:00 + 2002-12-31 00:00:00 + pecan/dbfiles + + \ No newline at end of file diff --git a/apps/api/tests/testthat.R b/apps/api/tests/testthat.R new file mode 100644 index 00000000000..527042724a4 --- /dev/null +++ b/apps/api/tests/testthat.R @@ -0,0 +1 @@ +library(testthat) diff --git a/base/all/DESCRIPTION b/base/all/DESCRIPTION index 0df2902e104..433a56017b4 100644 --- a/base/all/DESCRIPTION +++ b/base/all/DESCRIPTION @@ -2,8 +2,8 @@ Package: PEcAn.all Type: Package Title: PEcAn functions used for ecological forecasts and reanalysis -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("David","LeBauer"), person("Xiaohui", "Feng"), @@ -56,9 +56,9 @@ Suggests: PEcAn.allometry, PEcAn.photosynthesis, testthat -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/base/all/data/pecan.packages.csv b/base/all/data/pecan.packages.csv index 0faa264c50e..4fc9fa6db82 100644 --- a/base/all/data/pecan.packages.csv +++ b/base/all/data/pecan.packages.csv @@ -1,4 +1,2 @@ 1;2;3;4;5;6;7;8;9;10;11;12;13;14;15;16;17;18 -"utils";"common";"db";"modules/meta.analysis";"modules/uncertainty";"modules/emulator";"modules/assim.batch";"modules/assim.sequential";"modules/data.land";"modules/photosythesis";"modules/priors";"modules/rtm";"modules/benchmark";models/c4photo";"models/ed";"models/sipnet";"models/maat";"all" - - +"utils";"common";"db";"modules/meta.analysis";"modules/uncertainty";"modules/emulator";"modules/assim.batch";"modules/assim.sequential";"modules/data.land";"modules/photosythesis";"modules/priors";"modules/rtm";"modules/benchmark";"models/c4photo";"models/ed";"models/sipnet";"models/maat";"all" diff --git a/base/all/tests/Rcheck_reference.log b/base/all/tests/Rcheck_reference.log new file mode 100644 index 00000000000..716da54d3b8 --- /dev/null +++ b/base/all/tests/Rcheck_reference.log @@ -0,0 +1,56 @@ +* using log directory ‘/tmp/Rtmp3UHCCJ/PEcAn.all.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.all/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.all’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... NOTE +Depends: includes the non-default packages: + ‘PEcAn.DB’ ‘PEcAn.settings’ ‘PEcAn.MA’ ‘PEcAn.logger’ ‘PEcAn.utils’ + ‘PEcAn.uncertainty’ ‘PEcAn.data.atmosphere’ ‘PEcAn.data.land’ + ‘PEcAn.data.remote’ ‘PEcAn.assim.batch’ ‘PEcAn.emulator’ + ‘PEcAn.priors’ ‘PEcAn.benchmark’ ‘PEcAn.remote’ ‘PEcAn.workflow’ +Adding so many packages to the search path is excessive and importing +selectively is preferable. +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.all’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking for missing documentation entries ... WARNING +Undocumented data sets: + ‘pecan.packages’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking contents of ‘data’ directory ... OK +* checking data for non-ASCII characters ... OK +* checking data for ASCII and uncompressed saves ... OK +* checking examples ... NONE +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 1 WARNING, 2 NOTEs diff --git a/base/all/tests/testthat/test.workflow.R b/base/all/tests/testthat/test.workflow.R index dc540016780..2e2b6e5dcac 100644 --- a/base/all/tests/testthat/test.workflow.R +++ b/base/all/tests/testthat/test.workflow.R @@ -19,4 +19,4 @@ # run.write.configs("ED2") # clear.scratch(settings) # start.model.runs("ED2") -# get.model.output("ED2") +# get.results(settings) diff --git a/base/db/DESCRIPTION b/base/db/DESCRIPTION index aa31ac36663..6b653fc3033 100644 --- a/base/db/DESCRIPTION +++ b/base/db/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAn.DB Type: Package Title: PEcAn functions used for ecological forecasts and reanalysis -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("David", "LeBauer", role = c("aut", "cre"), email = "dlebauer@email.arizona.edu", comment = c(ORCID = "0000-0001-7228-053X")), @@ -37,7 +37,8 @@ Authors@R: c(person("David", "LeBauer", role = c("aut", "cre"), person("Ryan", "Kelly", role = c("aut")), person("Dan", "Wang", role = c("aut")), person("Carl", "Davidson", role = c("aut")), - person("Xiaohui", "Feng", role = c("aut"))) + person("Xiaohui", "Feng", role = c("aut")), + person("Shashank", "Singh", role = c("aut"))) Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific workflow management tool that is designed to simplify the management of model parameterization, execution, and analysis. The goal of PECAn is to @@ -50,11 +51,13 @@ Imports: PEcAn.utils, dbplyr, dplyr, + fs, glue, lubridate, magrittr, ncdf4, purrr, + R.utils, rlang, tibble, tidyr, @@ -63,14 +66,15 @@ Suggests: RPostgreSQL, RPostgres, RSQLite, + bit64, data.table, here, rcrossref, testthat (>= 2.0.0), tidyverse -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/base/db/NAMESPACE b/base/db/NAMESPACE index cb9ae447563..2aa2d3a7ad7 100644 --- a/base/db/NAMESPACE +++ b/base/db/NAMESPACE @@ -20,6 +20,7 @@ export(dbfile.id) export(dbfile.input.check) export(dbfile.input.insert) export(dbfile.insert) +export(dbfile.move) export(dbfile.posterior.check) export(dbfile.posterior.insert) export(default_hostname) @@ -30,6 +31,7 @@ export(fancy_scientific) export(get.id) export(get.trait.data) export(get.trait.data.pft) +export(get_postgres_envvars) export(get_run_ids) export(get_users) export(get_var_names) @@ -50,7 +52,6 @@ export(query.trait.data) export(query.traits) export(query_pfts) export(query_priors) -export(rename_jags_columns) export(runs) export(search_references) export(symmetric_setdiff) @@ -62,4 +63,5 @@ export(workflows) importFrom(magrittr,"%>%") importFrom(rlang,"!!!") importFrom(rlang,"!!") +importFrom(rlang,":=") importFrom(rlang,.data) diff --git a/base/db/NEWS.md b/base/db/NEWS.md new file mode 100644 index 00000000000..e607aac3350 --- /dev/null +++ b/base/db/NEWS.md @@ -0,0 +1,10 @@ +# PEcAn.DB 1.7.1.9000 + +## Removed + +* `rename_jags_columns()` has been removed from `PEcAn.DB` but is now available in package `PEcAn.MA` (#2805, @moki1202). + + +# PEcAn.DB 1.7.1 + +* All changes in 1.7.1 and earlier were recorded in a single file for all of the PEcAn packages; please see https://github.com/PecanProject/pecan/blob/v1.7.1/CHANGELOG.md for details. diff --git a/base/db/R/zzz.R b/base/db/R/PEcAn.DB-package.R similarity index 77% rename from base/db/R/zzz.R rename to base/db/R/PEcAn.DB-package.R index 5fa815e0e9f..3466f70b4ff 100644 --- a/base/db/R/zzz.R +++ b/base/db/R/PEcAn.DB-package.R @@ -3,11 +3,10 @@ #' This package provides an interface between PEcAn and the BETY database. #' For usage examples, please see \code{vignette("betydb_access")} #' -#' @docType package -#' @name PEcAn.DB +#' @keywords internal #' @importFrom magrittr %>% -#' @importFrom rlang .data !! !!! -NULL +#' @importFrom rlang .data !! !!! := +"_PACKAGE" #' @export magrittr::`%>%` diff --git a/base/db/R/assign.treatments.R b/base/db/R/assign.treatments.R new file mode 100644 index 00000000000..5e22285e837 --- /dev/null +++ b/base/db/R/assign.treatments.R @@ -0,0 +1,48 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##-----------------------------------------------------------------------------# +##' Change treatments to sequential integers +##' +##' Assigns all control treatments the same value, then assigns unique treatments +##' within each site. Each site is required to have a control treatment. +##' The algorithm (incorrectly) assumes that each site has a unique set of experimental +##' treatments. This assumption is required by the data in BETTdb that does not always consistently name treatments or quantity them in the managements table. Also it avoids having the need to estimate treatment by site interactions in the meta analysis model. This model uses data in the control treatment to estimate model parameters so the impact of the assumption is minimal. +##' @name assign.treatments +##' @title assign.treatments +##' @param data input data +##' @return dataframe with sequential treatments +##' @export +##' @author David LeBauer, Carl Davidson, Alexey Shiklomanov +assign.treatments <- function(data){ + data$trt_id[which(data$control == 1)] <- "control" + sites <- unique(data$site_id) + # Site IDs may be returned as `integer64`, which the `for` loop + # type-coerces to regular integer, which turns it into gibberish. + # Looping over the index instead prevents this type coercion. + for (si in seq_along(sites)) { + ss <- sites[[si]] + site.i <- data$site_id == ss + #if only one treatment, it's control + if (length(unique(data$trt_id[site.i])) == 1) data$trt_id[site.i] <- "control" + if (!"control" %in% data$trt_id[site.i]){ + PEcAn.logger::logger.severe(paste0( + "No control treatment set for site_id ", unique(data$site_id[site.i]), + " and citation id ", unique(data$citation_id[site.i]), ".\n", + "Please set control treatment for this site / citation in database.\n" + )) + } + } + return(data) +} + +drop.columns <- function(data, columns){ + return(data[, which(!colnames(data) %in% columns)]) +} +##=============================================================================# diff --git a/base/db/R/check.lists.R b/base/db/R/check.lists.R new file mode 100644 index 00000000000..18e7c8b3840 --- /dev/null +++ b/base/db/R/check.lists.R @@ -0,0 +1,35 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##--------------------------------------------------------------------------------------------------# +##' Check two lists. Identical does not work since one can be loaded +##' from the database and the other from a CSV file. +##' +##' @name check.lists +##' @title Compares two lists +##' @param x first list +##' @param y second list +##' @param filename one of "species.csv" or "cultivars.csv" +##' @return true if two lists are the same +##' @author Rob Kooper +##' +check.lists <- function(x, y, filename = "species.csv") { + if (nrow(x) != nrow(y)) { + return(FALSE) + } + if(filename == "species.csv"){ + cols <- c('id', 'genus', 'species', 'scientificname') + } else if (filename == "cultivars.csv") { + cols <- c('id', 'specie_id', 'species_name', 'cultivar_name') + } else { + return(FALSE) + } + xy_match <- vapply(cols, function(i) identical(as.character(x[[i]]), as.character(y[[i]])), logical(1)) + return(all(unlist(xy_match))) +} diff --git a/base/db/R/clone_pft.R b/base/db/R/clone_pft.R index 81e0b19bc8c..9460cb85582 100644 --- a/base/db/R/clone_pft.R +++ b/base/db/R/clone_pft.R @@ -2,8 +2,8 @@ ##' ##' Creates a new pft that is a duplicate of an existing pft, ##' including relationships with priors, species, and cultivars (if any) of the existing pft. -##' This function mimics the 'clone pft' button in the PFTs record view page in the -##' BETYdb web interface for PFTs that aggregate >=1 species, but adds the ability to +##' This function mimics the 'clone pft' button in the PFTs record view page in the +##' BETYdb web interface for PFTs that aggregate >=1 species, but adds the ability to ##' clone the cultivar associations. ##' ##' @param parent.pft.name name of PFT to duplicate @@ -32,10 +32,10 @@ clone_pft <- function(parent.pft.name, } con <- db.open(settings$database$bety) - on.exit(db.close(con)) + on.exit(db.close(con), add = TRUE) parent.pft <- (dplyr::tbl(con, "pfts") - %>% dplyr::filter(name == !!parent.pft.name) + %>% dplyr::filter(.data$name == !!parent.pft.name) %>% dplyr::collect()) if (nrow(parent.pft) == 0) { @@ -43,7 +43,7 @@ clone_pft <- function(parent.pft.name, } new.pft <- (parent.pft - %>% dplyr::select(-id, -created_at, -updated_at) + %>% dplyr::select(-.data$id, -.data$created_at, -.data$updated_at) %>% dplyr::mutate( name = !!new.pft.name, definition = !!new.pft.definition, @@ -58,8 +58,8 @@ clone_pft <- function(parent.pft.name, row.names = FALSE) new.pft$id <- (dplyr::tbl(con, "pfts") - %>% dplyr::filter(name == !!new.pft.name) - %>% dplyr::pull(id)) + %>% dplyr::filter(.data$name == !!new.pft.name) + %>% dplyr::pull(.data$id)) # PFT members are stored in different tables depending on pft_type. @@ -72,7 +72,7 @@ clone_pft <- function(parent.pft.name, member_tbl <- "pfts_species" } new_members <- (dplyr::tbl(con, member_tbl) - %>% dplyr::filter(pft_id == !!parent.pft$id) + %>% dplyr::filter(.data$pft_id == !!parent.pft$id) %>% dplyr::mutate(pft_id = !!new.pft$id) %>% dplyr::distinct() %>% dplyr::collect()) @@ -87,7 +87,7 @@ clone_pft <- function(parent.pft.name, } new_priors <- (dplyr::tbl(con, "pfts_priors") - %>% dplyr::filter(pft_id == !!parent.pft$id) + %>% dplyr::filter(.data$pft_id == !!parent.pft$id) %>% dplyr::mutate(pft_id = !!new.pft$id) %>% dplyr::distinct() %>% dplyr::collect()) diff --git a/base/db/R/covariate.functions.R b/base/db/R/covariate.functions.R new file mode 100644 index 00000000000..31c93009ee9 --- /dev/null +++ b/base/db/R/covariate.functions.R @@ -0,0 +1,124 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +######################## COVARIATE FUNCTIONS ################################# + +##--------------------------------------------------------------------------------------------------# +##' Append covariate data as a column within a table +##' +##' \code{append.covariate} appends a data frame of covariates as a new column in a data frame +##' of trait data. +##' In the event a trait has several covariates available, the first one found +##' (i.e. lowest row number) will take precedence +##' +##' @param data trait dataframe that will be appended to. +##' @param column.name name of the covariate as it will appear in the appended column +##' @param covariates.data one or more tables of covariate data, ordered by the precedence +##' they will assume in the event a trait has covariates across multiple tables. +##' All tables must contain an 'id' and 'level' column, at minimum. +##' +##' @author Carl Davidson, Ryan Kelly +##' @export +##--------------------------------------------------------------------------------------------------# +append.covariate <- function(data, column.name, covariates.data){ + # Keep only the highest-priority covariate for each trait + covariates.data <- covariates.data[!duplicated(covariates.data$trait_id), ] + + # Select columns to keep, and rename the covariate column + covariates.data <- covariates.data[, c('trait_id', 'level')] + names(covariates.data) <- c('id', column.name) + + # Merge on trait ID + merged <- merge(covariates.data, data, all = TRUE, by = "id") + return(merged) +} +##==================================================================================================# + + +##--------------------------------------------------------------------------------------------------# +##' Queries covariates from database for a given vector of trait id's +##' +##' @param trait.ids list of trait ids +##' @param con database connection +##' @param ... extra arguments +##' +##' @author David LeBauer +query.covariates <- function(trait.ids, con = NULL, ...){ + covariate.query <- paste("select covariates.trait_id, covariates.level,variables.name", + "from covariates left join variables on variables.id = covariates.variable_id", + "where trait_id in (", PEcAn.utils::vecpaste(trait.ids), ")") + covariates <- db.query(query = covariate.query, con = con) + return(covariates) +} +##==================================================================================================# + + +##--------------------------------------------------------------------------------------------------# +##' Apply Arrhenius scaling to 25 degC for temperature-dependent traits +##' +##' @param data data frame of data to scale, as returned by query.data() +##' @param covariates data frame of covariates, as returned by query.covariates(). +##' Note that data with no matching covariates will be unchanged. +##' @param temp.covariates names of covariates used to adjust for temperature; +##' if length > 1, order matters (first will be used preferentially) +##' @param new.temp the reference temperature for the scaled traits. Curerntly 25 degC +##' @param missing.temp the temperature assumed for traits with no covariate found. Curerntly 25 degC +##' @author Carl Davidson, David LeBauer, Ryan Kelly +arrhenius.scaling.traits <- function(data, covariates, temp.covariates, new.temp = 25, missing.temp = 25){ + # Select covariates that match temp.covariates + covariates <- covariates[covariates$name %in% temp.covariates,] + + if(nrow(covariates)>0) { + # Sort covariates in order of priority + covariates <- do.call(rbind, + lapply(temp.covariates, function(temp.covariate) covariates[covariates$name == temp.covariate, ]) + ) + + data <- append.covariate(data, 'temp', covariates) + + # Assign default value for traits with no covariates + data$temp[is.na(data$temp)] <- missing.temp + + # Scale traits + data$mean <- PEcAn.utils::arrhenius.scaling(observed.value = data$mean, old.temp = data$temp, new.temp=new.temp) + data$stat <- PEcAn.utils::arrhenius.scaling(observed.value = data$stat, old.temp = data$temp, new.temp=new.temp) + + #remove temporary covariate column. + data<-data[,colnames(data)!='temp'] + } else { + data <- NULL + } + return(data) +} +##==================================================================================================# + + +##--------------------------------------------------------------------------------------------------# +##' Function to filter out upper canopy leaves +##' +##' @name filter_sunleaf_traits +##' @aliases filter.sunleaf.traits +##' @param data input data +##' @param covariates covariate data +##' +##' @author David LeBauer +filter_sunleaf_traits <- function(data, covariates){ + if(length(covariates)>0) { + data <- append.covariate(data = data, column.name = 'canopy_layer', + covariates.data = covariates[covariates$name == 'canopy_layer',]) + data <- data[data$canopy_layer >= 0.66 | is.na(data$canopy_layer),] + + # remove temporary covariate column + data <- data[,colnames(data)!='canopy_layer'] + } else { + data <- NULL + } + return(data) +} +##==================================================================================================# \ No newline at end of file diff --git a/base/db/R/dbfiles.R b/base/db/R/dbfiles.R index ba23a628456..ba7dccbaf75 100644 --- a/base/db/R/dbfiles.R +++ b/base/db/R/dbfiles.R @@ -30,27 +30,34 @@ ##' @author Rob Kooper, Betsy Cowdery ##' @examples ##' \dontrun{ -##' dbfile.input.insert('trait.data.Rdata', siteid, startdate, enddate, 'application/x-RData', 'traits', dbcon) +##' dbfile.input.insert( +##' in.path = 'trait.data.Rdata', +##' in.prefix = siteid, +##' startdate = startdate, +##' enddate = enddate, +##' mimetype = 'application/x-RData', +##' formatname = 'traits', +##' con = dbcon) ##' } dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, mimetype, formatname, - parentid=NA, con, hostname=PEcAn.remote::fqdn(), allow.conflicting.dates=FALSE, ens=FALSE) { + parentid = NA, con, hostname = PEcAn.remote::fqdn(), allow.conflicting.dates = FALSE, ens = FALSE) { name <- basename(in.path) hostname <- default_hostname(hostname) - + # find mimetype, if it does not exist, it will create one mimetypeid <- get.id("mimetypes", "type_string", mimetype, con, create = TRUE) - + # find appropriate format, create if it does not exist formatid <- get.id( table = "formats", - colnames = c('mimetype_id', 'name'), + colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con, create = TRUE, dates = TRUE ) - - + + # setup parent part of query if specified if (is.na(parentid)) { parent <- "" @@ -68,23 +75,28 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, ), con = con ) - + inputid <- NULL if (nrow(existing.input) > 0) { # Convert dates to Date objects and strip all time zones (DB values are timezone-free) - startdate <- lubridate::force_tz(time = lubridate::as_date(startdate), tzone = 'UTC') - enddate <- lubridate::force_tz(time = lubridate::as_date(enddate), tzone = 'UTC') - existing.input$start_date <- lubridate::force_tz(time = lubridate::as_date(existing.input$start_date), tzone = 'UTC') - existing.input$end_date <- lubridate::force_tz(time = lubridate::as_date(existing.input$end_date), tzone = 'UTC') - + if (!is.null(startdate)) { + startdate <- lubridate::force_tz(time = lubridate::as_date(startdate), tzone = "UTC") + } + if (!is.null(enddate)) { + enddate <- lubridate::force_tz(time = lubridate::as_date(enddate), tzone = "UTC") + } + existing.input$start_date <- lubridate::force_tz(time = lubridate::as_date(existing.input$start_date), tzone = "UTC") + existing.input$end_date <- lubridate::force_tz(time = lubridate::as_date(existing.input$end_date), tzone = "UTC") + for (i in seq_len(nrow(existing.input))) { - existing.input.i <- existing.input[i,] - if (existing.input.i$start_date == startdate && existing.input.i$end_date == enddate) { - inputid <- existing.input.i[['id']] - break + existing.input.i <- existing.input[i, ] + if (is.na(existing.input.i$start_date) && is.null(startdate)) { + inputid <- existing.input.i[["id"]] + } else if (existing.input.i$start_date == startdate && existing.input.i$end_date == enddate) { + inputid <- existing.input.i[["id"]] } } - + if (is.null(inputid) && !allow.conflicting.dates) { print(existing.input, digits = 10) PEcAn.logger::logger.error(paste0( @@ -98,59 +110,89 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, return(NULL) } } - + if (is.null(inputid)) { # Either there was no existing input, or there was but the dates don't match and # allow.conflicting.dates==TRUE. So, insert new input record. - if (parent == "") { - cmd <- paste0("INSERT INTO inputs ", - "(site_id, format_id, created_at, updated_at, start_date, end_date, name) VALUES (", - siteid, ", ", formatid, ", NOW(), NOW(), '", startdate, "', '", enddate, "','", name, "') RETURNING id") + # adding is.null(startdate) to add inputs like soil that don't have dates + if (parent == "" && is.null(startdate)) { + cmd <- paste0( + "INSERT INTO inputs ", + "(site_id, format_id, name) VALUES (", + siteid, ", ", formatid, ", '", name, + "'", ") RETURNING id" + ) + } else if (parent == "" && !is.null(startdate)) { + cmd <- paste0( + "INSERT INTO inputs ", + "(site_id, format_id, start_date, end_date, name) VALUES (", + siteid, ", ", formatid, ", '", startdate, "', '", enddate, "','", name, + "') RETURNING id" + ) + } else if (is.null(startdate)) { + cmd <- paste0( + "INSERT INTO inputs ", + "(site_id, format_id, name, parent_id) VALUES (", + siteid, ", ", formatid, ", '", name, "',", parentid, ") RETURNING id" + ) } else { - cmd <- paste0("INSERT INTO inputs ", - "(site_id, format_id, created_at, updated_at, start_date, end_date, name, parent_id) VALUES (", - siteid, ", ", formatid, ", NOW(), NOW(), '", startdate, "', '", enddate, "','", name, "',", parentid, ") RETURNING id") + cmd <- paste0( + "INSERT INTO inputs ", + "(site_id, format_id, start_date, end_date, name, parent_id) VALUES (", + siteid, ", ", formatid, ", '", startdate, "', '", enddate, "','", name, "',", parentid, ") RETURNING id" + ) } # This is the id that we just registered - inserted.id <-db.query(query = cmd, con = con) + inserted.id <- db.query(query = cmd, con = con) name.s <- name - inputid <- db.query( - query = paste0( - "SELECT id FROM inputs WHERE site_id=", siteid, - " AND format_id=", formatid, - " AND start_date='", startdate, - "' AND end_date='", enddate, - "'" , parent, ";" - ), - con = con - )$id - }else{ - inserted.id <- data.frame(id=inputid) # in the case that inputid is not null then this means that there was an exsiting input + if (is.null(startdate)) { + inputid <- db.query( + query = paste0( + "SELECT id FROM inputs WHERE site_id=", siteid, + " AND format_id=", formatid + ), + con = con + )$id + } else { + inputid <- db.query( + query = paste0( + "SELECT id FROM inputs WHERE site_id=", siteid, + " AND format_id=", formatid, + " AND start_date='", startdate, + "' AND end_date='", enddate, + "'", parent, ";" + ), + con = con + )$id + } + } else { + inserted.id <- data.frame(id = inputid) # in the case that inputid is not null then this means that there was an exsiting input } - + if (length(inputid) > 1 && !ens) { - PEcAn.logger::logger.warn(paste0("Multiple input files found matching parameters format_id = ", formatid, - ", startdate = ", startdate, ", enddate = ", enddate, ", parent = ", parent, ". Selecting the", - " last input file. This is normal for when an entire ensemble is inserted iteratively, but ", - " is likely an error otherwise.")) - inputid = inputid[length(inputid)] - } else if (ens){ + PEcAn.logger::logger.warn(paste0( + "Multiple input files found matching parameters format_id = ", formatid, + ", startdate = ", startdate, ", enddate = ", enddate, ", parent = ", parent, ". Selecting the", + " last input file. This is normal for when an entire ensemble is inserted iteratively, but ", + " is likely an error otherwise." + )) + inputid <- inputid[length(inputid)] + } else if (ens) { inputid <- inserted.id$id } - + # find appropriate dbfile, if not in database, insert new dbfile - dbfile <- dbfile.check(type = 'Input', container.id = inputid, con = con, hostname = hostname) - - if (nrow(dbfile) > 0 ) { - + dbfile <- dbfile.check(type = "Input", container.id = inputid, con = con, hostname = hostname) + + if (nrow(dbfile) > 0 & !ens) { if (nrow(dbfile) > 1) { print(dbfile) PEcAn.logger::logger.warn("Multiple dbfiles found. Using last.") - dbfile <- dbfile[nrow(dbfile),] + dbfile <- dbfile[nrow(dbfile), ] } - - if (dbfile$file_name != in.prefix || dbfile$file_path != in.path ) { + + if (dbfile$file_name != in.prefix || dbfile$file_path != in.path && !ens) { print(dbfile, digits = 10) PEcAn.logger::logger.error(paste0( "The existing dbfile record printed above has the same machine_id and container ", @@ -159,15 +201,16 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, )) dbfileid <- NA } else { - dbfileid <- dbfile[['id']] + dbfileid <- dbfile[["id"]] } - } else { - #insert dbfile & return dbfile id - dbfileid <- dbfile.insert(in.path = in.path, in.prefix = in.prefix, type = 'Input', id = inputid, - con = con, reuse = TRUE, hostname = hostname) + # insert dbfile & return dbfile id + dbfileid <- dbfile.insert( + in.path = in.path, in.prefix = in.prefix, type = "Input", id = inputid, + con = con, reuse = TRUE, hostname = hostname + ) } - + invisible(list(input.id = inputid, dbfile.id = dbfileid)) } @@ -195,126 +238,131 @@ dbfile.input.insert <- function(in.path, in.prefix, siteid, startdate, enddate, ##' \dontrun{ ##' dbfile.input.check(siteid, startdate, enddate, 'application/x-RData', 'traits', dbcon) ##' } -dbfile.input.check <- function(siteid, startdate=NULL, enddate=NULL, mimetype, formatname, parentid=NA, - con, hostname=PEcAn.remote::fqdn(), exact.dates=FALSE, pattern=NULL, return.all=FALSE) { - - - +dbfile.input.check <- function(siteid, startdate = NULL, enddate = NULL, mimetype, formatname, parentid = NA, + con, hostname = PEcAn.remote::fqdn(), exact.dates = FALSE, pattern = NULL, return.all = FALSE) { hostname <- default_hostname(hostname) - - mimetypeid <- get.id(table = 'mimetypes', colnames = 'type_string', values = mimetype, con = con) + + mimetypeid <- get.id(table = "mimetypes", colnames = "type_string", values = mimetype, con = con) if (is.null(mimetypeid)) { return(invisible(data.frame())) } - + # find appropriate format - formatid <- get.id(table = 'formats', colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con) - + formatid <- get.id(table = "formats", colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con) + if (is.null(formatid)) { invisible(data.frame()) } - + # setup parent part of query if specified if (is.na(parentid)) { parent <- "" } else { parent <- paste0(" AND parent_id=", parentid) } - + # find appropriate input if (exact.dates) { + if (!is.null(enddate)) { + inputs <- db.query( + query = paste0( + "SELECT * FROM inputs WHERE site_id=", siteid, + " AND format_id=", formatid, + " AND start_date='", startdate, + "' AND end_date='", enddate, + "'", parent + ), + con = con + ) + } else { + inputs <- db.query( + query = paste0( + "SELECT * FROM inputs WHERE site_id=", siteid, + " AND format_id=", formatid, + " AND start_date='", startdate, + "'", parent + ), + con = con + ) + } + } else { # not exact dates inputs <- db.query( - query = paste0( - "SELECT * FROM inputs WHERE site_id=", siteid, - " AND format_id=", formatid, - " AND start_date='", startdate, - "' AND end_date='", enddate, - "'", parent - ), - con = con - )#[['id']] - } else { - inputs <- db.query( - query = paste0( - "SELECT * FROM inputs WHERE site_id=", siteid, - " AND format_id=", formatid, - parent - ), - con = con - )#[['id']] + query = paste0( + "SELECT * FROM inputs WHERE site_id=", siteid, + " AND format_id=", formatid, + parent + ), + con = con + ) } - + if (is.null(inputs) | length(inputs$id) == 0) { return(data.frame()) } else { - if (!is.null(pattern)) { ## Case where pattern is not NULL - inputs <- inputs[grepl(pattern, inputs$name),] + inputs <- inputs[grepl(pattern, inputs$name), ] } - + ## parent check when NA - if (is.na(parentid)) { - inputs <- inputs[is.na(inputs$parent_id),] - } - + # if (is.na(parentid)) { + # inputs <- inputs[is.na(inputs$parent_id),] + # } + if (length(inputs$id) > 1) { PEcAn.logger::logger.warn("Found multiple matching inputs. Checking for one with associate files on host machine") print(inputs) - # ni = length(inputs$id) - # dbfile = list() - # for(i in seq_len(ni)){ - # dbfile[[i]] <- dbfile.check(type = 'Input', container.id = inputs$id[i], con = con, hostname = hostname, machine.check = TRUE) - # } - + # ni = length(inputs$id) + # dbfile = list() + # for(i in seq_len(ni)){ + # dbfile[[i]] <- dbfile.check(type = 'Input', container.id = inputs$id[i], con = con, hostname = hostname, machine.check = TRUE) + # } + dbfile <- dbfile.check( - type = 'Input', + type = "Input", container.id = inputs$id, con = con, hostname = hostname, machine.check = TRUE, return.all = return.all ) - - + + if (nrow(dbfile) == 0) { ## With the possibility of dbfile.check returning nothing, ## as.data.frame ensures a empty data.frame is returned ## rather than an empty list. PEcAn.logger::logger.info("File not found on host machine. Returning Valid input with file associated on different machine if possible") - return(as.data.frame(dbfile.check(type = 'Input', container.id = inputs$id, con = con, hostname = hostname, machine.check = FALSE))) + return(as.data.frame(dbfile.check(type = "Input", container.id = inputs$id, con = con, hostname = hostname, machine.check = FALSE))) } - + return(dbfile) } else if (length(inputs$id) == 0) { - + # need this third case here because prent check above can return an empty inputs return(data.frame()) - - }else{ - + } else { PEcAn.logger::logger.warn("Found possible matching input. Checking if its associate files are on host machine") print(inputs) dbfile <- dbfile.check( - type = 'Input', + type = "Input", container.id = inputs$id, con = con, hostname = hostname, machine.check = TRUE, return.all = return.all ) - + if (nrow(dbfile) == 0) { ## With the possibility of dbfile.check returning nothing, ## as.data.frame ensures an empty data.frame is returned ## rather than an empty list. PEcAn.logger::logger.info("File not found on host machine. Returning Valid input with file associated on different machine if possible") - return(as.data.frame(dbfile.check(type = 'Input', container.id = inputs$id, con = con, hostname = hostname, machine.check = FALSE))) + return(as.data.frame(dbfile.check(type = "Input", container.id = inputs$id, con = con, hostname = hostname, machine.check = FALSE))) } - + return(dbfile) - } } } @@ -338,45 +386,53 @@ dbfile.input.check <- function(siteid, startdate=NULL, enddate=NULL, mimetype, f ##' \dontrun{ ##' dbfile.posterior.insert('trait.data.Rdata', pft, 'application/x-RData', 'traits', dbcon) ##' } -dbfile.posterior.insert <- function(filename, pft, mimetype, formatname, con, hostname=PEcAn.remote::fqdn()) { +dbfile.posterior.insert <- function(filename, pft, mimetype, formatname, con, hostname = PEcAn.remote::fqdn()) { hostname <- default_hostname(hostname) - + # find appropriate pft pftid <- get.id("pfts", "name", pft, con) if (is.null(pftid)) { PEcAn.logger::logger.severe("Could not find pft, could not store file", filename) } - - mimetypeid <- get.id(table = 'mimetypes', colnames = 'type_string', values = mimetype, - con = con, create = TRUE) - + + mimetypeid <- get.id( + table = "mimetypes", colnames = "type_string", values = mimetype, + con = con, create = TRUE + ) + # find appropriate format - formatid <- get.id(table = "formats", colnames = c('mimetype_id', 'name'), values = c(mimetypeid, formatname), - con = con, create = TRUE, dates = TRUE) - + formatid <- get.id( + table = "formats", colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), + con = con, create = TRUE, dates = TRUE + ) + # find appropriate posterior # NOTE: This is defined but not used # posterior_ids <- get.id("posteriors", "pft_id", pftid, con) - - posteriorid_query <- paste0("SELECT id FROM posteriors WHERE pft_id=", pftid, - " AND format_id=", formatid) - posteriorid <- db.query(query = posteriorid_query, con = con)[['id']] + + posteriorid_query <- paste0( + "SELECT id FROM posteriors WHERE pft_id=", pftid, + " AND format_id=", formatid + ) + posteriorid <- db.query(query = posteriorid_query, con = con)[["id"]] if (is.null(posteriorid)) { # insert input db.query( query = paste0( - "INSERT INTO posteriors (pft_id, format_id, created_at, updated_at) VALUES (", - pftid, ", ", formatid, ", NOW(), NOW())" + "INSERT INTO posteriors (pft_id, format_id)", + " VALUES (", pftid, ", ", formatid, ")" ), con = con ) - posteriorid <- db.query(posteriorid_query, con)[['id']] + posteriorid <- db.query(posteriorid_query, con)[["id"]] } - + # NOTE: Modified by Alexey Shiklomanov. # I'm not sure how this is supposed to work, but I think it's like this - invisible(dbfile.insert(in.path = dirname(filename), in.prefix = basename(filename), type = "Posterior", id = posteriorid, - con = con, reuse = TRUE, hostname = hostname)) + invisible(dbfile.insert( + in.path = dirname(filename), in.prefix = basename(filename), type = "Posterior", id = posteriorid, + con = con, reuse = TRUE, hostname = hostname + )) } ##' Function to check to see if a file exists in the dbfiles table as an input @@ -397,26 +453,26 @@ dbfile.posterior.insert <- function(filename, pft, mimetype, formatname, con, ho ##' \dontrun{ ##' dbfile.posterior.check(pft, 'application/x-RData', 'traits', dbcon) ##' } -dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname=PEcAn.remote::fqdn()) { +dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname = PEcAn.remote::fqdn()) { hostname <- default_hostname(hostname) - + # find appropriate pft pftid <- get.id(table = "pfts", values = "name", colnames = pft, con = con) if (is.null(pftid)) { invisible(data.frame()) } - + # find appropriate format mimetypeid <- get.id(table = "mimetypes", values = "type_string", colnames = mimetype, con = con) if (is.null(mimetypeid)) { PEcAn.logger::logger.error("mimetype ", mimetype, "does not exist") } formatid <- get.id(table = "formats", colnames = c("mimetype_id", "name"), values = c(mimetypeid, formatname), con = con) - + if (is.null(formatid)) { invisible(data.frame()) } - + # find appropriate posterior posteriorid <- db.query( query = paste0( @@ -424,12 +480,12 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname=PEcA " AND format_id=", formatid ), con = con - )[['id']] + )[["id"]] if (is.null(posteriorid)) { invisible(data.frame()) } - - invisible(dbfile.check(type = 'Posterior', container.id = posteriorid, con = con, hostname = hostname)) + + invisible(dbfile.check(type = "Posterior", container.id = posteriorid, con = con, hostname = hostname)) } ##' Function to insert a file into the dbfiles table @@ -451,16 +507,16 @@ dbfile.posterior.check <- function(pft, mimetype, formatname, con, hostname=PEcA ##' \dontrun{ ##' dbfile.insert('somefile.txt', 'Input', 7, dbcon) ##' } -dbfile.insert <- function(in.path, in.prefix, type, id, con, reuse = TRUE, hostname=PEcAn.remote::fqdn()) { +dbfile.insert <- function(in.path, in.prefix, type, id, con, reuse = TRUE, hostname = PEcAn.remote::fqdn()) { hostname <- default_hostname(hostname) - - if (substr(in.path, 1, 1) != '/') { + + if (substr(in.path, 1, 1) != "/") { PEcAn.logger::logger.error("path to dbfiles:", in.path, " is not a valid full path") } - + # find appropriate host hostid <- get.id(table = "machines", colnames = "hostname", values = hostname, con = con, create = TRUE, dates = TRUE) - + # Query for existing dbfile record with same file_name, file_path, machine_id , # container_type, and container_id. dbfile <- invisible(db.query( @@ -470,29 +526,23 @@ dbfile.insert <- function(in.path, in.prefix, type, id, con, reuse = TRUE, hostn "file_path='", in.path, "' AND ", "machine_id='", hostid, "'" ), - con = con)) - + con = con + )) + if (nrow(dbfile) == 0) { - # If no exsting record, insert one - now <- format(Sys.time(), "%Y-%m-%d %H:%M:%S") - - db.query( - query = paste0("INSERT INTO dbfiles ", - "(container_type, container_id, file_name, file_path, machine_id, created_at, updated_at) VALUES (", - "'", type, "', ", id, ", '", basename(in.prefix), "', '", in.path, "', ", hostid, - ", '", now, "', '", now, "')"), - con = con - ) - - file.id <- invisible(db.query( + # If no existing record, insert one + + insert_result <- db.query( query = paste0( - "SELECT * FROM dbfiles WHERE container_type='", type, - "' AND container_id=", id, - " AND created_at='", now, - "' ORDER BY id DESC LIMIT 1" + "INSERT INTO dbfiles ", + "(container_type, container_id, file_name, file_path, machine_id) VALUES (", + "'", type, "', ", id, ", '", basename(in.prefix), "', '", in.path, "', ", hostid, + ") RETURNING id" ), con = con - )[['id']]) + ) + + file.id <- insert_result[["id"]] } else if (!reuse) { # If there is an existing record but reuse==FALSE, return NA. file.id <- NA @@ -506,10 +556,10 @@ dbfile.insert <- function(in.path, in.prefix, type, id, con, reuse = TRUE, hostn )) file.id <- NA } else { - file.id <- dbfile[['id']] + file.id <- dbfile[["id"]] } } - + # Return the new dbfile ID, or the one that existed already (reuse==T), or NA (reuse==F) return(file.id) } @@ -540,32 +590,35 @@ dbfile.check <- function(type, container.id, con, hostname = PEcAn.remote::fqdn(), machine.check = TRUE, return.all = FALSE) { - type <- match.arg(type, c("Input", "Posterior", "Model")) - + hostname <- default_hostname(hostname) - + # find appropriate host hostid <- get.id(table = "machines", colnames = "hostname", values = hostname, con = con) - if (is.null(hostid)) return(data.frame()) - + if (is.null(hostid)) { + return(data.frame()) + } + dbfiles <- dplyr::tbl(con, "dbfiles") %>% - dplyr::filter(container_type == !!type, - container_id %in% !!container.id) - + dplyr::filter( + .data$container_type == !!type, + .data$container_id %in% !!container.id + ) + if (machine.check) { dbfiles <- dbfiles %>% - dplyr::filter(machine_id == !!hostid) + dplyr::filter(.data$machine_id == !!hostid) } - + dbfiles <- dplyr::collect(dbfiles) - + if (nrow(dbfiles) > 1 && !return.all) { PEcAn.logger::logger.warn("Multiple Valid Files found on host machine. Returning last updated record.") dbfiles <- dbfiles %>% - dplyr::filter(updated_at == max(updated_at)) + dplyr::filter(.data$updated_at == max(.data$updated_at)) } - + dbfiles } @@ -588,16 +641,16 @@ dbfile.check <- function(type, container.id, con, ##' \dontrun{ ##' dbfile.file('Input', 7, dbcon) ##' } -dbfile.file <- function(type, id, con, hostname=PEcAn.remote::fqdn()) { +dbfile.file <- function(type, id, con, hostname = PEcAn.remote::fqdn()) { hostname <- default_hostname(hostname) - + files <- dbfile.check(type = type, container.id = id, con = con, hostname = hostname) - + if (nrow(files) > 1) { PEcAn.logger::logger.warn("multiple files found for", id, "returned; using the first one found") - invisible(file.path(files[1, 'file_path'], files[1, 'file_name'])) + invisible(file.path(files[1, "file_path"], files[1, "file_name"])) } else if (nrow(files) == 1) { - invisible(file.path(files[1, 'file_path'], files[1, 'file_name'])) + invisible(file.path(files[1, "file_path"], files[1, "file_name"])) } else { PEcAn.logger::logger.warn("no files found for ", id, "in database") invisible(NA) @@ -612,15 +665,15 @@ dbfile.file <- function(type, id, con, hostname=PEcAn.remote::fqdn()) { ##' \dontrun{ ##' dbfile.id('Model', '/usr/local/bin/sipnet', dbcon) ##' } -dbfile.id <- function(type, file, con, hostname=PEcAn.remote::fqdn()) { +dbfile.id <- function(type, file, con, hostname = PEcAn.remote::fqdn()) { hostname <- default_hostname(hostname) - + # find appropriate host - hostid <- db.query(query = paste0("SELECT id FROM machines WHERE hostname='", hostname, "'"), con = con)[['id']] + hostid <- db.query(query = paste0("SELECT id FROM machines WHERE hostname='", hostname, "'"), con = con)[["id"]] if (is.null(hostid)) { invisible(NA) } - + # find file file_name <- basename(file) file_path <- dirname(file) @@ -631,15 +684,255 @@ dbfile.id <- function(type, file, con, hostname=PEcAn.remote::fqdn()) { "' AND file_name='", file_name, "' AND machine_id=", hostid ), - con = con) - + con = con + ) + if (nrow(ids) > 1) { PEcAn.logger::logger.warn("multiple ids found for", file, "returned; using the first one found") - invisible(ids[1, 'container_id']) + invisible(ids[1, "container_id"]) } else if (nrow(ids) == 1) { - invisible(ids[1, 'container_id']) + invisible(ids[1, "container_id"]) } else { PEcAn.logger::logger.warn("no id found for", file, "in database") invisible(NA) } -} \ No newline at end of file +} + + + +##' +##' This function will move dbfiles - clim or nc - from one location +##' to another on the same machine and update BETY +##' +##' @name dbfile.move +##' @title Move files to new location +##' @param old.dir directory with files to be moved +##' @param new.dir directory where files should be moved +##' @param file.type what type of files are being moved +##' @param siteid needed to register files that arent already in BETY +##' @param register if file isn't already in BETY, should it be registered? +##' @return print statement of how many files were moved, registered, or have symbolic links +##' @export +##' @author kzarada +##' @examples +##' \dontrun{ +##' dbfile.move( +##' old.dir = "/fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_site_0-676", +##' new.dir = '/projectnb/dietzelab/pecan.data/dbfiles/NOAA_GEFS_site_0-676' +##' file.type= clim, +##' siteid = 676, +##' register = TRUE +##' ) +##' } + + +dbfile.move <- function(old.dir, new.dir, file.type, siteid = NULL, register = FALSE) { + + + # create nulls for file movement and error info + error <- 0 + files.sym <- 0 + files.changed <- 0 + files.reg <- 0 + files.indb <- 0 + + # check for file type and update to make it *.file type + if (file.type != "clim" | file.type != "nc") { + PEcAn.logger::logger.error("File type not supported by move at this time. Currently only supports NC and CLIM files") + error <- 1 + } + file.pattern <- paste0("*.", file.type) + + + + # create new directory if it doesn't exist + if (!dir.exists(new.dir)) { + dir.create(new.dir) + } + + + # check to make sure both directories exist + if (!dir.exists(old.dir)) { + PEcAn.logger::logger.error("Old File directory does not exist. Please enter valid file path") + error <- 1 + } + + if (!dir.exists(new.dir)) { + PEcAn.logger::logger.error("New File directory does not exist. Please enter valid file path") + error <- 1 + } + + if (basename(new.dir) != basename(old.dir)) { + PEcAn.logger::logger.error("Basenames of files do not match") + } + + # list files in the old directory + old.files <- list.files(path = old.dir, pattern = file.pattern) + + # check to make sure there are files + if (length(old.files) == 0) { + PEcAn.logger::logger.warn("No files found") + error <- 1 + } + + # create full file path + full.old.file <- file.path(old.dir, old.files) + + + ### Get BETY information ### + bety <- dplyr::src_postgres( + dbname = "bety", + host = "psql-pecan.bu.edu", + user = "bety", + password = "bety" + ) + con <- bety$con + + # get matching dbfiles from BETY + dbfile.path <- dirname(full.old.file) + dbfiles <- dplyr::tbl(con, "dbfiles") %>% + dplyr::collect() %>% + dplyr::filter(.data$file_name %in% basename(full.old.file)) %>% + dplyr::filter(.data$file_path %in% dbfile.path) + + + # if there are matching db files + if (dim(dbfiles)[1] > 0) { + + # Check to make sure files line up + if (dim(dbfiles)[1] != length(full.old.file)) { + PEcAn.logger::logger.warn("Files to be moved don't match up with BETY files, only moving the files that match") + + # IF DB FILES AND FULL FILES DONT MATCH, remove those not in BETY - will take care of the rest below + index <- which(basename(full.old.file) %in% dbfiles$file_name) + index1 <- seq(1, length(full.old.file)) + check <- index1[-which(index1 %in% index)] + full.old.file <- full.old.file[-check] + + # record the number of files that are being moved + files.changed <- length(full.old.file) + } + + # Check to make sure the files line up + if (dim(dbfiles)[1] != length(full.old.file)) { + PEcAn.logger::logger.error("Files to be moved don't match up with BETY files, canceling move") + error <- 1 + } + + + # Make sure the files line up + dbfiles <- dbfiles[order(dbfiles$file_name), ] + full.old.file <- sort(full.old.file) + + # Record number of files moved and changed in BETY + files.indb <- dim(dbfiles)[1] + + # Move files and update BETY + if (error == 0) { + for (i in 1:length(full.old.file)) { + fs::file_move(full.old.file[i], new.dir) + db.query(paste0("UPDATE dbfiles SET file_path= '", new.dir, "' where id=", dbfiles$id[i]), con) + } # end i loop + } # end error if statement + } # end dbfile loop + + + # if there are files that are in the folder but not in BETY, we can either register them or not + if (dim(dbfiles)[1] == 0 | files.changed > 0) { + + # Recheck what files are in the directory since others may have been moved above + old.files <- list.files(path = old.dir, pattern = file.pattern) + + # Recreate full file path + full.old.file <- file.path(old.dir, old.files) + + + # Error check again to make sure there aren't any matching dbfiles + dbfile.path <- dirname(full.old.file) + dbfiles <- dplyr::tbl(con, "dbfiles") %>% + dplyr::collect() %>% + dplyr::filter(.data$file_name %in% basename(full.old.file)) %>% + dplyr::filter(.data$file_path %in% dbfile.path) + + if (dim(dbfiles)[1] > 0) { + PEcAn.logger::logger.error("There are still dbfiles matching these files! Canceling link or registration") + error <- 1 + } + + + if (error == 0 & register == TRUE) { + + # Record how many files are being registered to BETY + files.reg <- length(full.old.file) + + for (i in 1:length(full.old.file)) { + file_path <- dirname(full.old.file[i]) + file_name <- basename(full.old.file[i]) + + if (file.type == "nc") { + mimetype <- "application/x-netcdf" + formatname <- "CF Meteorology application" + } + else if (file.type == "clim") { + mimetype <- "text/csv" + formatname <- "Sipnet.climna" + } + else { + PEcAn.logger::logger.error("File Type is currently not supported") + } + + + dbfile.input.insert( + in.path = file_path, + in.prefix = file_name, + siteid = siteid, + startdate = NULL, + enddate = NULL, + mimetype = mimetype, + formatname = formatname, + parentid = NA, + con = con, + hostname = PEcAn.remote::fqdn(), + allow.conflicting.dates = FALSE, + ens = FALSE + ) + } # end i loop + } # end error loop + } # end register == TRUE + + if (error == 0 & register == FALSE) { + # Create file path for symbolic link + full.new.file <- file.path(new.dir, old.files) + + # Record number of files that will have a symbolic link made + files.sym <- length(full.new.file) + + # Line up files + full.new.file <- sort(full.new.file) + full.old.file <- sort(full.old.file) + + # Check to make sure the files are the same length + if (length(full.new.file) != length(full.old.file)) { + PEcAn.logger::logger.error("Files to be moved don't match up with BETY. Canceling Move") + error <- 1 + } + + # Move file and create symbolic link if there are no errors + + if (error == 0) { + for (i in 1:length(full.old.file)) { + fs::file_move(full.old.file[i], new.dir) + R.utils::createLink(link = full.old.file[i], target = full.new.file[i]) + } # end i loop + } # end error loop + } # end Register == FALSE + + + if (error > 0) { + PEcAn.logger::logger.error("There was an error, files were not moved or linked") + } + + if (error == 0) { + PEcAn.logger::logger.info(paste0(files.changed + files.indb, " files were moved and updated on BETY, ", files.sym, " were moved and had a symbolic link created, and ", files.reg, " files were moved and then registered in BETY")) + } +} # end dbfile.move() diff --git a/base/db/R/derive.trait.R b/base/db/R/derive.trait.R new file mode 100644 index 00000000000..7abc5b9cc64 --- /dev/null +++ b/base/db/R/derive.trait.R @@ -0,0 +1,46 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##--------------------------------------------------------------------------------------------------# +##' +##' Performs an arithmetic function, FUN, over a series of traits and returns +##' the result as a derived trait. +##' Traits must be specified as either lists or single row data frames, +##' and must be either single data points or normally distributed. +##' In the event one or more input traits are normally distributed, +##' the resulting distribution is approximated by numerical simulation. +##' The output trait is effectively a copy of the first input trait with +##' modified mean, stat, and n. +##' +##' @name derive.trait +##' @title Performs an arithmetic function, FUN, over a series of traits and returns the result as a derived trait. +##' @param FUN arithmetic function +##' @param ... traits that will be supplied to FUN as input +##' @param input list of trait inputs. See examples +##' @param var.name name to use in output +##' @param sample.size number of random samples generated by rnorm for normally distributed trait input +##' @return a copy of the first input trait with mean, stat, and n reflecting the derived trait +##' @export +##' @examples +##' input <- list(x = data.frame(mean = 1, stat = 1, n = 1)) +##' derive.trait(FUN = identity, input = input, var.name = 'x') +derive.trait <- function(FUN, ..., input = list(...), var.name = NA, sample.size = 10^6){ + if(any(lapply(input, nrow) > 1)){ + return(NULL) + } + input.samples <- lapply(input, take.samples, sample.size=sample.size) + output.samples <- do.call(FUN, input.samples) + output <- input[[1]] + output$mean <- mean(output.samples) + output$stat <- ifelse(length(output.samples) > 1, stats::sd(output.samples), NA) + output$n <- min(sapply(input, function(trait){trait$n})) + output$vname <- ifelse(is.na(var.name), output$vname, var.name) + return(output) +} +##==================================================================================================# \ No newline at end of file diff --git a/base/db/R/derive.traits.R b/base/db/R/derive.traits.R new file mode 100644 index 00000000000..c5b8be9e7ec --- /dev/null +++ b/base/db/R/derive.traits.R @@ -0,0 +1,59 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##--------------------------------------------------------------------------------------------------# +##' Equivalent to derive.trait(), but operates over a series of trait datasets, +##' as opposed to individual trait rows. See \code{\link{derive.trait}}; for more information. +##' +##' @name derive.traits +##' @title Performs an arithmetic function, FUN, over a series of traits and returns the result as a derived trait. +##' @export +##' @param FUN arithmetic function +##' @param ... trait datasets that will be supplied to FUN as input +##' @param input list of trait inputs. See examples in \code{\link{derive.trait}} +##' @param var.name name to use in output +##' @param sample.size where traits are normally distributed with a given +##' @param match.columns in the event more than one trait dataset is supplied, +##' this specifies the columns that identify a unique data point +##' @return a copy of the first input trait with modified mean, stat, and n +derive.traits <- function(FUN, ..., input = list(...), + match.columns = c('citation_id', 'site_id', 'specie_id'), + var.name = NA, sample.size = 10^6){ + if(length(input) == 1){ + input <- input[[1]] + #KLUDGE: modified to handle empty datasets + for(i in (0:nrow(input))[-1]){ + input[i,] <- derive.trait(FUN, input[i,], sample.size=sample.size) + } + return(input) + } + else if(length(match.columns) > 0){ + #function works recursively to reduce the number of match columns + match.column <- match.columns[[1]] + #find unique values within the column that intersect among all input datasets + columns <- lapply(input, function(data){data[[match.column]]}) + intersection <- Reduce(intersect, columns) + + #run derive.traits() on subsets of input that contain those unique values + derived.traits<-lapply(intersection, + function(id){ + filtered.input <- lapply(input, + function(data){data[data[[match.column]] == id,]}) + derive.traits(FUN, input=filtered.input, + match.columns=match.columns[-1], + var.name=var.name, + sample.size=sample.size) + }) + derived.traits <- derived.traits[!is.null(derived.traits)] + derived.traits <- do.call(rbind, derived.traits) + return(derived.traits) + } else { + return(derive.trait(FUN, input = input, var.name = var.name, sample.size = sample.size)) + } +} diff --git a/base/db/R/fetch.stats2se.R b/base/db/R/fetch.stats2se.R new file mode 100644 index 00000000000..7425399f3c3 --- /dev/null +++ b/base/db/R/fetch.stats2se.R @@ -0,0 +1,25 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##--------------------------------------------------------------------------------------------------# +##' Queries data from the trait database and transforms statistics to SE +##' +##' Performs query and then uses \code{transformstats} to convert miscellaneous statistical summaries +##' to SE +##' @name fetch.stats2se +##' @title Fetch data and transform stats to SE +##' @param connection connection to trait database +##' @param query to send to databse +##' @return dataframe with trait data +##' @seealso used in \code{\link{query.trait.data}}; \code{\link{transformstats}} performs transformation calculations +##' @author +fetch.stats2se <- function(connection, query){ + transformed <- PEcAn.utils::transformstats(db.query(query = query, con = connection)) + return(transformed) +} \ No newline at end of file diff --git a/base/db/R/get.trait.data.R b/base/db/R/get.trait.data.R index cea64e49792..28213453f7f 100644 --- a/base/db/R/get.trait.data.R +++ b/base/db/R/get.trait.data.R @@ -7,368 +7,6 @@ # http://opensource.ncsa.illinois.edu/license.html #------------------------------------------------------------------------------- -##--------------------------------------------------------------------------------------------------# -##' Check two lists. Identical does not work since one can be loaded -##' from the database and the other from a CSV file. -##' -##' @name check.lists -##' @title Compares two lists -##' @param x first list -##' @param y second list -##' @param filename one of "species.csv" or "cultivars.csv" -##' @return true if two list are the same -##' @author Rob Kooper -##' -check.lists <- function(x, y, filename = "species.csv") { - if (nrow(x) != nrow(y)) { - return(FALSE) - } - if(filename == "species.csv"){ - cols <- c('id', 'genus', 'species', 'scientificname') - } else if (filename == "cultivars.csv") { - cols <- c('id', 'specie_id', 'species_name', 'cultivar_name') - } else { - return(FALSE) - } - xy_match <- vapply(cols, function(i) identical(as.character(x[[i]]), as.character(y[[i]])), logical(1)) - return(all(unlist(xy_match))) -} - -##--------------------------------------------------------------------------------------------------# -##' Get trait data from the database for a single PFT -##' -##' @details `pft` should be a list containing at least `name` and `outdir`, and optionally `posteriorid` and `constants`. BEWARE: All existing files in `outir` will be deleted! -##' @param pft list of settings for the pft whose traits to retrieve. See details -##' @param modeltype type of model that is used, this is used to distinguish between different pfts with the same name. -##' @param dbfiles location where previous results are found -##' @param dbcon database connection -##' @param forceupdate set this to true to force an update, auto will check to see if an update is needed. -##' @param trait.names list of trait names to retrieve -##' @return updated pft with posteriorid -##' @author David LeBauer, Shawn Serbin, Rob Kooper -##' @export -get.trait.data.pft <- function(pft, modeltype, dbfiles, dbcon, trait.names, - forceupdate = FALSE) { - - # Create directory if necessary - if (!file.exists(pft$outdir) && !dir.create(pft$outdir, recursive = TRUE)) { - PEcAn.logger::logger.error(paste0("Couldn't create PFT output directory: ", pft$outdir)) - } - - ## Remove old files. Clean up. - old.files <- list.files(path = pft$outdir, full.names = TRUE, include.dirs = FALSE) - file.remove(old.files) - - # find appropriate pft - pftres <- query_pfts(dbcon, pft[["name"]], modeltype) - pfttype <- pftres[["pft_type"]] - pftid <- pftres[["id"]] - - if (nrow(pftres) > 1) { - PEcAn.logger::logger.severe( - "Multiple PFTs named", pft[["name"]], "found,", - "with ids", PEcAn.utils::vecpaste(pftres[["id"]]), ".", - "Specify modeltype to fix this.") - } - - if (nrow(pftres) == 0) { - PEcAn.logger::logger.severe("Could not find pft", pft[["name"]]) - return(NA) - } - - # get the member species/cultivars, we need to check if anything changed - if (pfttype == "plant") { - pft_member_filename = "species.csv" - pft_members <- PEcAn.DB::query.pft_species(pft$name, modeltype, dbcon) - } else if (pfttype == "cultivar") { - pft_member_filename = "cultivars.csv" - pft_members <- PEcAn.DB::query.pft_cultivars(pft$name, modeltype, dbcon) - } else { - PEcAn.logger::logger.severe("Unknown pft type! Expected 'plant' or 'cultivar', got", pfttype) - } - - # ANS: Need to do this conversion for the check against existing - # membership later on. Otherwise, `NA` from the CSV is interpreted - # as different from `""` returned here, even though they are really - # the same thing. - pft_members <- pft_members %>% - dplyr::mutate_if(is.character, ~dplyr::na_if(., "")) - - # get the priors - prior.distns <- PEcAn.DB::query.priors(pft = pftid, trstr = PEcAn.utils::vecpaste(trait.names), con = dbcon) - prior.distns <- prior.distns[which(!rownames(prior.distns) %in% names(pft$constants)),] - traits <- rownames(prior.distns) - - # get the trait data (don't bother sampling derived traits until after update check) - trait.data.check <- PEcAn.DB::query.traits(ids = pft_members$id, priors = traits, con = dbcon, update.check.only = TRUE, ids_are_cultivars = (pfttype=="cultivar")) - traits <- names(trait.data.check) - - # Set forceupdate FALSE if it's a string (backwards compatible with 'AUTO' flag used in the past) - if (!is.logical(forceupdate)) { - forceupdate <- FALSE - } - - # check to see if we need to update - if (!forceupdate) { - if (is.null(pft$posteriorid)) { - pft$posteriorid <- dplyr::tbl(dbcon, "posteriors") %>% - dplyr::filter(pft_id == !!pftid) %>% - dplyr::arrange(dplyr::desc(created_at)) %>% - head(1) %>% - dplyr::pull(id) - } - if (!is.null(pft$posteriorid)) { - files <- dbfile.check(type = "Posterior", container.id = pft$posteriorid, con = dbcon, - return.all = TRUE) - need_files <- c( - trait_data = "trait.data.Rdata", - priors = "prior.distns.Rdata", - pft_membership = pft_member_filename - ) - ids <- match(need_files, files$file_name) - names(ids) <- names(need_files) - if (any(is.na(ids))) { - missing_files <- need_files[is.na(ids)] - PEcAn.logger::logger.info(paste0( - "Forcing meta-analysis update because ", - "the following files are missing from the posterior: ", - paste0(shQuote(missing_files), collapse = ", ") - )) - PEcAn.logger::logger.debug( - "\n `dbfile.check` returned the following output:\n", - PEcAn.logger::print2string(files), - wrap = FALSE - ) - } else { - PEcAn.logger::logger.debug( - "All posterior files are present. Performing additional checks ", - "to determine if meta-analysis needs to be updated." - ) - # check if all files exist - need_paths <- file.path(files$file_path[ids], need_files) - names(need_paths) <- names(need_files) - files_exist <- file.exists(need_paths) - foundallfiles <- all(files_exist) - if (!foundallfiles) { - PEcAn.logger::logger.warn( - "The following files are in database but not found on disk: ", - paste(shQuote(need_files[!files_exist]), collapse = ", "), ". ", - "Re-running meta-analysis." - ) - } else { - # Check if PFT membership has changed - PEcAn.logger::logger.debug("Checking if PFT membership has changed.") - existing_membership <- utils::read.csv( - need_paths[["pft_membership"]], - # Columns are: id, genus, species, scientificname - # Need this so NA values are - colClasses = c("double", "character", "character", "character"), - stringsAsFactors = FALSE, - na.strings = "" - ) - diff_membership <- symmetric_setdiff( - existing_membership, - pft_members, - xname = "existing", - yname = "current" - ) - if (nrow(diff_membership) > 0) { - PEcAn.logger::logger.error( - "\n PFT membership has changed. \n", - "Difference is:\n", - PEcAn.logger::print2string(diff_membership), - wrap = FALSE - ) - foundallfiles <- FALSE - } - - # Check if priors have changed - PEcAn.logger::logger.debug("Checking if priors have changed") - existing_prior <- PEcAn.utils::load_local(need_paths[["priors"]])[["prior.distns"]] - diff_prior <- symmetric_setdiff( - dplyr::as_tibble(prior.distns, rownames = "trait"), - dplyr::as_tibble(existing_prior, rownames = "trait") - ) - if (nrow(diff_prior) > 0) { - PEcAn.logger::logger.error( - "\n Prior has changed. \n", - "Difference is:\n", - PEcAn.logger::print2string(diff_prior), - wrap = FALSE - ) - foundallfiles <- FALSE - } - - # Check if trait data have changed - PEcAn.logger::logger.debug("Checking if trait data have changed") - existing_trait_data <- PEcAn.utils::load_local( - need_paths[["trait_data"]] - )[["trait.data"]] - if (length(trait.data.check) != length(existing_trait_data)) { - PEcAn.logger::logger.warn( - "Lengths of new and existing `trait.data` differ. ", - "Re-running meta-analysis." - ) - foundallfiles <- FALSE - } else if (length(trait.data.check) == 0) { - PEcAn.logger::logger.warn("New and existing trait data are both empty. Skipping this check.") - } else { - current_traits <- dplyr::bind_rows(trait.data.check, .id = "trait") %>% - dplyr::select(-mean, -stat) - existing_traits <- dplyr::bind_rows(existing_trait_data, .id = "trait") %>% - dplyr::select(-mean, -stat) - diff_traits <- symmetric_setdiff(current_traits, existing_traits) - if (nrow(diff_traits) > 0) { - diff_summary <- diff_traits %>% - dplyr::count(source, trait) - PEcAn.logger::logger.error( - "\n Prior has changed. \n", - "Here are the number of differing trait records by trait:\n", - PEcAn.logger::print2string(diff_summary), - wrap = FALSE - ) - foundallfiles <- FALSE - } - } - } - - - if (foundallfiles) { - PEcAn.logger::logger.info( - "Reusing existing files from posterior", pft$posteriorid, - "for PFT", shQuote(pft$name) - ) - for (id in seq_len(nrow(files))) { - file.copy(from = file.path(files[[id, "file_path"]], files[[id, "file_name"]]), - to = file.path(pft$outdir, files[[id, "file_name"]])) - } - - done <- TRUE - - # May need to symlink the generic post.distns.Rdata to a specific post.distns.*.Rdata file. - if (length(list.files(pft$outdir, "post.distns.Rdata")) == 0) { - all.files <- list.files(pft$outdir) - post.distn.file <- all.files[grep("post\\.distns\\..*\\.Rdata", all.files)] - if (length(post.distn.file) > 1) - PEcAn.logger::logger.severe( - "get.trait.data.pft() doesn't know how to ", - "handle multiple `post.distns.*.Rdata` files.", - "Found the following files: ", - paste(shQuote(post.distn.file), collapse = ", ") - ) - else if (length(post.distn.file) == 1) { - # Found exactly one post.distns.*.Rdata file. Use it. - link_input <- file.path(pft[["outdir"]], post.distn.file) - link_target <- file.path(pft[["outdir"]], "post.distns.Rdata") - PEcAn.logger::logger.debug( - "Found exactly one posterior distribution file: ", - shQuote(link_input), - ". Symlinking it to PFT output directory: ", - shQuote(link_target) - ) - file.symlink(from = link_input, to = link_target) - } else { - PEcAn.logger::logger.error( - "No previous posterior distribution file found. ", - "Most likely, trait data were retrieved, but meta-analysis ", - "was not run. Meta-analysis will be run." - ) - done <- FALSE - } - } - if (done) return(pft) - } - } - } - } - - # get the trait data (including sampling of derived traits, if any) - trait.data <- query.traits(pft_members$id, traits, con = dbcon, - update.check.only = FALSE, - ids_are_cultivars = (pfttype == "cultivar")) - traits <- names(trait.data) - - if (length(trait.data) > 0) { - trait_counts <- trait.data %>% - dplyr::bind_rows(.id = "trait") %>% - dplyr::count(trait) - - PEcAn.logger::logger.info( - "\n Number of observations per trait for PFT ", shQuote(pft[["name"]]), ":\n", - PEcAn.logger::print2string(trait_counts, n = Inf), - wrap = FALSE - ) - } else { - PEcAn.logger::logger.warn( - "None of the requested traits were found for PFT ", - format(pft_members[["id"]], scientific = FALSE) - ) - } - - # get list of existing files so they get ignored saving - old.files <- list.files(path = pft$outdir) - - # create a new posterior - now <- format(x = Sys.time(), format = "%Y-%m-%d %H:%M:%S") - db.query(paste0("INSERT INTO posteriors (pft_id, created_at, updated_at) ", - "VALUES (", pftid, ", '", now, "', '", now, "')"), - con = dbcon) - pft$posteriorid <- dplyr::tbl(dbcon, "posteriors") %>% - dplyr::filter(pft_id == !!pftid, created_at == !!now) %>% - dplyr::pull(id) - - # create path where to store files - pathname <- file.path(dbfiles, "posterior", pft$posteriorid) - dir.create(pathname, showWarnings = FALSE, recursive = TRUE) - - ## 1. get species/cultivar list based on pft - utils::write.csv(pft_members, file.path(pft$outdir, pft_member_filename), - row.names = FALSE) - - ## save priors - save(prior.distns, file = file.path(pft$outdir, "prior.distns.Rdata")) - utils::write.csv(prior.distns, file.path(pft$outdir, "prior.distns.csv"), - row.names = TRUE) - - ## 3. display info to the console - PEcAn.logger::logger.info( - "\n Summary of prior distributions for PFT ", shQuote(pft$name), ":\n", - PEcAn.logger::print2string(prior.distns), - wrap = FALSE - ) - - ## traits = variables with prior distributions for this pft - trait.data.file <- file.path(pft$outdir, "trait.data.Rdata") - save(trait.data, file = trait.data.file) - utils::write.csv( - dplyr::bind_rows(trait.data), - file.path(pft$outdir, "trait.data.csv"), - row.names = FALSE - ) - - ### save and store in database all results except those that were there already - store_files_all <- list.files(path = pft[["outdir"]]) - store_files <- setdiff(store_files_all, old.files) - PEcAn.logger::logger.debug( - "The following posterior files found in PFT outdir ", - "(", shQuote(pft[["outdir"]]), ") will be registered in BETY ", - "under posterior ID ", format(pft[["posteriorid"]], scientific = FALSE), ": ", - paste(shQuote(store_files), collapse = ", "), ". ", - "The following files (if any) will not be registered because they already existed: ", - paste(shQuote(intersect(store_files, old.files)), collapse = ", "), - wrap = FALSE - ) - for (file in store_files) { - filename <- file.path(pathname, file) - file.copy(file.path(pft$outdir, file), filename) - dbfile.insert(in.path = pathname, in.prefix = file, - type = "Posterior", id = pft[["posteriorid"]], - con = dbcon) - } - - return(pft) -} - ##--------------------------------------------------------------------------------------------------# ##' Get trait data from the database. ##' @@ -402,10 +40,10 @@ get.trait.data <- function(pfts, modeltype, dbfiles, database, forceupdate, if (any(sapply(pft_outdirs, is.null))) { PEcAn.logger::logger.severe('At least one pft in settings is missing its "outdir"') } - + dbcon <- db.open(database) - on.exit(db.close(dbcon)) - + on.exit(db.close(dbcon), add = TRUE) + if (is.null(trait.names)) { PEcAn.logger::logger.debug(paste0( "`trait.names` is NULL, so retrieving all traits ", @@ -424,7 +62,7 @@ get.trait.data <- function(pfts, modeltype, dbfiles, database, forceupdate, # all_priors <- query_priors(pfts, params = database) # trait.names <- unique(all_priors[["name"]]) } - + # process all pfts result <- lapply(pfts, get.trait.data.pft, modeltype = modeltype, @@ -432,67 +70,6 @@ get.trait.data <- function(pfts, modeltype, dbfiles, database, forceupdate, dbcon = dbcon, forceupdate = forceupdate, trait.names = trait.names) - + invisible(result) -} - -#' Symmetric set difference of two data frames -#' -#' @param x,y `data.frame`s to compare -#' @param xname Label for data in x but not y. Default = "x" -#' @param yname Label for data in y but not x. Default = "y" -#' @param namecol Name of label column. Default = "source". -#' @param simplify_types (Logical) If `TRUE`, coerce anything that -#' isn't numeric to character, to facilitate comparison. -#' @return `data.frame` of data not common to x and y, with additional -#' column (`namecol`) indicating whether data are only in x -#' (`xname`) or y (`yname`) -#' @export -#' @examples -#' xdf <- data.frame(a = c("a", "b", "c"), -#' b = c(1, 2, 3), -#' stringsAsFactors = FALSE) -#' ydf <- data.frame(a = c("a", "b", "d"), -#' b = c(1, 2.5, 3), -#' stringsAsFactors = FALSE) -#' symmetric_setdiff(xdf, ydf) -symmetric_setdiff <- function(x, y, xname = "x", yname = "y", - namecol = "source", simplify_types = TRUE) { - stopifnot(is.data.frame(x), is.data.frame(y), - is.character(xname), is.character(yname), - length(xname) == 1, length(yname) == 1) - is_i64 <- c( - vapply(x, inherits, logical(1), what = "integer64"), - vapply(y, inherits, logical(1), what = "integer64") - ) - if (any(is_i64)) { - PEcAn.logger::logger.debug( - "Detected at least one `integer64` column. ", - "Converting to `numeric` for comparison." - ) - if (requireNamespace("bit64", quietly = TRUE)) { - x <- dplyr::mutate_if(x, bit64::is.integer64, as.numeric) - y <- dplyr::mutate_if(y, bit64::is.integer64, as.numeric) - } else { - PEcAn.logger::logger.warn( - '"bit64" package required for `integer64` conversion, but not installed. ', - "Skipping conversion, which may produce weird results!" - ) - } - } - if (simplify_types) { - x <- dplyr::mutate_if(x, ~!is.numeric(.), as.character) - y <- dplyr::mutate_if(x, ~!is.numeric(.), as.character) - } - namecol <- dplyr::sym(namecol) - xy <- dplyr::setdiff(x, y) %>% - dplyr::mutate(!!namecol := xname) - yx <- dplyr::setdiff(y, x) %>% - dplyr::mutate(!!namecol := yname) - dplyr::bind_rows(xy, yx) %>% - dplyr::select(!!namecol, dplyr::everything()) -} - -#################################################################################################### -### EOF. End of R script file. -#################################################################################################### +} \ No newline at end of file diff --git a/base/db/R/get.trait.data.pft.R b/base/db/R/get.trait.data.pft.R new file mode 100644 index 00000000000..3f48fe64416 --- /dev/null +++ b/base/db/R/get.trait.data.pft.R @@ -0,0 +1,351 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##--------------------------------------------------------------------------------------------------# +##' Get trait data from the database for a single PFT +##' +##' @details `pft` should be a list containing at least `name` and `outdir`, and optionally `posteriorid` and `constants`. BEWARE: All existing files in `outir` will be deleted! +##' @param pft list of settings for the pft whose traits to retrieve. See details +##' @param modeltype type of model that is used, this is used to distinguish between different pfts with the same name. +##' @param dbfiles location where previous results are found +##' @param dbcon database connection +##' @param forceupdate set this to true to force an update, auto will check to see if an update is needed. +##' @param trait.names list of trait names to retrieve +##' @return updated pft with posteriorid +##' @author David LeBauer, Shawn Serbin, Rob Kooper +##' @export +get.trait.data.pft <- function(pft, modeltype, dbfiles, dbcon, trait.names, + forceupdate = FALSE) { + + # Create directory if necessary + if (!file.exists(pft$outdir) && !dir.create(pft$outdir, recursive = TRUE)) { + PEcAn.logger::logger.error(paste0("Couldn't create PFT output directory: ", pft$outdir)) + } + + ## Remove old files. Clean up. + old.files <- list.files(path = pft$outdir, full.names = TRUE, include.dirs = FALSE) + file.remove(old.files) + + # find appropriate pft + pftres <- query_pfts(dbcon, pft[["name"]], modeltype) + pfttype <- pftres[["pft_type"]] + pftid <- pftres[["id"]] + + if (nrow(pftres) > 1) { + PEcAn.logger::logger.severe( + "Multiple PFTs named", pft[["name"]], "found,", + "with ids", PEcAn.utils::vecpaste(pftres[["id"]]), ".", + "Specify modeltype to fix this.") + } + + if (nrow(pftres) == 0) { + PEcAn.logger::logger.severe("Could not find pft", pft[["name"]]) + return(NA) + } + + # get the member species/cultivars, we need to check if anything changed + if (pfttype == "plant") { + pft_member_filename = "species.csv" + pft_members <- PEcAn.DB::query.pft_species(pft$name, modeltype, dbcon) + } else if (pfttype == "cultivar") { + pft_member_filename = "cultivars.csv" + pft_members <- PEcAn.DB::query.pft_cultivars(pft$name, modeltype, dbcon) + } else { + PEcAn.logger::logger.severe("Unknown pft type! Expected 'plant' or 'cultivar', got", pfttype) + } + + # ANS: Need to do this conversion for the check against existing + # membership later on. Otherwise, `NA` from the CSV is interpreted + # as different from `""` returned here, even though they are really + # the same thing. + pft_members <- pft_members %>% + dplyr::mutate_if(is.character, ~dplyr::na_if(., "")) + + # get the priors + prior.distns <- PEcAn.DB::query.priors(pft = pftid, trstr = PEcAn.utils::vecpaste(trait.names), con = dbcon) + prior.distns <- prior.distns[which(!rownames(prior.distns) %in% names(pft$constants)),] + traits <- rownames(prior.distns) + + # get the trait data (don't bother sampling derived traits until after update check) + trait.data.check <- PEcAn.DB::query.traits(ids = pft_members$id, priors = traits, con = dbcon, update.check.only = TRUE, ids_are_cultivars = (pfttype=="cultivar")) + traits <- names(trait.data.check) + + # Set forceupdate FALSE if it's a string (backwards compatible with 'AUTO' flag used in the past) + forceupdate <- isTRUE(as.logical(forceupdate)) + + # check to see if we need to update + if (!forceupdate) { + if (is.null(pft$posteriorid)) { + recent_posterior <- dplyr::tbl(dbcon, "posteriors") %>% + dplyr::filter(.data$pft_id == !!pftid) %>% + dplyr::collect() + if (length(recent_posterior) > 0) { + pft$posteriorid <- dplyr::tbl(dbcon, "posteriors") %>% + dplyr::filter(.data$pft_id == !!pftid) %>% + dplyr::arrange(dplyr::desc(.data$created_at)) %>% + utils::head(1) %>% + dplyr::pull(id) + } else { + PEcAn.logger::logger.info("No previous posterior found. Forcing update") + } + } + if (!is.null(pft$posteriorid)) { + files <- dbfile.check(type = "Posterior", container.id = pft$posteriorid, con = dbcon, + return.all = TRUE) + need_files <- c( + trait_data = "trait.data.Rdata", + priors = "prior.distns.Rdata", + pft_membership = pft_member_filename + ) + ids <- match(need_files, files$file_name) + names(ids) <- names(need_files) + if (any(is.na(ids))) { + missing_files <- need_files[is.na(ids)] + PEcAn.logger::logger.info(paste0( + "Forcing meta-analysis update because ", + "the following files are missing from the posterior: ", + paste0(shQuote(missing_files), collapse = ", ") + )) + PEcAn.logger::logger.debug( + "\n `dbfile.check` returned the following output:\n", + PEcAn.logger::print2string(files), + wrap = FALSE + ) + } else { + PEcAn.logger::logger.debug( + "All posterior files are present. Performing additional checks ", + "to determine if meta-analysis needs to be updated." + ) + # check if all files exist + need_paths <- file.path(files$file_path[ids], need_files) + names(need_paths) <- names(need_files) + files_exist <- file.exists(need_paths) + foundallfiles <- all(files_exist) + if (!foundallfiles) { + PEcAn.logger::logger.warn( + "The following files are in database but not found on disk: ", + paste(shQuote(need_files[!files_exist]), collapse = ", "), ". ", + "Re-running meta-analysis." + ) + } else { + # Check if PFT membership has changed + PEcAn.logger::logger.debug("Checking if PFT membership has changed.") + if (pfttype == "plant") { + # Columns are: id, genus, species, scientificname + colClass = c("double", "character", "character", "character") + } else if (pfttype == "cultivar") { + # Columns are: id, specie_id, genus, species, scientificname, cultivar + colClass = c("double", "double", "character", "character", "character", "character") + } + existing_membership <- utils::read.csv( + need_paths[["pft_membership"]], + # Need this so NA values are formatted consistently + colClasses = colClass, + stringsAsFactors = FALSE, + na.strings = c("", "NA") + ) + diff_membership <- symmetric_setdiff( + existing_membership, + pft_members, + xname = "existing", + yname = "current" + ) + if (nrow(diff_membership) > 0) { + PEcAn.logger::logger.error( + "\n PFT membership has changed. \n", + "Difference is:\n", + PEcAn.logger::print2string(diff_membership), + wrap = FALSE + ) + foundallfiles <- FALSE + } + + # Check if priors have changed + PEcAn.logger::logger.debug("Checking if priors have changed") + existing_prior <- PEcAn.utils::load_local(need_paths[["priors"]])[["prior.distns"]] + diff_prior <- symmetric_setdiff( + dplyr::as_tibble(prior.distns, rownames = "trait"), + dplyr::as_tibble(existing_prior, rownames = "trait") + ) + if (nrow(diff_prior) > 0) { + PEcAn.logger::logger.error( + "\n Prior has changed. \n", + "Difference is:\n", + PEcAn.logger::print2string(diff_prior), + wrap = FALSE + ) + foundallfiles <- FALSE + } + + # Check if trait data have changed + PEcAn.logger::logger.debug("Checking if trait data have changed") + existing_trait_data <- PEcAn.utils::load_local( + need_paths[["trait_data"]] + )[["trait.data"]] + if (length(trait.data.check) != length(existing_trait_data)) { + PEcAn.logger::logger.warn( + "Lengths of new and existing `trait.data` differ. ", + "Re-running meta-analysis." + ) + foundallfiles <- FALSE + } else if (length(trait.data.check) == 0) { + PEcAn.logger::logger.warn("New and existing trait data are both empty. Skipping this check.") + } else { + current_traits <- dplyr::bind_rows(trait.data.check, .id = "trait") %>% + dplyr::select(-mean, -.data$stat) + existing_traits <- dplyr::bind_rows(existing_trait_data, .id = "trait") %>% + dplyr::select(-mean, -.data$stat) + diff_traits <- symmetric_setdiff(current_traits, existing_traits) + if (nrow(diff_traits) > 0) { + diff_summary <- diff_traits %>% + dplyr::count(source, .data$trait) + PEcAn.logger::logger.error( + "\n Prior has changed. \n", + "Here are the number of differing trait records by trait:\n", + PEcAn.logger::print2string(diff_summary), + wrap = FALSE + ) + foundallfiles <- FALSE + } + } + } + + + if (foundallfiles) { + PEcAn.logger::logger.info( + "Reusing existing files from posterior", pft$posteriorid, + "for PFT", shQuote(pft$name) + ) + for (id in seq_len(nrow(files))) { + file.copy(from = file.path(files[[id, "file_path"]], files[[id, "file_name"]]), + to = file.path(pft$outdir, files[[id, "file_name"]])) + } + + done <- TRUE + + # May need to symlink the generic post.distns.Rdata to a specific post.distns.*.Rdata file. + if (length(list.files(pft$outdir, "post.distns.Rdata")) == 0) { + all.files <- list.files(pft$outdir) + post.distn.file <- all.files[grep("post\\.distns\\..*\\.Rdata", all.files)] + if (length(post.distn.file) > 1) + PEcAn.logger::logger.severe( + "get.trait.data.pft() doesn't know how to ", + "handle multiple `post.distns.*.Rdata` files.", + "Found the following files: ", + paste(shQuote(post.distn.file), collapse = ", ") + ) + else if (length(post.distn.file) == 1) { + # Found exactly one post.distns.*.Rdata file. Use it. + link_input <- file.path(pft[["outdir"]], post.distn.file) + link_target <- file.path(pft[["outdir"]], "post.distns.Rdata") + PEcAn.logger::logger.debug( + "Found exactly one posterior distribution file: ", + shQuote(link_input), + ". Symlinking it to PFT output directory: ", + shQuote(link_target) + ) + file.symlink(from = link_input, to = link_target) + } else { + PEcAn.logger::logger.error( + "No previous posterior distribution file found. ", + "Most likely, trait data were retrieved, but meta-analysis ", + "was not run. Meta-analysis will be run." + ) + done <- FALSE + } + } + if (done) return(pft) + } + } + } + } + + # get the trait data (including sampling of derived traits, if any) + trait.data <- query.traits(pft_members$id, traits, con = dbcon, + update.check.only = FALSE, + ids_are_cultivars = (pfttype == "cultivar")) + traits <- names(trait.data) + + if (length(trait.data) > 0) { + trait_counts <- trait.data %>% + dplyr::bind_rows(.id = "trait") %>% + dplyr::count(.data$trait) + + PEcAn.logger::logger.info( + "\n Number of observations per trait for PFT ", shQuote(pft[["name"]]), ":\n", + PEcAn.logger::print2string(trait_counts, n = Inf, na.print = ""), + wrap = FALSE + ) + } else { + PEcAn.logger::logger.warn( + "None of the requested traits were found for PFT ", + format(pft_members[["id"]], scientific = FALSE) + ) + } + + # get list of existing files so they get ignored saving + old.files <- list.files(path = pft$outdir) + + # create a new posterior + insert_result <- db.query( + paste0("INSERT INTO posteriors (pft_id) VALUES (", pftid, ") RETURNING id"), + con = dbcon) + pft$posteriorid <- insert_result[["id"]] + + # create path where to store files + pathname <- file.path(dbfiles, "posterior", pft$posteriorid) + dir.create(pathname, showWarnings = FALSE, recursive = TRUE) + + ## 1. get species/cultivar list based on pft + utils::write.csv(pft_members, file.path(pft$outdir, pft_member_filename), + row.names = FALSE) + + ## save priors + save(prior.distns, file = file.path(pft$outdir, "prior.distns.Rdata")) + utils::write.csv(prior.distns, file.path(pft$outdir, "prior.distns.csv"), + row.names = TRUE) + + ## 3. display info to the console + PEcAn.logger::logger.info( + "\n Summary of prior distributions for PFT ", shQuote(pft$name), ":\n", + PEcAn.logger::print2string(prior.distns), + wrap = FALSE + ) + + ## traits = variables with prior distributions for this pft + trait.data.file <- file.path(pft$outdir, "trait.data.Rdata") + save(trait.data, file = trait.data.file) + utils::write.csv( + dplyr::bind_rows(trait.data), + file.path(pft$outdir, "trait.data.csv"), + row.names = FALSE + ) + + ### save and store in database all results except those that were there already + store_files_all <- list.files(path = pft[["outdir"]]) + store_files <- setdiff(store_files_all, old.files) + PEcAn.logger::logger.debug( + "The following posterior files found in PFT outdir ", + "(", shQuote(pft[["outdir"]]), ") will be registered in BETY ", + "under posterior ID ", format(pft[["posteriorid"]], scientific = FALSE), ": ", + paste(shQuote(store_files), collapse = ", "), ". ", + "The following files (if any) will not be registered because they already existed: ", + paste(shQuote(intersect(store_files, old.files)), collapse = ", "), + wrap = FALSE + ) + for (file in store_files) { + filename <- file.path(pathname, file) + file.copy(file.path(pft$outdir, file), filename) + dbfile.insert(in.path = pathname, in.prefix = file, + type = "Posterior", id = pft[["posteriorid"]], + con = dbcon) + } + + return(pft) +} diff --git a/base/db/R/get_postgres_envvars.R b/base/db/R/get_postgres_envvars.R new file mode 100644 index 00000000000..7d5773b21b4 --- /dev/null +++ b/base/db/R/get_postgres_envvars.R @@ -0,0 +1,75 @@ +#' Look up Postgres connection parameters from environment variables +#' +#' Retrieves database connection parameters stored in any of the +#' environment variables known by Postgres, +#' using defaults from `...` for parameters not set in the environment. +#' In a standard PEcAn installation only a few of these parameters +#' will ever be set, but we check all of them anyway in case you need to do +#' anything unusual. +#' +#' The list of environment variables we check is taken from the +#' [Postgres 12 manual](https://postgresql.org/docs/12/libpq-envars.html), +#' but it should apply to older Postgres versions as well. +#' Note that this function only looks for environment variables that control +#' connection parameters; it does not retrieve any of the variables related to +#' per-session behavior (e.g. PGTZ, PGSYSCONFDIR). +#' +#' @param ... defaults for parameters not found in the environment, +#' in `name = value` form +#' @return list of connection parameters suitable for passing on to `db.open` +#' +#' @examples +#' host <- Sys.getenv("PGHOST") # to restore environment after demo +#' +#' Sys.unsetenv("PGHOST") +#' get_postgres_envvars()$host # NULL +#' get_postgres_envvars(host = "default", port = 5432)$host # "default" + +#' # defaults are ignored for a variable that exists +#' Sys.setenv(PGHOST = "localhost") +#' get_postgres_envvars()$host # "localhost" +#' get_postgres_envvars(host = "postgres")$host # still "localhost" +#' +#' # To override a set variable, edit the returned list before using it +#' con_parms <- get_postgres_envvars() +#' con_parms$host # "localhost" +#' con_parms$host <- "postgres" +#' # db.open(con_parms) +#' +#' Sys.setenv(PGHOST = host) +#' @export +get_postgres_envvars <- function(...) { + pg_vars <- list( + host = "PGHOST", + hostaddr = "PGHOSTADDR", + port = "PGPORT", + dbname = "PGDATABASE", + user = "PGUSER", + password = "PGPASSWORD", + passfile = "PGPASSFILE", + service = "PGSERVICE", + options = "PGOPTIONS", + application_name = "PGAPPNAME", + ssl_mode = "PGSSLMODE", + requiressl = "PGREQUIRESSL", + sslcompression = "PGSSLCOMPRESSION", + sslcert = "PGSSLCERT", + sslkey = "PGSSLKEY", + sslrootcert = "PGSSLROOTCERT", + sslcrl = "PGSSLCRL", + requirepeer = "PGREQUIREPEER", + krbsrvname = "PGKRBSRVNAME", + gsslib = "PGGSSLIB", + connect_timeout = "PGCONNECT_TIMEOUT", + client_encoding = "PGCLIENTENCODING", + target_session_attrs = "PGTARGETSESSIONATTRS") + + vals <- Sys.getenv(pg_vars) + names(vals) <- names(pg_vars) + vals <- vals[vals != ""] + + defaults <- list(...) + defaults <- defaults[!(names(defaults) %in% names(vals))] + + append(vals, defaults) +} diff --git a/base/db/R/insert.format.vars.R b/base/db/R/insert.format.vars.R index 27ce4a453d6..95cafbf6c87 100644 --- a/base/db/R/insert.format.vars.R +++ b/base/db/R/insert.format.vars.R @@ -1,17 +1,17 @@ -#' Insert Format and Format-Variable Records +#' Insert Format and Format-Variable Records #' #' @param con SQL connection to BETYdb #' @param format_name The name of the format. Type: character string. -#' @param mimetype_id The id associated with the mimetype of the format. Type: integer. +#' @param mimetype_id The id associated with the mimetype of the format. Type: integer. #' @param header Boolean that indicates the presence of a header in the format. Defaults to "TRUE". -#' @param skip Integer that indicates the number of lines to skip in the header. Defaults to 0. -#' @param formats_variables A 'tibble' consisting of entries that correspond to columns in the formats-variables table. See Details for further information. +#' @param skip Integer that indicates the number of lines to skip in the header. Defaults to 0. +#' @param formats_variables A 'tibble' consisting of entries that correspond to columns in the formats-variables table. See Details for further information. #' @param notes Additional description of the format: character string. -#' @param suppress Boolean that suppresses or allows a test for an existing variable id. This test is inconvenient in applications where the variable_ids are already known. -#' @details The formats_variables argument must be a 'tibble' and be structured in a specific format so that the SQL query functions properly. All arguments should be passed as vectors so that each entry will correspond with a specific row. All empty values should be specified as NA. +#' @param suppress Boolean that suppresses or allows a test for an existing variable id. This test is inconvenient in applications where the variable_ids are already known. +#' @details The formats_variables argument must be a 'tibble' and be structured in a specific format so that the SQL query functions properly. All arguments should be passed as vectors so that each entry will correspond with a specific row. All empty values should be specified as NA. #' \describe{ #' \item{variable_id}{(Required) Vector of integers.} -#' \item{name}{(Optional) Vector of character strings. The variable name in the imported data need only be specified if it differs from the BETY variable name.} +#' \item{name}{(Optional) Vector of character strings. The variable name in the imported data need only be specified if it differs from the BETY variable name.} #' \item{unit}{(Optional) Vector of type character string. Should be in a format parseable by the udunits library and need only be secified if the units of the data in the file differ from the BETY standard.} #' \item{storage_type}{(Optional) Vector of character strings. Storage type need only be specified if the variable is stored in a format other than would be expected (e.g. if numeric values are stored as quoted character strings). Additionally, storage_type stores POSIX codes that are used to store any time variables (e.g. a column with a 4-digit year would be \%Y). See also \code{[base::strptime]}} #' \item{column_number}{Vector of integers that list the column numbers associated with variables in a dataset. Required for text files that lack headers.}} @@ -21,55 +21,62 @@ #' @examples #' \dontrun{ #' bety <- PEcAn.DB::betyConnect() -#' +#' #' formats_variables_tibble <- tibble::tibble( -#' variable_id = c(411, 135, 382), -#' name = c("NPP", NA, "YEAR"), -#' unit = c("g C m-2 yr-1", NA, NA), -#' storage_type = c(NA, NA, "%Y"), -#' column_number = c(2, NA, 4), -#' ) -#' insert.format.vars(con = bety$con, format_name = "LTER-HFR-103", mimetype_id = 1090, notes = "NPP from Harvard Forest.", header = FALSE, skip = 0, formats_variables = formats_variables_tibble) +#' variable_id = c(411, 135, 382), +#' name = c("NPP", NA, "YEAR"), +#' unit = c("g C m-2 yr-1", NA, NA), +#' storage_type = c(NA, NA, "%Y"), +#' column_number = c(2, NA, 4)) +#' +#' insert.format.vars( +#' con = bety$con, +#' format_name = "LTER-HFR-103", +#' mimetype_id = 1090, +#' notes = "NPP from Harvard Forest.", +#' header = FALSE, +#' skip = 0, +#' formats_variables = formats_variables_tibble) #' } insert.format.vars <- function(con, format_name, mimetype_id, notes = NULL, header = TRUE, skip = 0, formats_variables = NULL, suppress = TRUE){ - + # Test if name is a character string if(!is.character(format_name)){ PEcAn.logger::logger.error( "Name must be a character string" ) } - + # Test if format name already exists - name_test <- dplyr::tbl(con, "formats") %>% dplyr::select(id, name) %>% dplyr::filter(name %in% !!format_name) %>% collect() + name_test <- dplyr::tbl(con, "formats") %>% dplyr::select(.data$id, .data$name) %>% dplyr::filter(.data$name %in% !!format_name) %>% dplyr::collect() name_test_df <- as.data.frame(name_test) if(!is.null(name_test_df[1,1])){ PEcAn.logger::logger.error( "Name already exists" ) } - + #Test if skip is an integer if(!is.character(skip)){ PEcAn.logger::logger.error( "Skip must be of type character" ) } - + # Test if header is a Boolean if(!is.logical(header)){ PEcAn.logger::logger.error( "Header must be of type Boolean" ) } - + # Test if notes are a character string if(!is.character(notes)&!is.null(notes)){ PEcAn.logger::logger.error( "Notes must be of type character" ) } - + ######## Formats-Variables tests ############### if(!is.null(formats_variables)){ for(i in 1:nrow(formats_variables)){ @@ -81,7 +88,7 @@ insert.format.vars <- function(con, format_name, mimetype_id, notes = NULL, head if(suppress == FALSE){ ## Test if variable_id already exists ## - var_id_test <- dplyr::tbl(con, "variables") %>% dplyr::select(id) %>% dplyr::filter(id %in% !!formats_variables[[i, "variable_id"]]) %>% dplyr::collect(id) + var_id_test <- dplyr::tbl(con, "variables") %>% dplyr::select(.data$id) %>% dplyr::filter(.data$id %in% !!formats_variables[[i, "variable_id"]]) %>% dplyr::collect(.data$id) if(!is.null(var_id_test[1,1])){ PEcAn.logger::logger.error( "variable_id already exists" @@ -110,21 +117,21 @@ insert.format.vars <- function(con, format_name, mimetype_id, notes = NULL, head ) } } - + ## convert NA to "" for inserting into db ## formats_variables[is.na(formats_variables)] <- "" - + ### udunit tests ### for(i in 1:nrow(formats_variables)){ u1 <- formats_variables[1,"unit"] - u2 <- dplyr::tbl(con, "variables") %>% dplyr::select(id, units) %>% dplyr::filter(id %in% !!formats_variables[[1, "variable_id"]]) %>% dplyr::pull(units) - + u2 <- dplyr::tbl(con, "variables") %>% dplyr::select(.data$id, units) %>% dplyr::filter(.data$id %in% !!formats_variables[[1, "variable_id"]]) %>% dplyr::pull(.data$units) + if(!udunits2::ud.is.parseable(u1)){ PEcAn.logger::logger.error( "Units not parseable. Please enter a unit that is parseable by the udunits library." ) } - # Grab the bety units and + # Grab the bety units and if(!udunits2::ud.are.convertible(u1, u2)){ PEcAn.logger::logger.error( "Units are not convertable." @@ -132,7 +139,7 @@ insert.format.vars <- function(con, format_name, mimetype_id, notes = NULL, head } } } - + formats_df <- tibble::tibble( header = as.character(header), skip = skip, @@ -144,20 +151,20 @@ insert.format.vars <- function(con, format_name, mimetype_id, notes = NULL, head ## Insert format record inserted_formats <- db_merge_into(formats_df, "formats", con = con, by = c("name", "mimetype_id")) ## Make sure to include a 'by' argument - format_id <- dplyr::pull(inserted_formats, id) - + format_id <- dplyr::pull(inserted_formats, .data$id) + if(!is.null(formats_variables)){ - ## Insert format_id into + ## Insert format_id into n <- nrow(formats_variables) format_id_df <- matrix(data = format_id, nrow = n, ncol = 1) colnames(format_id_df) <- "format_id" - + ## Make query data.frame - formats_variables_input <- cbind(format_id_df, formats_variables) - + formats_variables_input <- cbind(format_id_df, formats_variables) + ## Insert Format-Variable record inserted_formats_variables <- db_merge_into(formats_variables_input, "formats_variables", con = con, by = c("variable_id")) } return(format_id) - + } diff --git a/base/db/R/insert_table.R b/base/db/R/insert_table.R index bc5df90f389..5eb2e8112d5 100644 --- a/base/db/R/insert_table.R +++ b/base/db/R/insert_table.R @@ -20,8 +20,8 @@ #' dplyr::tbl(irisdb, "iris") insert_table <- function(values, table, con, coerce_col_class = TRUE, drop = TRUE) { values_fixed <- match_dbcols(values, table, con, coerce_col_class, drop = TRUE) - insert_query <- build_insert_query(values_fixed, table, .con = con) - db.query(insert_query, con) + + DBI::dbAppendTable(con, table, values_fixed) } #' Match column names and classes between local and SQL table @@ -91,22 +91,3 @@ match_colnames <- function(values, table, con) { values_cols <- colnames(values) intersect(values_cols, table_cols) } - -#' Build query to insert R data frame into SQL table -#' -#' @inheritParams insert_table -#' @inheritParams glue::glue_sql -build_insert_query <- function(values, table, .con) { - value_list <- purrr::map(seq_len(nrow(values)), ~as.list(values[.x, ])) - - insert_list <- value_list %>% - purrr::map(unname) %>% - purrr::map(dbplyr::escape, con = .con) %>% - purrr::map(dbplyr::sql_vector, con = .con) - - glue::glue_sql( - "INSERT INTO {`table`} ({`colnames(values)`*}) ", - "VALUES {insert_list*}", - .con = .con - ) -} diff --git a/base/db/R/query.data.R b/base/db/R/query.data.R new file mode 100644 index 00000000000..7cedb1033d8 --- /dev/null +++ b/base/db/R/query.data.R @@ -0,0 +1,56 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##--------------------------------------------------------------------------------------------------# +##' Function to query data from database for specific species and convert stat to SE +##' +##' @name query.data +##' @title Query data and transform stats to SE by calling \code{\link{fetch.stats2se}}; +##' @param trait trait to query from the database +##' @param spstr IDs of species to query from, as a single comma-separated string +##' @param con database connection +##' @param extra.columns other query terms to pass in. If unspecified, retrieves latitude and longitude +##' @param ids_are_cultivars if TRUE, ids is a vector of cultivar IDs, otherwise they are species IDs +##' @param ... extra arguments +##' @seealso used in \code{\link{query.trait.data}}; \code{\link{fetch.stats2se}}; \code{\link{transformstats}} performs transformation calculations +##' @author David LeBauer, Carl Davidson +query.data <- function( + trait, + spstr, + con, + extra.columns = paste( + "ST_X(ST_CENTROID(sites.geometry)) AS lon,", + "ST_Y(ST_CENTROID(sites.geometry)) AS lat, "), + store.unconverted = FALSE, + ids_are_cultivars = FALSE, + ...) { + id_type <- if (ids_are_cultivars) {"cultivar_id"} else {"specie_id"} + + query <- paste("select + traits.id, traits.citation_id, traits.site_id, traits.treatment_id, + treatments.name, traits.date, traits.time, traits.cultivar_id, traits.specie_id, + traits.mean, traits.statname, traits.stat, traits.n, variables.name as vname, + extract(month from traits.date) as month,", + extra.columns, + "treatments.control, sites.greenhouse + from traits + left join treatments on (traits.treatment_id = treatments.id) + left join sites on (traits.site_id = sites.id) + left join variables on (traits.variable_id = variables.id) + where ", id_type, " in (", spstr,") + and variables.name in ('", trait,"');", sep = "") + result <- fetch.stats2se(connection = con, query = query) + + if(store.unconverted) { + result$mean_unconverted <- result$mean + result$stat_unconverted <- result$stat + } + + return(result) +} \ No newline at end of file diff --git a/base/db/R/query.dplyr.R b/base/db/R/query.dplyr.R index 4882ed53c0a..e587925cc2c 100644 --- a/base/db/R/query.dplyr.R +++ b/base/db/R/query.dplyr.R @@ -1,22 +1,35 @@ #' Connect to bety using current PEcAn configuration #' @param php.config Path to `config.php` #' @export -#' +#' betyConnect <- function(php.config = "../../web/config.php") { ## Read PHP config file for webserver + if (file.exists(php.config)) { + php_params <- PEcAn.utils::read_web_config(php.config) + } else { + php_params <- list() + } + + ## helper function + getphp = function (item, default = "") { + value = php_params[[item]] + if (is.null(value)) default else value + } - config.list <- PEcAn.utils::read_web_config(php.config) + ## fill in all data from environment variables + dbparams <- get_postgres_envvars(host = getphp("db_bety_hostname", "localhost"), + port = getphp("db_bety_port", "5432"), + dbname = getphp("db_bety_database", "bety"), + user = getphp("db_bety_username", "bety"), + password = getphp("db_bety_password", "bety")) + + ## force driver to be postgres (only value supported by db.open) + dbparams[["driver"]] <- "Postgres" ## Database connection - # TODO: The latest version of dplyr/dbplyr works with standard DBI-based - # objects, so we should replace this with a standard `db.open` call. - dplyr::src_postgres(dbname = config.list$db_bety_database, - host = config.list$db_bety_hostname, - user = config.list$db_bety_username, - password = config.list$db_bety_password) + db.open(dbparams) } # betyConnect - #' Convert number to scientific notation pretty expression #' @param l Number to convert to scientific notation #' @export @@ -59,22 +72,28 @@ ncdays2date <- function(time, unit) { #' @export dbHostInfo <- function(bety) { # get host id - result <- db.query(query = "select cast(floor(nextval('users_id_seq') / 1e9) as bigint);", con = bety$con) + result <- db.query(query = "select cast(floor(nextval('users_id_seq') / 1e9) as bigint);", con = bety) hostid <- result[["floor"]] # get machine start and end based on hostid machine <- dplyr::tbl(bety, "machines") %>% - dplyr::filter(sync_host_id == !!hostid) %>% - dplyr::select(sync_start, sync_end) + dplyr::filter(.data$sync_host_id == !!hostid) + if (is.na(nrow(machine)) || nrow(machine) == 0) { return(list(hostid = hostid, + hostname = "", start = 1e+09 * hostid, - end = 1e+09 * (hostid + 1) - 1)) + end = 1e+09 * (hostid + 1) - 1, + sync_url = "", + sync_contact = "")) } else { return(list(hostid = hostid, + hostname = machine$hostname, start = machine$sync_start, - end = machine$sync_end)) + end = machine$sync_end, + sync_url = machine$sync_url, + sync_contact = machine$sync_contact)) } } # dbHostInfo @@ -92,7 +111,7 @@ workflows <- function(bety, ensemble = FALSE) { query <- "SELECT id AS workflow_id, folder FROM workflows" } dplyr::tbl(bety, dbplyr::sql(query)) %>% - dplyr::filter(workflow_id >= !!hostinfo$start & workflow_id <= !!hostinfo$end) %>% + dplyr::filter(.data$workflow_id >= !!hostinfo$start & .data$workflow_id <= !!hostinfo$end) %>% return() } # workflows @@ -103,7 +122,7 @@ workflows <- function(bety, ensemble = FALSE) { #' @export workflow <- function(bety, workflow_id) { workflows(bety) %>% - dplyr::filter(workflow_id == !!workflow_id) + dplyr::filter(.data$workflow_id == !!.data$workflow_id) } # workflow @@ -113,14 +132,14 @@ workflow <- function(bety, workflow_id) { #' @export runs <- function(bety, workflow_id) { Workflows <- workflow(bety, workflow_id) %>% - dplyr::select(workflow_id, folder) + dplyr::select(.data$workflow_id, .data$folder) Ensembles <- dplyr::tbl(bety, "ensembles") %>% - dplyr::select(ensemble_id = id, workflow_id) %>% + dplyr::select(ensemble_id = .data$id, .data$workflow_id) %>% dplyr::inner_join(Workflows, by = "workflow_id") Runs <- dplyr::tbl(bety, "runs") %>% - dplyr::select(run_id = id, ensemble_id) %>% + dplyr::select(run_id = .data$id, .data$ensemble_id) %>% dplyr::inner_join(Ensembles, by = "ensemble_id") - dplyr::select(Runs, -workflow_id, -ensemble_id) %>% + dplyr::select(Runs, -.data$workflow_id, -.data$ensemble_id) %>% return() } # runs @@ -136,9 +155,9 @@ get_workflow_ids <- function(bety, query, all.ids = FALSE) { } else { # Get all workflow IDs ids <- workflows(bety, ensemble = FALSE) %>% - dplyr::distinct(workflow_id) %>% + dplyr::distinct(.data$workflow_id) %>% dplyr::collect() %>% - dplyr::pull(workflow_id) %>% + dplyr::pull(.data$workflow_id) %>% sort(decreasing = TRUE) } return(ids) @@ -151,7 +170,7 @@ get_users <- function(bety) { hostinfo <- dbHostInfo(bety) query <- "SELECT id, login FROM users" out <- dplyr::tbl(bety, dbplyr::sql(query)) %>% - dplyr::filter(id >= hostinfo$start & id <= hostinfo$end) + dplyr::filter(.data$id >= hostinfo$start & .data$id <= hostinfo$end) return(out) } # get_workflow_ids @@ -165,7 +184,7 @@ get_run_ids <- function(bety, workflow_id) { if (workflow_id != "") { runs <- runs(bety, workflow_id) if (dplyr.count(runs) > 0) { - run_ids <- dplyr::pull(runs, run_id) %>% sort() + run_ids <- dplyr::pull(runs, .data$run_id) %>% sort() } } return(run_ids) @@ -181,7 +200,7 @@ get_run_ids <- function(bety, workflow_id) { get_var_names <- function(bety, workflow_id, run_id, remove_pool = TRUE) { var_names <- character(0) if (workflow_id != "" && run_id != "") { - workflow <- dplyr::collect(workflow(bety, workflow_id)) + workflow <- dplyr::collect(workflow(bety, .data$workflow_id)) if (nrow(workflow) > 0) { outputfolder <- file.path(workflow$folder, "out", run_id) if (utils::file_test("-d", outputfolder)) { @@ -235,18 +254,18 @@ load_data_single_run <- function(bety, workflow_id, run_id) { # @return Dataframe for one run # Adapted from earlier code in pecan/shiny/workflowPlot/server.R globalDF <- data.frame() - workflow <- dplyr::collect(workflow(bety, workflow_id)) + workflow <- dplyr::collect(workflow(bety, .data$workflow_id)) # Use the function 'var_names_all' to get all variables var_names <- var_names_all(bety, workflow_id, run_id) # lat/lon often cause trouble (like with JULES) but aren't needed for this basic plotting - var_names <- setdiff(var_names, c("lat", "latitude", "lon", "longitude")) + var_names <- setdiff(var_names, c("lat", "latitude", "lon", "longitude")) outputfolder <- file.path(workflow$folder, 'out', run_id) out <- read.output(runid = run_id, outdir = outputfolder, variables = var_names, dataframe = TRUE) ncfile <- list.files(path = outputfolder, pattern = "\\.nc$", full.names = TRUE)[1] nc <- ncdf4::nc_open(ncfile) - + globalDF <- tidyr::gather(out, key = var_name, value = vals, names(out)[names(out) != "posix"]) %>% - dplyr::rename(dates = posix) + dplyr::rename(dates = .data$posix) globalDF$workflow_id <- workflow_id globalDF$run_id <- run_id globalDF$xlab <- "Time" diff --git a/base/db/R/query.format.vars.R b/base/db/R/query.format.vars.R index 79f88eba8d8..c59bdcd131b 100644 --- a/base/db/R/query.format.vars.R +++ b/base/db/R/query.format.vars.R @@ -13,8 +13,6 @@ query.format.vars <- function(bety, input.id=NA, format.id=NA, var.ids=NA) { PEcAn.logger::logger.error("Must specify input id or format id") } - con <- bety$con - # get input info either form input.id or format.id, depending which is provided # defaults to format.id if both provided # also query site information (id/lat/lon) if an input.id @@ -27,9 +25,9 @@ query.format.vars <- function(bety, input.id=NA, format.id=NA, var.ids=NA) { if (is.na(format.id)) { f <- PEcAn.DB::db.query( query = paste("SELECT * from formats as f join inputs as i on f.id = i.format_id where i.id = ", input.id), - con = con + con = bety ) - site.id <- PEcAn.DB::db.query(query = paste("SELECT site_id from inputs where id =", input.id), con = con) + site.id <- PEcAn.DB::db.query(query = paste("SELECT site_id from inputs where id =", input.id), con = bety) if (is.data.frame(site.id) && nrow(site.id)>0) { site.id <- site.id$site_id site.info <- @@ -38,17 +36,17 @@ query.format.vars <- function(bety, input.id=NA, format.id=NA, var.ids=NA) { "SELECT id, time_zone, ST_X(ST_CENTROID(geometry)) AS lon, ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id =", site.id ), - con = con + con = bety ) site.lat <- site.info$lat site.lon <- site.info$lon site.time_zone <- site.info$time_zone } } else { - f <- PEcAn.DB::db.query(query = paste("SELECT * from formats where id = ", format.id), con = con) + f <- PEcAn.DB::db.query(query = paste("SELECT * from formats where id = ", format.id), con = bety) } - mimetype <- PEcAn.DB::db.query(query = paste("SELECT * from mimetypes where id = ", f$mimetype_id), con = con)[["type_string"]] + mimetype <- PEcAn.DB::db.query(query = paste("SELECT * from mimetypes where id = ", f$mimetype_id), con = bety)[["type_string"]] f$mimetype <- utils::tail(unlist(strsplit(mimetype, "/")),1) # get variable names and units of input data @@ -56,12 +54,12 @@ query.format.vars <- function(bety, input.id=NA, format.id=NA, var.ids=NA) { query = paste( "SELECT variable_id,name,unit,storage_type,column_number from formats_variables where format_id = ", f$id ), - con = con + con = bety ) if(all(!is.na(var.ids))){ # Need to subset the formats table - fv <- fv %>% dplyr::filter(variable_id %in% !!var.ids | storage_type != "") + fv <- fv %>% dplyr::filter(.data$variable_id %in% !!var.ids | .data$storage_type != "") if(dim(fv)[1] == 0){ PEcAn.logger::logger.error("None of your requested variables are available") } @@ -84,7 +82,7 @@ query.format.vars <- function(bety, input.id=NA, format.id=NA, var.ids=NA) { vars_bety[i, (ncol(vars_bety) - 1):ncol(vars_bety)] <- as.matrix(PEcAn.DB::db.query( query = paste("SELECT name, units from variables where id = ", fv$variable_id[i]), - con = con + con = bety )) } @@ -171,36 +169,36 @@ query.format.vars <- function(bety, input.id=NA, format.id=NA, var.ids=NA) { ##' Convert BETY variable names to MsTMIP and subsequently PEcAn standard names ##' ##' @param vars_bety data frame with variable names and units -##' @export +##' @export ##' ##' @author Betsy Cowdery bety2pecan <- function(vars_bety){ - - # This needs to be moved to lazy load - bety_mstmip <- utils::read.csv(system.file("bety_mstmip_lookup.csv", package= "PEcAn.DB"), + + # This needs to be moved to lazy load + bety_mstmip <- utils::read.csv(system.file("bety_mstmip_lookup.csv", package= "PEcAn.DB"), header = T, stringsAsFactors = FALSE) - + vars_full <- merge(vars_bety, bety_mstmip, by = "bety_name", all.x = TRUE) - + vars_full$pecan_name <- vars_full$mstmip_name vars_full$pecan_units <- vars_full$mstmip_units ind <- is.na(vars_full$pecan_name) vars_full$pecan_name[ind] <- vars_full$bety_name[ind] vars_full$pecan_units[ind] <- vars_full$bety_units[ind] - + dups <- unique(vars_full$pecan_name[duplicated(vars_full$pecan_name)]) - + if("NEE" %in% dups){ # This is a hack specific to Ameriflux! - # It ultimately needs to be generalized, perhaps in a better version of + # It ultimately needs to be generalized, perhaps in a better version of # bety2pecan that doesn't use a lookup table # In Ameriflux FC and NEE can map to NEE in mstmip/pecan standard # Thus if both are reported in the data, both will be converted to NEE - # which creates a conflict. + # which creates a conflict. # Here we go back to the bety name to determine which of those is NEE # The variable that is not NEE in bety (assuming it's FC) is discarded. - + keep <- which(vars_full$bety_name[which(vars_full$pecan_name == "NEE")] == "NEE") if(length(keep) == 1){ discard <- vars_full$bety_name[which(vars_full$pecan_name == "NEE")][-keep] diff --git a/base/db/R/query.pft.R b/base/db/R/query.pft.R index bf10f85f88b..920cacbd5f7 100644 --- a/base/db/R/query.pft.R +++ b/base/db/R/query.pft.R @@ -65,7 +65,7 @@ query.pft_species <- function(pft, modeltype = NULL, con) { query.pft_cultivars <- function(pft, modeltype = NULL, con) { pft_tbl <- (dplyr::tbl(con, "pfts") - %>% dplyr::filter(name == !!pft, pft_type == "cultivar")) + %>% dplyr::filter(.data$name == !!pft, .data$pft_type == "cultivar")) if (!is.null(modeltype)) { pft_tbl <- (pft_tbl @@ -73,7 +73,7 @@ query.pft_cultivars <- function(pft, modeltype = NULL, con) { dplyr::tbl(con, "modeltypes"), by = c("modeltype_id" = "id"), suffix = c("", ".mt")) - %>% dplyr::filter(name.mt == !!modeltype)) + %>% dplyr::filter(.data$name.mt == !!modeltype)) } (pft_tbl @@ -90,12 +90,12 @@ query.pft_cultivars <- function(pft, modeltype = NULL, con) { by=c("specie_id" = "id"), suffix=c("", ".sp")) %>% dplyr::select( - id = cultivar_id, - specie_id, - genus, - species, - scientificname, - cultivar = name.cv) + id = .data$cultivar_id, + .data$specie_id, + .data$genus, + .data$species, + .data$scientificname, + cultivar = .data$name.cv) %>% dplyr::collect()) } diff --git a/base/db/R/query.trait.data.R b/base/db/R/query.trait.data.R index b2054425ecb..19eb2c88d83 100644 --- a/base/db/R/query.trait.data.R +++ b/base/db/R/query.trait.data.R @@ -6,417 +6,6 @@ # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html #------------------------------------------------------------------------------- -##--------------------------------------------------------------------------------------------------# -##' Queries data from the trait database and transforms statistics to SE -##' -##' Performs query and then uses \code{transformstats} to convert miscellaneous statistical summaries -##' to SE -##' @name fetch.stats2se -##' @title Fetch data and transform stats to SE -##' @param connection connection to trait database -##' @param query to send to databse -##' @return dataframe with trait data -##' @seealso used in \code{\link{query.trait.data}}; \code{\link{transformstats}} performs transformation calculations -##' @author -fetch.stats2se <- function(connection, query){ - transformed <- PEcAn.utils::transformstats(db.query(query = query, con = connection)) - return(transformed) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' Function to query data from database for specific species and convert stat to SE -##' -##' @name query.data -##' @title Query data and transform stats to SE by calling \code{\link{fetch.stats2se}}; -##' @param trait trait to query from the database -##' @param spstr IDs of species to query from, as a single comma-separated string -##' @param extra.columns other query terms to pass in. If unspecified, retrieves latitude and longitude -##' @param con database connection -##' @param ids_are_cultivars if TRUE, ids is a vector of cultivar IDs, otherwise they are species IDs -##' @param ... extra arguments -##' @seealso used in \code{\link{query.trait.data}}; \code{\link{fetch.stats2se}}; \code{\link{transformstats}} performs transformation calculations -##' @author David LeBauer, Carl Davidson -query.data <- function(trait, spstr, extra.columns = 'ST_X(ST_CENTROID(sites.geometry)) AS lon, ST_Y(ST_CENTROID(sites.geometry)) AS lat, ', con=NULL, store.unconverted=FALSE, ids_are_cultivars=FALSE, ...) { - if (is.null(con)) { - PEcAn.logger::logger.error("No open database connection passed in.") - con <- db.open(settings$database$bety) - on.exit(db.close(con)) - } - id_type = if (ids_are_cultivars) {"cultivar_id"} else {"specie_id"} - - query <- paste("select - traits.id, traits.citation_id, traits.site_id, traits.treatment_id, - treatments.name, traits.date, traits.time, traits.cultivar_id, traits.specie_id, - traits.mean, traits.statname, traits.stat, traits.n, variables.name as vname, - extract(month from traits.date) as month,", - extra.columns, - "treatments.control, sites.greenhouse - from traits - left join treatments on (traits.treatment_id = treatments.id) - left join sites on (traits.site_id = sites.id) - left join variables on (traits.variable_id = variables.id) - where ", id_type, " in (", spstr,") - and variables.name in ('", trait,"');", sep = "") - result <- fetch.stats2se(connection = con, query = query) - - if(store.unconverted) { - result$mean_unconverted <- result$mean - result$stat_unconverted <- result$stat - } - - return(result) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' Function to query yields data from database for specific species and convert stat to SE -##' -##' @name query.yields -##' @title Query yield data and transform stats to SE by calling \code{\link{fetch.stats2se}}; -##' @param trait yield trait to query -##' @param spstr species to query for yield data -##' @param extra.columns other query terms to pass in. Optional -##' @param con database connection -##' @param ids_are_cultivars if TRUE, spstr contains cultivar IDs, otherwise they are species IDs -##' @param ... extra arguments -##' @seealso used in \code{\link{query.trait.data}}; \code{\link{fetch.stats2se}}; \code{\link{transformstats}} performs transformation calculations -##' @author -query.yields <- function(trait = 'yield', spstr, extra.columns = '', con = NULL, - ids_are_cultivars = FALSE, ...){ - - member_column <- if (ids_are_cultivars) {"cultivar_id"} else {"specie_id"} - query <- paste("select - yields.id, yields.citation_id, yields.site_id, treatments.name, - yields.date, yields.time, yields.cultivar_id, yields.specie_id, - yields.mean, yields.statname, yields.stat, yields.n, - variables.name as vname, - month(yields.date) as month,", - extra.columns, - "treatments.control, sites.greenhouse - from yields - left join treatments on (yields.treatment_id = treatments.id) - left join sites on (yields.site_id = sites.id) - left join variables on (yields.variable_id = variables.id) - where ", member_column, " in (", spstr,");", sep = "") - if(!trait == 'yield'){ - query <- gsub(");", paste(" and variables.name in ('", trait,"');", sep = ""), query) - } - - return(fetch.stats2se(connection = con, query = query)) -} -##==================================================================================================# - - -######################## COVARIATE FUNCTIONS ################################# - -##--------------------------------------------------------------------------------------------------# -##' Append covariate data as a column within a table -##' -##' \code{append.covariate} appends a data frame of covariates as a new column in a data frame -##' of trait data. -##' In the event a trait has several covariates available, the first one found -##' (i.e. lowest row number) will take precedence -##' -##' @param data trait dataframe that will be appended to. -##' @param column.name name of the covariate as it will appear in the appended column -##' @param covariates.data one or more tables of covariate data, ordered by the precedence -##' they will assume in the event a trait has covariates across multiple tables. -##' All tables must contain an 'id' and 'level' column, at minimum. -##' -##' @author Carl Davidson, Ryan Kelly -##' @export -##--------------------------------------------------------------------------------------------------# -append.covariate <- function(data, column.name, covariates.data){ - # Keep only the highest-priority covariate for each trait - covariates.data <- covariates.data[!duplicated(covariates.data$trait_id), ] - - # Select columns to keep, and rename the covariate column - covariates.data <- covariates.data[, c('trait_id', 'level')] - names(covariates.data) <- c('id', column.name) - - # Merge on trait ID - merged <- merge(covariates.data, data, all = TRUE, by = "id") - return(merged) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' Queries covariates from database for a given vector of trait id's -##' -##' @param trait.ids list of trait ids -##' @param con database connection -##' @param ... extra arguments -##' -##' @author David LeBauer -query.covariates <- function(trait.ids, con = NULL, ...){ - covariate.query <- paste("select covariates.trait_id, covariates.level,variables.name", - "from covariates left join variables on variables.id = covariates.variable_id", - "where trait_id in (", PEcAn.utils::vecpaste(trait.ids), ")") - covariates <- db.query(query = covariate.query, con = con) - return(covariates) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' Apply Arrhenius scaling to 25 degC for temperature-dependent traits -##' -##' @param data data frame of data to scale, as returned by query.data() -##' @param covariates data frame of covariates, as returned by query.covariates(). -##' Note that data with no matching covariates will be unchanged. -##' @param temp.covariates names of covariates used to adjust for temperature; -##' if length > 1, order matters (first will be used preferentially) -##' @param new.temp the reference temperature for the scaled traits. Curerntly 25 degC -##' @param missing.temp the temperature assumed for traits with no covariate found. Curerntly 25 degC -##' @author Carl Davidson, David LeBauer, Ryan Kelly -arrhenius.scaling.traits <- function(data, covariates, temp.covariates, new.temp = 25, missing.temp = 25){ - # Select covariates that match temp.covariates - covariates <- covariates[covariates$name %in% temp.covariates,] - - if(nrow(covariates)>0) { - # Sort covariates in order of priority - covariates <- do.call(rbind, - lapply(temp.covariates, function(temp.covariate) covariates[covariates$name == temp.covariate, ]) - ) - - data <- append.covariate(data, 'temp', covariates) - - # Assign default value for traits with no covariates - data$temp[is.na(data$temp)] <- missing.temp - - # Scale traits - data$mean <- PEcAn.utils::arrhenius.scaling(observed.value = data$mean, old.temp = data$temp, new.temp=new.temp) - data$stat <- PEcAn.utils::arrhenius.scaling(observed.value = data$stat, old.temp = data$temp, new.temp=new.temp) - - #remove temporary covariate column. - data<-data[,colnames(data)!='temp'] - } else { - data <- NULL - } - return(data) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' Function to filter out upper canopy leaves -##' -##' @name filter_sunleaf_traits -##' @aliases filter.sunleaf.traits -##' @param data input data -##' @param covariates covariate data -##' -##' @author David LeBauer -filter_sunleaf_traits <- function(data, covariates){ - if(length(covariates)>0) { - data <- append.covariate(data = data, column.name = 'canopy_layer', - covariates.data = covariates[covariates$name == 'canopy_layer',]) - data <- data[data$canopy_layer >= 0.66 | is.na(data$canopy_layer),] - - # remove temporary covariate column - data <- data[,colnames(data)!='canopy_layer'] - } else { - data <- NULL - } - return(data) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' renames the variables within output data frame trait.data -##' -##' @param data data frame to with variables to rename -##' -##' @seealso used with \code{\link[PEcAn.MA]{jagify}}; -##' @export -##' @author David LeBauer -rename_jags_columns <- function(data) { - - # Change variable names and calculate obs.prec within data frame - transformed <- transform(data, - Y = mean, - se = stat, - obs.prec = 1 / (sqrt(n) * stat) ^2, - trt = trt_id, - site = site_id, - cite = citation_id, - ghs = greenhouse) - - # Subset data frame - selected <- subset(transformed, select = c('Y', 'n', 'site', 'trt', 'ghs', 'obs.prec', - 'se', 'cite')) - # Return subset data frame - return(selected) -} -##==================================================================================================# - - - -##--------------------------------------------------------------------------------------------------# -##' Change treatments to sequential integers -##' -##' Assigns all control treatments the same value, then assigns unique treatments -##' within each site. Each site is required to have a control treatment. -##' The algorithm (incorrectly) assumes that each site has a unique set of experimental -##' treatments. -##' @name assign.treatments -##' @title assign.treatments -##' @param data input data -##' @return dataframe with sequential treatments -##' @export -##' @author David LeBauer, Carl Davidson, Alexey Shiklomanov -assign.treatments <- function(data){ - data$trt_id[which(data$control == 1)] <- "control" - sites <- unique(data$site_id) - # Site IDs may be returned as `integer64`, which the `for` loop - # type-coerces to regular integer, which turns it into gibberish. - # Looping over the index instead prevents this type coercion. - for (si in seq_along(sites)) { - ss <- sites[[si]] - site.i <- data$site_id == ss - #if only one treatment, it's control - if (length(unique(data$trt_id[site.i])) == 1) data$trt_id[site.i] <- "control" - if (!"control" %in% data$trt_id[site.i]){ - PEcAn.logger::logger.severe(paste0( - "No control treatment set for site_id ", unique(data$site_id[site.i]), - " and citation id ", unique(data$citation_id[site.i]), ".\n", - "Please set control treatment for this site / citation in database.\n" - )) - } - } - return(data) -} - -drop.columns <- function(data, columns){ - return(data[, which(!colnames(data) %in% columns)]) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' sample from normal distribution, given summary stats -##' -##' @name take.samples -##' @title Sample from normal distribution, given summary stats -##' @param summary data.frame with values of mean and sd -##' @param sample.size number of samples to take -##' @return sample of length sample.size -##' @author David LeBauer, Carl Davidson -##' @export -##' @examples -##' ## return the mean when stat = NA -##' take.samples(summary = data.frame(mean = 10, stat = NA)) -##' ## return vector of length \code{sample.size} from N(mean,stat) -##' take.samples(summary = data.frame(mean = 10, stat = 10), sample.size = 10) -##' -take.samples <- function(summary, sample.size = 10^6){ - if(is.na(summary$stat)){ - ans <- summary$mean - } else { - set.seed(0) - ans <- stats::rnorm(n = sample.size, mean = summary$mean, sd = summary$stat) - } - return(ans) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' -##' Performs an arithmetic function, FUN, over a series of traits and returns -##' the result as a derived trait. -##' Traits must be specified as either lists or single row data frames, -##' and must be either single data points or normally distributed. -##' In the event one or more input traits are normally distributed, -##' the resulting distribution is approximated by numerical simulation. -##' The output trait is effectively a copy of the first input trait with -##' modified mean, stat, and n. -##' -##' @name derive.trait -##' @title Performs an arithmetic function, FUN, over a series of traits and returns the result as a derived trait. -##' @param FUN arithmetic function -##' @param ... traits that will be supplied to FUN as input -##' @param input list of trait inputs. See examples -##' @param var.name name to use in output -##' @param sample.size number of random samples generated by rnorm for normally distributed trait input -##' @return a copy of the first input trait with mean, stat, and n reflecting the derived trait -##' @export -##' @examples -##' input <- list(x = data.frame(mean = 1, stat = 1, n = 1)) -##' derive.trait(FUN = identity, input = input, var.name = 'x') -derive.trait <- function(FUN, ..., input = list(...), var.name = NA, sample.size = 10^6){ - if(any(lapply(input, nrow) > 1)){ - return(NULL) - } - input.samples <- lapply(input, take.samples, sample.size=sample.size) - output.samples <- do.call(FUN, input.samples) - output <- input[[1]] - output$mean <- mean(output.samples) - output$stat <- ifelse(length(output.samples) > 1, stats::sd(output.samples), NA) - output$n <- min(sapply(input, function(trait){trait$n})) - output$vname <- ifelse(is.na(var.name), output$vname, var.name) - return(output) -} -##==================================================================================================# - - -##--------------------------------------------------------------------------------------------------# -##' Equivalent to derive.trait(), but operates over a series of trait datasets, -##' as opposed to individual trait rows. See \code{\link{derive.trait}}; for more information. -##' -##' @name derive.traits -##' @title Performs an arithmetic function, FUN, over a series of traits and returns the result as a derived trait. -##' @export -##' @param FUN arithmetic function -##' @param ... trait datasets that will be supplied to FUN as input -##' @param input list of trait inputs. See examples in \code{\link{derive.trait}} -##' @param var.name name to use in output -##' @param sample.size where traits are normally distributed with a given -##' @param match.columns in the event more than one trait dataset is supplied, -##' this specifies the columns that identify a unique data point -##' @return a copy of the first input trait with modified mean, stat, and n -derive.traits <- function(FUN, ..., input = list(...), - match.columns = c('citation_id', 'site_id', 'specie_id'), - var.name = NA, sample.size = 10^6){ - if(length(input) == 1){ - input <- input[[1]] - #KLUDGE: modified to handle empty datasets - for(i in (0:nrow(input))[-1]){ - input[i,] <- derive.trait(FUN, input[i,], sample.size=sample.size) - } - return(input) - } - else if(length(match.columns) > 0){ - #function works recursively to reduce the number of match columns - match.column <- match.columns[[1]] - #find unique values within the column that intersect among all input datasets - columns <- lapply(input, function(data){data[[match.column]]}) - intersection <- Reduce(intersect, columns) - - #run derive.traits() on subsets of input that contain those unique values - derived.traits<-lapply(intersection, - function(id){ - filtered.input <- lapply(input, - function(data){data[data[[match.column]] == id,]}) - derive.traits(FUN, input=filtered.input, - match.columns=match.columns[-1], - var.name=var.name, - sample.size=sample.size) - }) - derived.traits <- derived.traits[!is.null(derived.traits)] - derived.traits <- do.call(rbind, derived.traits) - return(derived.traits) - } else { - return(derive.trait(FUN, input = input, var.name = var.name, sample.size = sample.size)) - } -} -##==================================================================================================# - ##--------------------------------------------------------------------------------------------------# ##' Extract trait data from database @@ -440,114 +29,114 @@ derive.traits <- function(FUN, ..., input = list(...), ##' } ##' @author David LeBauer, Carl Davidson, Shawn Serbin query.trait.data <- function(trait, spstr, con = NULL, update.check.only = FALSE, ids_are_cultivars = FALSE, ...){ - + if(is.list(con)){ PEcAn.logger::logger.warn("WEB QUERY OF DATABASE NOT IMPLEMENTED") return(NULL) } - + # print trait info if(!update.check.only) { PEcAn.logger::logger.info("---------------------------------------------------------") PEcAn.logger::logger.info(trait) } - -### Query the data from the database for trait X. + + ### Query the data from the database for trait X. data <- query.data(trait = trait, spstr = spstr, con = con, store.unconverted = TRUE, ids_are_cultivars = ids_are_cultivars) - -### Query associated covariates from database for trait X. + + ### Query associated covariates from database for trait X. covariates <- query.covariates(trait.ids = data$id, con = con) canopy.layer.covs <- covariates[covariates$name == 'canopy_layer', ] - -### Set small sample size for derived traits if update-checking only. Otherwise use default. + + ### Set small sample size for derived traits if update-checking only. Otherwise use default. if(update.check.only) { sample.size <- 10 } else { sample.size <- 10^6 ## Same default as derive.trait(), derive.traits(), and take.samples() } - + if(trait == 'Vcmax') { -######################### VCMAX ############################ -### Apply Arrhenius scaling to convert Vcmax at measurement temp to that at 25 degC (ref temp). + ######################### VCMAX ############################ + ### Apply Arrhenius scaling to convert Vcmax at measurement temp to that at 25 degC (ref temp). data <- arrhenius.scaling.traits(data = data, covariates = covariates, temp.covariates = c('leafT', 'airT','T')) - -### Keep only top of canopy/sunlit leaf samples based on covariate. + + ### Keep only top of canopy/sunlit leaf samples based on covariate. if(nrow(canopy.layer.covs) > 0) data <- filter_sunleaf_traits(data = data, covariates = canopy.layer.covs) - + ## select only summer data for Panicum virgatum ##TODO fix following hack to select only summer data if (spstr == "'938'"){ data <- subset(data, subset = data$month %in% c(0,5,6,7)) } - + } else if (trait == 'SLA') { -######################### SLA ############################ + ######################### SLA ############################ ## convert LMA to SLA data <- rbind(data, derive.traits(function(lma){1/lma}, query.data('LMA', spstr, con=con, store.unconverted=TRUE, - ids_are_cultivars=ids_are_cultivars), + ids_are_cultivars=ids_are_cultivars), sample.size=sample.size)) - + ### Keep only top of canopy/sunlit leaf samples based on covariate. if(nrow(canopy.layer.covs) > 0) data <- filter_sunleaf_traits(data = data, covariates = canopy.layer.covs) - + ## select only summer data for Panicum virgatum ##TODO fix following hack to select only summer data if (spstr == "'938'"){ data <- subset(data, subset = data$month %in% c(0,5,6,7,8,NA)) } - + } else if (trait == 'leaf_turnover_rate'){ -######################### LEAF TURNOVER ############################ + ######################### LEAF TURNOVER ############################ ## convert Longevity to Turnover data <- rbind(data, derive.traits(function(leaf.longevity){ 1 / leaf.longevity }, query.data('Leaf Longevity', spstr, con = con, store.unconverted = TRUE, - ids_are_cultivars = ids_are_cultivars), + ids_are_cultivars = ids_are_cultivars), sample.size = sample.size)) - + } else if (trait == 'root_respiration_rate') { -######################### ROOT RESPIRATION ############################ + ######################### ROOT RESPIRATION ############################ ## Apply Arrhenius scaling to convert root respiration at measurement temp ## to that at 25 degC (ref temp). data <- arrhenius.scaling.traits(data = data, covariates = covariates, temp.covariates = c('rootT', 'airT','soilT')) - + } else if (trait == 'leaf_respiration_rate_m2') { -######################### LEAF RESPIRATION ############################ + ######################### LEAF RESPIRATION ############################ ## Apply Arrhenius scaling to convert leaf respiration at measurement temp ## to that at 25 degC (ref temp). - data <- arrhenius.scaling.traits(data = data, covariates = covariates, temp.covariates = c('leafT', 'airT','T')) - + data <- arrhenius.scaling.traits(data = data, covariates = covariates, temp.covariates = c('leafT', 'airT','T')) + } else if (trait == 'stem_respiration_rate') { -######################### STEM RESPIRATION ############################ + ######################### STEM RESPIRATION ############################ ## Apply Arrhenius scaling to convert stem respiration at measurement temp ## to that at 25 degC (ref temp). data <- arrhenius.scaling.traits(data = data, covariates = covariates, temp.covariates = c('stemT', 'airT','T')) - + } else if (trait == 'c2n_leaf') { -######################### LEAF C:N ############################ - + ######################### LEAF C:N ############################ + data <- rbind(data, derive.traits(function(leafN){ 48 / leafN }, query.data('leafN', spstr, con = con, store.unconverted = TRUE, - ids_are_cultivars = ids_are_cultivars), + ids_are_cultivars = ids_are_cultivars), sample.size = sample.size)) - + } else if (trait == 'fineroot2leaf') { -######################### FINE ROOT ALLOCATION ############################ + ######################### FINE ROOT ALLOCATION ############################ ## FRC_LC is the ratio of fine root carbon to leaf carbon data <- rbind(data, query.data(trait = 'FRC_LC', spstr = spstr, con = con, store.unconverted = TRUE, ids_are_cultivars = ids_are_cultivars)) } result <- data - + ## if result is empty, stop run - + if (nrow(result) == 0) { return(NA) warning(paste("there is no data for", trait)) } else { - + ## Do we really want to print each trait table?? Seems like a lot of ## info to send to console. Maybe just print summary stats? ## print(result) @@ -558,10 +147,4 @@ query.trait.data <- function(trait, spstr, con = NULL, update.check.only = FALSE # print list of traits queried and number by outdoor/glasshouse return(result) } -} -##==================================================================================================# - - -#################################################################################################### -### EOF. End of R script file. -#################################################################################################### +} \ No newline at end of file diff --git a/base/db/R/query.traits.R b/base/db/R/query.traits.R index c156550ecc7..5b4dab14c68 100644 --- a/base/db/R/query.traits.R +++ b/base/db/R/query.traits.R @@ -6,7 +6,7 @@ # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html #------------------------------------------------------------------------------- -#--------------------------------------------------------------------------------------------------# +#------------------------------------------------------------------------------# ##' Query available trait data associated with a given pft and a list of traits ##' ##' @name query.traits @@ -21,24 +21,20 @@ ##' @export query.traits ##' @examples ##' \dontrun{ +##' con <- db.open(your_settings_here) ##' species <- query.pft_species('ebifarm.c4crop') ##' spstr <- vecpaste(species$id) ##' trvec <- c('leafN', 'SLA') -##' trait.data <- query.traits(spstr, trvec) +##' trait.data <- query.traits(spstr, trvec, con) ##' } ##' @author David LeBauer, Carl Davidson, Shawn Serbin -query.traits <- function(ids, priors, con = NULL, - update.check.only=FALSE, - ids_are_cultivars=FALSE){ +query.traits <- function(ids, priors, con, + update.check.only = FALSE, + ids_are_cultivars = FALSE) { - if(is.null(con)){ - con <- db.open(settings$database$bety) - on.exit(db.close(con)) - } - if(is.list(con)){ - print("query.traits") - print("WEB QUERY OF DATABASE NOT IMPLEMENTED") - return(NULL) + + if (!inherits(con, "DBIConnection")) { + PEcAn.logger::logger.severe("'con' is not a database connection") } if (length(ids) == 0 || length(priors) == 0) { @@ -48,12 +44,12 @@ query.traits <- function(ids, priors, con = NULL, id_type = rlang::sym(if (ids_are_cultivars) {"cultivar_id"} else {"specie_id"}) traits <- (dplyr::tbl(con, "traits") - %>% dplyr::inner_join(dplyr::tbl(con, "variables"), by = c("variable_id" = "id")) - %>% dplyr::filter( - (!!id_type %in% ids), - (name %in% !!priors)) # TODO: use .data$name when filter supports it - %>% dplyr::distinct(name) # TODO: use .data$name when distinct supports it - %>% dplyr::collect()) + %>% dplyr::inner_join(dplyr::tbl(con, "variables"), by = c("variable_id" = "id")) + %>% dplyr::filter( + (!!id_type %in% ids), + (.data$name %in% !!priors)) + %>% dplyr::distinct(.data$name) + %>% dplyr::collect()) if (nrow(traits) == 0) { return(list()) @@ -72,9 +68,3 @@ query.traits <- function(ids, priors, con = NULL, return(trait.data) } -#==================================================================================================# - - -#################################################################################################### -### EOF. End of R script file. -#################################################################################################### diff --git a/base/db/R/query.yields.R b/base/db/R/query.yields.R new file mode 100644 index 00000000000..d28c8bf10dd --- /dev/null +++ b/base/db/R/query.yields.R @@ -0,0 +1,45 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##--------------------------------------------------------------------------------------------------# +##' Function to query yields data from database for specific species and convert stat to SE +##' +##' @name query.yields +##' @title Query yield data and transform stats to SE by calling \code{\link{fetch.stats2se}}; +##' @param trait yield trait to query +##' @param spstr species to query for yield data +##' @param extra.columns other query terms to pass in. Optional +##' @param con database connection +##' @param ids_are_cultivars if TRUE, spstr contains cultivar IDs, otherwise they are species IDs +##' @param ... extra arguments +##' @seealso used in \code{\link{query.trait.data}}; \code{\link{fetch.stats2se}}; \code{\link{transformstats}} performs transformation calculations +##' @author +query.yields <- function(trait = 'yield', spstr, extra.columns = '', con = NULL, + ids_are_cultivars = FALSE, ...){ + + member_column <- if (ids_are_cultivars) {"cultivar_id"} else {"specie_id"} + query <- paste("select + yields.id, yields.citation_id, yields.site_id, treatments.name, + yields.date, yields.time, yields.cultivar_id, yields.specie_id, + yields.mean, yields.statname, yields.stat, yields.n, + variables.name as vname, + month(yields.date) as month,", + extra.columns, + "treatments.control, sites.greenhouse + from yields + left join treatments on (yields.treatment_id = treatments.id) + left join sites on (yields.site_id = sites.id) + left join variables on (yields.variable_id = variables.id) + where ", member_column, " in (", spstr,");", sep = "") + if(!trait == 'yield'){ + query <- gsub(");", paste(" and variables.name in ('", trait,"');", sep = ""), query) + } + + return(fetch.stats2se(connection = con, query = query)) +} \ No newline at end of file diff --git a/base/db/R/query_pfts.R b/base/db/R/query_pfts.R index 4e0ac654ed1..0015a1d790d 100644 --- a/base/db/R/query_pfts.R +++ b/base/db/R/query_pfts.R @@ -1,18 +1,20 @@ #' Retrieve PFT ID, name, and type from BETY #' #' @param dbcon Database connection object -#' @param pft_names Character vector of PFT names -#' @param modeltype +#' @param pft_names character vector of PFT names +#' @param modeltype character. +#' If specified, only returns PFTs matching this modeltype. +#' If NULL, considers all modeltypes. #' @return `data.frame` containing PFT ID (`id`), type (`pft_type`), -#' and name (`name`). +#' and name (`name`). #' @author Alexey Shiklomanov, Chris Black #' @export query_pfts <- function(dbcon, pft_names, modeltype = NULL, strict = FALSE) { pftres <- (dplyr::tbl(dbcon, "pfts") - %>% dplyr::filter(name %in% !!pft_names)) + %>% dplyr::filter(.data$name %in% !!pft_names)) if (!is.null(modeltype)) { pftres <- (pftres %>% dplyr::semi_join( - (dplyr::tbl(dbcon, "modeltypes") %>% dplyr::filter(name == !!modeltype)), + (dplyr::tbl(dbcon, "modeltypes") %>% dplyr::filter(.data$name == !!modeltype)), by = c("modeltype_id" = "id"))) } result <- (pftres diff --git a/base/db/R/search_references.R b/base/db/R/search_references.R index e1da9d9c0df..1e59df4e2c2 100644 --- a/base/db/R/search_references.R +++ b/base/db/R/search_references.R @@ -32,8 +32,8 @@ search_reference_single <- function(query, limit = 1, min_score = 85) { return(tibble::tibble(query = query)) } crdata <- crsearch[["data"]] %>% - dplyr::mutate(score = as.numeric(score)) %>% - dplyr::filter(score > !!min_score) + dplyr::mutate(score = as.numeric(.data$score)) %>% + dplyr::filter(.data$score > !!min_score) if (nrow(crdata) < 1) { PEcAn.logger::logger.info( "No matches found. ", @@ -54,14 +54,13 @@ search_reference_single <- function(query, limit = 1, min_score = 85) { proc_search <- crdata %>% dplyr::mutate( # Get the first author only -- this is the BETY format - author_family = purrr::map(author, list("family", 1)), - author_given = purrr::map(author, list("given", 1)), - author = paste(author_family, author_given, sep = ", "), - year = gsub("([[:digit:]]{4}).*", "\\1", issued) %>% as.numeric(), + author_family = purrr::map(.data$author, list("family", 1)), + author_given = purrr::map(.data$author, list("given", 1)), + author = paste(.data$author_family, .data$author_given, sep = ", "), + year = gsub("([[:digit:]]{4}).*", "\\1", .data$issued) %>% as.numeric(), query = query, - score = as.numeric(score) + score = as.numeric(.data$score) ) use_cols <- keep_cols[keep_cols %in% colnames(proc_search)] dplyr::select(proc_search, !!!use_cols) } - diff --git a/base/db/R/symmetric_setdiff.R b/base/db/R/symmetric_setdiff.R new file mode 100644 index 00000000000..1056ec0b5fd --- /dev/null +++ b/base/db/R/symmetric_setdiff.R @@ -0,0 +1,65 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +#' Symmetric set difference of two data frames +#' +#' @param x,y `data.frame`s to compare +#' @param xname Label for data in x but not y. Default = "x" +#' @param yname Label for data in y but not x. Default = "y" +#' @param namecol Name of label column. Default = "source". +#' @param simplify_types (Logical) If `TRUE`, coerce anything that +#' isn't numeric to character, to facilitate comparison. +#' @return `data.frame` of data not common to x and y, with additional +#' column (`namecol`) indicating whether data are only in x +#' (`xname`) or y (`yname`) +#' @export +#' @examples +#' xdf <- data.frame(a = c("a", "b", "c"), +#' b = c(1, 2, 3), +#' stringsAsFactors = FALSE) +#' ydf <- data.frame(a = c("a", "b", "d"), +#' b = c(1, 2.5, 3), +#' stringsAsFactors = FALSE) +#' symmetric_setdiff(xdf, ydf) +symmetric_setdiff <- function(x, y, xname = "x", yname = "y", + namecol = "source", simplify_types = TRUE) { + stopifnot(is.data.frame(x), is.data.frame(y), + is.character(xname), is.character(yname), + length(xname) == 1, length(yname) == 1) + is_i64 <- c( + vapply(x, inherits, logical(1), what = "integer64"), + vapply(y, inherits, logical(1), what = "integer64") + ) + if (any(is_i64)) { + PEcAn.logger::logger.debug( + "Detected at least one `integer64` column. ", + "Converting to `numeric` for comparison." + ) + if (requireNamespace("bit64", quietly = TRUE)) { + x <- dplyr::mutate_if(x, bit64::is.integer64, as.numeric) + y <- dplyr::mutate_if(y, bit64::is.integer64, as.numeric) + } else { + PEcAn.logger::logger.warn( + '"bit64" package required for `integer64` conversion, but not installed. ', + "Skipping conversion, which may produce weird results!" + ) + } + } + if (simplify_types) { + x <- dplyr::mutate_if(x, ~!is.numeric(.), as.character) + y <- dplyr::mutate_if(y, ~!is.numeric(.), as.character) + } + namecol <- dplyr::sym(namecol) + xy <- dplyr::setdiff(x, y) %>% + dplyr::mutate(!!namecol := xname) + yx <- dplyr::setdiff(y, x) %>% + dplyr::mutate(!!namecol := yname) + dplyr::bind_rows(xy, yx) %>% + dplyr::select(!!namecol, dplyr::everything()) +} diff --git a/base/db/R/take.samples.R b/base/db/R/take.samples.R new file mode 100644 index 00000000000..aa755a7e45e --- /dev/null +++ b/base/db/R/take.samples.R @@ -0,0 +1,35 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##-----------------------------------------------------------------------------# +##' sample from normal distribution, given summary stats +##' +##' @name take.samples +##' @title Sample from normal distribution, given summary stats +##' @param summary data.frame with values of mean and sd +##' @param sample.size number of samples to take +##' @return sample of length sample.size +##' @author David LeBauer, Carl Davidson +##' @export +##' @examples +##' ## return the mean when stat = NA +##' take.samples(summary = data.frame(mean = 10, stat = NA)) +##' ## return vector of length \code{sample.size} from N(mean,stat) +##' take.samples(summary = data.frame(mean = 10, stat = 10), sample.size = 10) +##' +take.samples <- function(summary, sample.size = 10^6){ + if(is.na(summary$stat)){ + ans <- summary$mean + } else { + set.seed(0) + ans <- stats::rnorm(n = sample.size, mean = summary$mean, sd = summary$stat) + } + return(ans) +} +##=============================================================================# diff --git a/base/db/R/try2sqlite.R b/base/db/R/try2sqlite.R index 828afd00957..2fdfb21ba65 100644 --- a/base/db/R/try2sqlite.R +++ b/base/db/R/try2sqlite.R @@ -75,7 +75,7 @@ try2sqlite <- function(try_files, sqlite_file = "try.sqlite") { PEcAn.logger::logger.info("Writing tables to SQLite database...") con <- DBI::dbConnect(RSQLite::SQLite(), sqlite_file) - on.exit(DBI::dbDisconnect(con)) + on.exit(DBI::dbDisconnect(con), add = TRUE) PEcAn.logger::logger.info("Writing values table...") DBI::dbWriteTable(con, "values", data_values) PEcAn.logger::logger.info("Writing traits table...") diff --git a/base/db/R/utils_db.R b/base/db/R/utils_db.R index b168a97c306..dad6a6184b3 100644 --- a/base/db/R/utils_db.R +++ b/base/db/R/utils_db.R @@ -125,7 +125,7 @@ db.query <- function(query, con = NULL, params = NULL, values = NULL) { PEcAn.logger::logger.severe("No parameters or connection specified") } con <- db.open(params) - on.exit(db.close(con)) + on.exit(db.close(con), add = TRUE) } if (.db.utils$showquery) { PEcAn.logger::logger.debug(query) @@ -318,7 +318,7 @@ db.exists <- function(params, write = TRUE, table = NA) { if (is.null(con)) { return(invisible(FALSE)) } else { - on.exit(db.close(con)) + on.exit(db.close(con), add = TRUE) } #check table's privilege about read and write permission @@ -446,7 +446,9 @@ db.getShowQueries <- function() { ##' @param values values to be queried in fields corresponding to colnames ##' @param con database connection object, ##' @param create logical: make a record if none found? -##' @param dates logical: update created_at and updated_at timestamps? Used only if `create` is TRUE +##' @param dates Ignored. +##' Formerly indicated whether to set created_at and updated_at timestamps +##' when `create` was TRUE, but the database now always sets them automatically ##' @return will numeric ##' @export ##' @author David LeBauer @@ -455,16 +457,14 @@ db.getShowQueries <- function() { ##' pftid <- get.id("pfts", "name", "salix", con) ##' pftid <- get.id("pfts", c("name", "modeltype_id"), c("ebifarm.salix", 1), con) ##' } -get.id <- function(table, colnames, values, con, create=FALSE, dates=FALSE){ +get.id <- function(table, colnames, values, con, create=FALSE, dates=TRUE){ values <- lapply(values, function(x) ifelse(is.character(x), shQuote(x), x)) where_clause <- paste(colnames, values , sep = " = ", collapse = " and ") query <- paste("select id from", table, "where", where_clause, ";") id <- db.query(query = query, con = con)[["id"]] if (is.null(id) && create) { colinsert <- paste0(colnames, collapse=", ") - if (dates) colinsert <- paste0(colinsert, ", created_at, updated_at") valinsert <- paste0(values, collapse=", ") - if (dates) valinsert <- paste0(valinsert, ", NOW(), NOW()") PEcAn.logger::logger.info("INSERT INTO ", table, " (", colinsert, ") VALUES (", valinsert, ")") db.query(query = paste0("INSERT INTO ", table, " (", colinsert, ") VALUES (", valinsert, ")"), con = con) id <- db.query(query, con)[["id"]] diff --git a/base/db/inst/dump.db.sh b/base/db/inst/dump.db.sh deleted file mode 100755 index dcc4644a7a5..00000000000 --- a/base/db/inst/dump.db.sh +++ /dev/null @@ -1,49 +0,0 @@ -#!/bin/bash - -# exports from betydb - -cd $(dirname $0)/.. -set -x - -# copy database and load locally -ssh ebi-forecast.igb.illinois.edu "mysqldump --lock-tables=false ZZZZ -u YYYY -pXXXX" > betydump.sql -mysql -u bety -pbety -e 'DROP DATABASE IF EXISTS betydump; CREATE DATABASE betydump' -grep -v "DEFINER" betydump.sql | mysql -f -u bety -pbety betydump - -# anonymize all accounts, set default password to illinois -mysql -u bety -pbety betydump -e 'update users set login=CONCAT("user", id), name=CONCAT("user ", id), email=CONCAT("betydb+", id, "@gmail.com"), city="Urbana, IL", country="USA", field=NULL, created_at=NOW(), updated_at=NOW(), crypted_password="df8428063fb28d75841d719e3447c3f416860bb7", salt="carya", remember_token=NULL, remember_token_expires_at=NULL, access_level=3, page_access_level=3, apikey=NULL, state_prov=NULL, postal_code=NULL;' -mysql -u bety -pbety betydump -e 'update users set login="carya", access_level=1, page_access_level=1 where id=1;' - -# remove all non checked data -mysql -u bety -pbety betydump -e 'delete from traits where checked = -1;' -mysql -u bety -pbety betydump -e 'delete from yields where checked = -1;' - -# remove all secret data -mysql -u bety -pbety betydump -e 'delete from traits where access_level < 3;' -mysql -u bety -pbety betydump -e 'delete from yields where access_level < 3;' - -# update bety -# this assumes there is an environment called dump in the database.yml file -if [ -e ../bety ]; then - (cd ../bety && rake db:migrate RAILS_ENV="dump") -elif [ -e /usr/local/bety ]; then - (cd /usr/local/bety && rake db:migrate RAILS_ENV="dump") -fi - -# dump database and copy to isda -mysqldump -u bety -pbety betydump | gzip > betydump.mysql.gz -cp betydump.mysql.gz /mnt/isda/kooper/public_html/EBI/ - -# create postgres version -mysql -u bety -pbety betydump -e 'drop view mgmtview, yieldsview;' - -echo "DROP DATABASE betydump; CREATE DATABASE betydump" | sudo -u postgres psql -taps server mysql://bety:bety@localhost/betydump?encoding=latin1 bety bety & -SERVER=$! - -sleep 10 -taps pull postgres://bety:bety@localhost/betydump http://bety:bety@localhost:5000 -kill -9 $SERVER - -sudo -u postgres pg_dump betydump | gzip > betydump.psql.gz -cp betydump.psql.gz /mnt/isda/kooper/public_html/EBI diff --git a/base/db/inst/dump.db.subset.sh b/base/db/inst/dump.db.subset.sh deleted file mode 100755 index 45d26042fef..00000000000 --- a/base/db/inst/dump.db.subset.sh +++ /dev/null @@ -1,69 +0,0 @@ -#!/bin/bash -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - -#Note: this script requires read -DB="ebi_analysis" -PFT=$1 -SPID=`mysql --raw --skip-column-names -e "select specie_id from pfts_species join pfts on pfts_species.pft_id = pfts.id where pfts.name = 'ebifarm.pavi'" ebi_analysis ` - -## if traits given in command, use, otherwise, use given list -TRAITS="('mort2', 'growth_resp_factor', 'leaf_turnover_rate', 'leaf_width', 'nonlocal_dispersal', 'fineroot2leaf', 'root_turnover_rate', 'seedling_mortality', 'stomatal_slope', 'quantum_efficiency', 'r_fract', 'root_respiration_rate', 'Vm_low_temp', 'SLA', 'Vcmax')" -COVS="('leafT', 'airT', 'canopy_layer', 'rootT')" - -IGNORE="--ignore-table=$DB.counties --ignore-table=$DB.county_boundaries --ignore-table=$DB.county_paths --ignore-table=$DB.drop_me --ignore-table=$DB.error_logs --ignore-table=$DB.formats --ignore-table=$DB.inputs --ignore-table=$DB.inputs_runs --ignore-table=$DB.inputs_variables --ignore-table=$DB.likelihoods --ignore-table=$DB.location_yields --ignore-table=$DB.managements --ignore-table=$DB.managements_treatments --ignore-table=$DB.mimetypes --ignore-table=$DB.models --ignore-table=$DB.plants --ignore-table=$DB.posteriors --ignore-table=$DB.posteriors_runs --ignore-table=$DB.runs --ignore-table=$DB.schema_migrations --ignore-table=$DB.users --ignore-table=$DB.visitors" - - -table="trait" - CONDITION="specie_id in ($SPID) and variable_id in (select id from variables where name in $TRAITS)" - mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - - -table="yield" - CONDITION="specie_id in ($SPID)" - mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -# tables linked directly to traits -for table in site specie citation cultivar treatment -do - CONDITION="id in (select ${table}_id from traits where specie_id in ($SPID) and variable_id in (select id from variables where name in $TRAITS))" - mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql -done - -table="variable" -CONDITION="name in $TRAITS or name in $COVS" -mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -# lookup and auxillary tables -table="covariate" -CONDITION="variable_id in (select id from variables where name in $COVS) and trait_id in (select id from traits where specie_id in ($SPID) and variable_id in (select id from variables where name in $TRAITS))" -mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -table="pfts_specie" -CONDITION="specie_id in ($SPID)" -mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -table="pfts_prior" -CONDITION="pft_id in (select pft_id from pfts_species where specie_id in ($SPID));" -mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -table="prior" -CONDITION="id in (select prior_id from pfts_species, pfts_priors where specie_id in ($SPID) and pfts_priors.pft_id = pfts_species.pft_id);" -mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -table="pft" -CONDITION="name in ('$PFT');" -mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -table="yield" -CONDITION="specie_id in ($SPID)" -mysqldump --where="$CONDITION" --lock-all-tables $IGNORE $DB ${table}s > ${table}s.sql - -# Acknowledgements: -# Rolando from LogicWorks: http://dba.stackexchange.com/q/4654/1580 \ No newline at end of file diff --git a/base/db/inst/import-try/93.create.try.sites.R b/base/db/inst/import-try/93.create.try.sites.R index c2fcd5614ce..026550f1edf 100644 --- a/base/db/inst/import-try/93.create.try.sites.R +++ b/base/db/inst/import-try/93.create.try.sites.R @@ -49,7 +49,7 @@ bety.site.index <- which(names(try.sites) == "bety.site.id") # f. Loop over rows... radius.query.string <- 'SELECT id, sitename, ST_Y(ST_Centroid(geometry)) AS lat, ST_X(ST_Centroid(geometry)) AS lon, ST_Distance(ST_Centroid(geometry), ST_SetSRID(ST_MakePoint(%2$f, %1$f), 4326)) as distance FROM sites WHERE ST_Distance(ST_Centroid(geometry), ST_SetSRID(ST_MakePoint(%2$f, %1$f), 4326)) <= %3$f' -insert.query.string <- "INSERT INTO sites(sitename,notes,geometry,user_id,created_at,updated_at) VALUES('%s','%s',ST_Force3D(ST_SetSRID(ST_MakePoint(%f, %f), 4326)),'%s', NOW(), NOW() ) RETURNING id;" +insert.query.string <- "INSERT INTO sites(sitename,notes,geometry,user_id) VALUES('%s','%s',ST_Force3D(ST_SetSRID(ST_MakePoint(%f, %f), 4326)),'%s' ) RETURNING id;" message("Looping over sites and adding to BETY") pb <- txtProgressBar(0, nrow(try.sites), style=3) @@ -58,7 +58,7 @@ for(r in 1:nrow(try.sites)){ site.lat <- try.sites[r, site.Latitude] site.lon <- try.sites[r, site.Longitude] search.df <- try(db.query(sprintf(radius.query.string, site.lat, site.lon, radius), con)) - if(class(search.df) == "try-error"){ + if(inherits(search.df, "try-error")){ warning("Error querying database.") next } @@ -102,4 +102,4 @@ print(try.dat[sample(1:nrow(try.dat), 20), list(ObservationID, try.site.id, bety save(try.dat, file="try.3.RData", compress=TRUE) -# TODO: In the future, change centroid to bounding box containing all sites? \ No newline at end of file +# TODO: In the future, change centroid to bounding box containing all sites? diff --git a/base/db/inst/import-try/README.md b/base/db/inst/import-try/README.md index 7ad5b00de76..50a5be718ba 100644 --- a/base/db/inst/import-try/README.md +++ b/base/db/inst/import-try/README.md @@ -79,7 +79,5 @@ With a recent-enough R version (> 3.2), we can bring in the following: date_day --> ^^ time_hour --> from measurement time time_minute --> ^^ - created_at --> NOW() - updated_at --> NOW() 2. Store ID at every time step -- match with ObsDataID of TRY? Not perfect because miss time, etc., but may help later. diff --git a/base/db/inst/mysql2psql_validation.Rmd b/base/db/inst/mysql2psql_validation.Rmd deleted file mode 100644 index bd9bd61f5db..00000000000 --- a/base/db/inst/mysql2psql_validation.Rmd +++ /dev/null @@ -1,92 +0,0 @@ -Check MySQL --> PSQL Migration -======================================================== - - -This script will compare tables before and after migration from MySQL to PSQL ([Redmine issue 1860](https://ebi-forecast.igb.illinois.edu/redmine/issues/1860)) - -Note: For more information about accessing the database, see the [PEcAn settings wiki](https://pecanproject.github.io/pecan-documentation/master/pecan-xml-configuration.html#database-access). - - -```{r} -library(PEcAn.DB) -library(RMySQL) -library(RPostgreSQL) -library(testthat) -``` - -### Create connections to MySQL and PSQL versions - -```{r} -params = list(dbname = "ebi_production_copy", - user = "bety", - password = "bety", - host = "pecandev.igb.illinois.edu") - -mysqlparams <- c(params, driver = "MySQL") -mysqlparams$dbname <- "ebi_production_copy_clean" -psqlparams <- c(params, driver = "PostgreSQL") -psqlparams$dbname <- "ebi_production_copy" - -mcon <- db.open(mysqlparams) -pcon <- db.open(psqlparams) -``` - -### Check that they have the same tables - - -```{r} -mtables <- db.query("show tables", con = mcon) -ptables <- db.query("SELECT tablename FROM pg_catalog.pg_tables where tableowner = 'bety'", con = pcon) - -expect_equivalent(mtables, ptables) - -for (t in mtables[,1]) { - if(!grepl("_", t) ){ - print(paste("testing", t)) - mtest <- db.query(paste("select * from", t, "order by id"), con=mcon) - ptest <- db.query(paste("select * from", t, "order by id"), con=pcon) - expect_equal(colnames(mtest), colnames(ptest)) - - ## test numeric cols only - num.cols <- sapply(mtest, class) %in% c("integer", "numeric") - - mnums <- mtest[,num.cols] - pnums <- ptest[,num.cols] - mnums[is.na(mnums)] <- -9999 - pnums[is.na(pnums)] <- -9999 - - expect_equivalent(mnums, pnums) - - ## test char cols - - char.cols <- sapply(ptest, class) == "character" - mchar <- mtest[, char.cols] - pchar <- ptest[, char.cols] - mchar[is.na(mchar)] <- -9999 - pchar[is.na(pchar)] <- -9999 - if(ncol(mchar) > 0 && any(!mchar == pchar)){ - - ptmp <- pchar[!mchar == pchar] - sink(tempfile()) - asciitest <- !ptmp == showNonASCII(pchar[!mchar == pchar]) - sink() - diffs <- data.frame(mysql = mchar[!mchar == pchar], - psql = pchar[!mchar == pchar]) - asciidiffs <- diffs[asciitest,] - - print(paste("this table has", sum(!mchar==pchar), - " char mismatches")) - ## we only want to print out examples where diffs are not related to - ## mysql being latin1 encoding - print("printing elements where databases differences (probably) not related to character encoding ") - if(sum(asciitest) > 0) print(t(asciidiffs)) - - } - } - - } -} -``` - - - diff --git a/base/db/man/PEcAn.DB-package.Rd b/base/db/man/PEcAn.DB-package.Rd new file mode 100644 index 00000000000..c972c6ee550 --- /dev/null +++ b/base/db/man/PEcAn.DB-package.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PEcAn.DB-package.R +\docType{package} +\name{PEcAn.DB-package} +\alias{PEcAn.DB} +\alias{PEcAn.DB-package} +\title{Database functions for PEcAn, the Predictive Ecosystem Analyzer} +\description{ +This package provides an interface between PEcAn and the BETY database. +For usage examples, please see \code{vignette("betydb_access")} +} +\author{ +\strong{Maintainer}: David LeBauer \email{dlebauer@email.arizona.edu} (\href{https://orcid.org/0000-0001-7228-053X}{ORCID}) + +Authors: +\itemize{ + \item Mike Dietze \email{dietze@bu.edu} (\href{https://orcid.org/0000-0002-2324-2518}{ORCID}) + \item Rob Kooper \email{kooper@illinois.edu} (\href{https://orcid.org/0000-0002-5781-7287}{ORCID}) + \item Shawn Serbin \email{sserbin@bnl.gov} (\href{https://orcid.org/0000-0003-4136-8971}{ORCID}) + \item Betsy Cowdery \email{ecowdery@bu.edu} (\href{https://orcid.org/0000-0002-6538-6296}{ORCID}) + \item Ankur Desai \email{desai@aos.wisc.edu} (\href{https://orcid.org/0000-0002-5226-6041}{ORCID}) + \item Istem Fer \email{istfer@bu.edu} (\href{https://orcid.org/0000-0001-8236-303X}{ORCID}) + \item Alexey Shiklomanov \email{alexey.shiklomanov@pnnl.gov} (\href{https://orcid.org/0000-0003-4022-5979}{ORCID}) + \item Tony Gardella \email{tonygard@bu.edu} (\href{https://orcid.org/0000-0003-4380-3412}{ORCID}) + \item Christopher Black \email{ckb23@psu.edu} (\href{https://orcid.org/0000-0001-8382-298X}{ORCID}) + \item Liam Burke + \item Ryan Kelly + \item Dan Wang + \item Carl Davidson + \item Xiaohui Feng + \item Shashank Singh +} + +} +\keyword{internal} diff --git a/base/db/man/PEcAn.DB.Rd b/base/db/man/PEcAn.DB.Rd deleted file mode 100644 index 954aab09135..00000000000 --- a/base/db/man/PEcAn.DB.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/zzz.R -\docType{package} -\name{PEcAn.DB} -\alias{PEcAn.DB} -\alias{PEcAn.DB-package} -\title{Database functions for PEcAn, the Predictive Ecosystem Analyzer} -\description{ -This package provides an interface between PEcAn and the BETY database. -For usage examples, please see \code{vignette("betydb_access")} -} diff --git a/base/db/man/append.covariate.Rd b/base/db/man/append.covariate.Rd index ccc4f1d33c5..f964667171e 100644 --- a/base/db/man/append.covariate.Rd +++ b/base/db/man/append.covariate.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/covariate.functions.R \name{append.covariate} \alias{append.covariate} \title{Append covariate data as a column within a table} diff --git a/base/db/man/arrhenius.scaling.traits.Rd b/base/db/man/arrhenius.scaling.traits.Rd index 2f9db05abd3..bf2494a89b0 100644 --- a/base/db/man/arrhenius.scaling.traits.Rd +++ b/base/db/man/arrhenius.scaling.traits.Rd @@ -1,11 +1,16 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/covariate.functions.R \name{arrhenius.scaling.traits} \alias{arrhenius.scaling.traits} \title{Apply Arrhenius scaling to 25 degC for temperature-dependent traits} \usage{ -arrhenius.scaling.traits(data, covariates, temp.covariates, - new.temp = 25, missing.temp = 25) +arrhenius.scaling.traits( + data, + covariates, + temp.covariates, + new.temp = 25, + missing.temp = 25 +) } \arguments{ \item{data}{data frame of data to scale, as returned by query.data()} diff --git a/base/db/man/assign.treatments.Rd b/base/db/man/assign.treatments.Rd index 9f20a925b01..30365dc8468 100644 --- a/base/db/man/assign.treatments.Rd +++ b/base/db/man/assign.treatments.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/assign.treatments.R \name{assign.treatments} \alias{assign.treatments} \title{assign.treatments} @@ -19,7 +19,7 @@ Change treatments to sequential integers Assigns all control treatments the same value, then assigns unique treatments within each site. Each site is required to have a control treatment. The algorithm (incorrectly) assumes that each site has a unique set of experimental -treatments. +treatments. This assumption is required by the data in BETTdb that does not always consistently name treatments or quantity them in the managements table. Also it avoids having the need to estimate treatment by site interactions in the meta analysis model. This model uses data in the control treatment to estimate model parameters so the impact of the assumption is minimal. } \author{ David LeBauer, Carl Davidson, Alexey Shiklomanov diff --git a/base/db/man/build_insert_query.Rd b/base/db/man/build_insert_query.Rd deleted file mode 100644 index bbfb23fcfd4..00000000000 --- a/base/db/man/build_insert_query.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/insert_table.R -\name{build_insert_query} -\alias{build_insert_query} -\title{Build query to insert R data frame into SQL table} -\usage{ -build_insert_query(values, table, .con) -} -\arguments{ -\item{values}{`data.frame` of values to write to SQL database} - -\item{table}{Name of target SQL table, as character} - -\item{.con}{[\code{DBIConnection}]:A DBI connection object obtained from \code{DBI::dbConnect()}.} -} -\description{ -Build query to insert R data frame into SQL table -} diff --git a/base/db/man/check.lists.Rd b/base/db/man/check.lists.Rd index 70fd997c9be..87c48ce198c 100644 --- a/base/db/man/check.lists.Rd +++ b/base/db/man/check.lists.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.trait.data.R +% Please edit documentation in R/check.lists.R \name{check.lists} \alias{check.lists} \title{Compares two lists} @@ -14,7 +14,7 @@ check.lists(x, y, filename = "species.csv") \item{filename}{one of "species.csv" or "cultivars.csv"} } \value{ -true if two list are the same +true if two lists are the same } \description{ Check two lists. Identical does not work since one can be loaded diff --git a/base/db/man/clone_pft.Rd b/base/db/man/clone_pft.Rd index 824f15683f7..b21629a3d39 100644 --- a/base/db/man/clone_pft.Rd +++ b/base/db/man/clone_pft.Rd @@ -21,8 +21,8 @@ ID of the newly created pft in database, creates new PFT as a side effect \description{ Creates a new pft that is a duplicate of an existing pft, including relationships with priors, species, and cultivars (if any) of the existing pft. -This function mimics the 'clone pft' button in the PFTs record view page in the -BETYdb web interface for PFTs that aggregate >=1 species, but adds the ability to +This function mimics the 'clone pft' button in the PFTs record view page in the +BETYdb web interface for PFTs that aggregate >=1 species, but adds the ability to clone the cultivar associations. } \examples{ diff --git a/base/db/man/db_merge_into.Rd b/base/db/man/db_merge_into.Rd index 20fe759e672..b4004667d8f 100644 --- a/base/db/man/db_merge_into.Rd +++ b/base/db/man/db_merge_into.Rd @@ -17,15 +17,12 @@ db_merge_into(values, table, con, by = NULL, drop = FALSE, ...) \item{drop}{logical. If `TRUE` (default), drop columns not found in SQL table.} -\item{...}{Arguments passed on to \code{insert_table} -\describe{ - \item{values}{`data.frame` of values to write to SQL database} - \item{table}{Name of target SQL table, as character} - \item{coerce_col_class}{logical, whether or not to coerce local data columns +\item{...}{ + Arguments passed on to \code{\link[=insert_table]{insert_table}} + \describe{ + \item{\code{coerce_col_class}}{logical, whether or not to coerce local data columns to SQL classes. Default = `TRUE.`} - \item{drop}{logical. If `TRUE` (default), drop columns not found in SQL table.} - \item{con}{Database connection object} -}} + }} } \value{ Data frame: Inner join of SQL table and input data frame (as unevaluated "lazy query" table) diff --git a/base/db/man/dbfile.check.Rd b/base/db/man/dbfile.check.Rd index 5149b26ed76..cb75d5cf045 100644 --- a/base/db/man/dbfile.check.Rd +++ b/base/db/man/dbfile.check.Rd @@ -5,8 +5,14 @@ \title{List files associated with a container and machine exist in `dbfiles` table} \usage{ -dbfile.check(type, container.id, con, hostname = PEcAn.remote::fqdn(), - machine.check = TRUE, return.all = FALSE) +dbfile.check( + type, + container.id, + con, + hostname = PEcAn.remote::fqdn(), + machine.check = TRUE, + return.all = FALSE +) } \arguments{ \item{type}{The type of `dbfile`, as a character. Must be either diff --git a/base/db/man/dbfile.input.check.Rd b/base/db/man/dbfile.input.check.Rd index 419dc0cdc4b..6a6016f4b5c 100644 --- a/base/db/man/dbfile.input.check.Rd +++ b/base/db/man/dbfile.input.check.Rd @@ -4,9 +4,19 @@ \alias{dbfile.input.check} \title{Check for a file in the input/dbfiles tables} \usage{ -dbfile.input.check(siteid, startdate = NULL, enddate = NULL, mimetype, - formatname, parentid = NA, con, hostname = PEcAn.remote::fqdn(), - exact.dates = FALSE, pattern = NULL, return.all = FALSE) +dbfile.input.check( + siteid, + startdate = NULL, + enddate = NULL, + mimetype, + formatname, + parentid = NA, + con, + hostname = PEcAn.remote::fqdn(), + exact.dates = FALSE, + pattern = NULL, + return.all = FALSE +) } \arguments{ \item{siteid}{the id of the site that this data is applicable to} diff --git a/base/db/man/dbfile.input.insert.Rd b/base/db/man/dbfile.input.insert.Rd index 990b3e30e29..07b3805b770 100644 --- a/base/db/man/dbfile.input.insert.Rd +++ b/base/db/man/dbfile.input.insert.Rd @@ -4,10 +4,20 @@ \alias{dbfile.input.insert} \title{Insert file into tables} \usage{ -dbfile.input.insert(in.path, in.prefix, siteid, startdate, enddate, - mimetype, formatname, parentid = NA, con, - hostname = PEcAn.remote::fqdn(), allow.conflicting.dates = FALSE, - ens = FALSE) +dbfile.input.insert( + in.path, + in.prefix, + siteid, + startdate, + enddate, + mimetype, + formatname, + parentid = NA, + con, + hostname = PEcAn.remote::fqdn(), + allow.conflicting.dates = FALSE, + ens = FALSE +) } \arguments{ \item{in.path}{path to the directory containing the file to be inserted} @@ -46,7 +56,14 @@ data to store the file } \examples{ \dontrun{ - dbfile.input.insert('trait.data.Rdata', siteid, startdate, enddate, 'application/x-RData', 'traits', dbcon) + dbfile.input.insert( + in.path = 'trait.data.Rdata', + in.prefix = siteid, + startdate = startdate, + enddate = enddate, + mimetype = 'application/x-RData', + formatname = 'traits', + con = dbcon) } } \author{ diff --git a/base/db/man/dbfile.insert.Rd b/base/db/man/dbfile.insert.Rd index ab1daa65dfb..d1400e9e707 100644 --- a/base/db/man/dbfile.insert.Rd +++ b/base/db/man/dbfile.insert.Rd @@ -4,8 +4,15 @@ \alias{dbfile.insert} \title{Insert file into tables} \usage{ -dbfile.insert(in.path, in.prefix, type, id, con, reuse = TRUE, - hostname = PEcAn.remote::fqdn()) +dbfile.insert( + in.path, + in.prefix, + type, + id, + con, + reuse = TRUE, + hostname = PEcAn.remote::fqdn() +) } \arguments{ \item{in.path}{Path to file directory} diff --git a/base/db/man/dbfile.move.Rd b/base/db/man/dbfile.move.Rd new file mode 100644 index 00000000000..9e0a2d57546 --- /dev/null +++ b/base/db/man/dbfile.move.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dbfiles.R +\name{dbfile.move} +\alias{dbfile.move} +\title{Move files to new location} +\usage{ +dbfile.move(old.dir, new.dir, file.type, siteid = NULL, register = FALSE) +} +\arguments{ +\item{old.dir}{directory with files to be moved} + +\item{new.dir}{directory where files should be moved} + +\item{file.type}{what type of files are being moved} + +\item{siteid}{needed to register files that arent already in BETY} + +\item{register}{if file isn't already in BETY, should it be registered?} +} +\value{ +print statement of how many files were moved, registered, or have symbolic links +} +\description{ +This function will move dbfiles - clim or nc - from one location +to another on the same machine and update BETY +} +\examples{ +\dontrun{ + dbfile.move( + old.dir = "/fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_site_0-676", + new.dir = '/projectnb/dietzelab/pecan.data/dbfiles/NOAA_GEFS_site_0-676' + file.type= clim, + siteid = 676, + register = TRUE + ) +} +} +\author{ +kzarada +} diff --git a/base/db/man/dbfile.posterior.check.Rd b/base/db/man/dbfile.posterior.check.Rd index 352b00f5270..71640c2d799 100644 --- a/base/db/man/dbfile.posterior.check.Rd +++ b/base/db/man/dbfile.posterior.check.Rd @@ -4,8 +4,13 @@ \alias{dbfile.posterior.check} \title{Check for a file in the input/dbfiles tables} \usage{ -dbfile.posterior.check(pft, mimetype, formatname, con, - hostname = PEcAn.remote::fqdn()) +dbfile.posterior.check( + pft, + mimetype, + formatname, + con, + hostname = PEcAn.remote::fqdn() +) } \arguments{ \item{pft}{the name of the pft that this data is applicable to} diff --git a/base/db/man/dbfile.posterior.insert.Rd b/base/db/man/dbfile.posterior.insert.Rd index 6e7e3139ae0..e6011f0d949 100644 --- a/base/db/man/dbfile.posterior.insert.Rd +++ b/base/db/man/dbfile.posterior.insert.Rd @@ -4,8 +4,14 @@ \alias{dbfile.posterior.insert} \title{Insert file into tables} \usage{ -dbfile.posterior.insert(filename, pft, mimetype, formatname, con, - hostname = PEcAn.remote::fqdn()) +dbfile.posterior.insert( + filename, + pft, + mimetype, + formatname, + con, + hostname = PEcAn.remote::fqdn() +) } \arguments{ \item{filename}{the name of the file to be inserted} diff --git a/base/db/man/derive.trait.Rd b/base/db/man/derive.trait.Rd index f9eff2630e7..1db301d3e1a 100644 --- a/base/db/man/derive.trait.Rd +++ b/base/db/man/derive.trait.Rd @@ -1,11 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/derive.trait.R \name{derive.trait} \alias{derive.trait} \title{Performs an arithmetic function, FUN, over a series of traits and returns the result as a derived trait.} \usage{ -derive.trait(FUN, ..., input = list(...), var.name = NA, - sample.size = 10^6) +derive.trait(FUN, ..., input = list(...), var.name = NA, sample.size = 10^6) } \arguments{ \item{FUN}{arithmetic function} diff --git a/base/db/man/derive.traits.Rd b/base/db/man/derive.traits.Rd index 578018a5a8d..c9b521a127e 100644 --- a/base/db/man/derive.traits.Rd +++ b/base/db/man/derive.traits.Rd @@ -1,12 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/derive.traits.R \name{derive.traits} \alias{derive.traits} \title{Performs an arithmetic function, FUN, over a series of traits and returns the result as a derived trait.} \usage{ -derive.traits(FUN, ..., input = list(...), +derive.traits( + FUN, + ..., + input = list(...), match.columns = c("citation_id", "site_id", "specie_id"), - var.name = NA, sample.size = 10^6) + var.name = NA, + sample.size = 10^6 +) } \arguments{ \item{FUN}{arithmetic function} diff --git a/base/db/man/fetch.stats2se.Rd b/base/db/man/fetch.stats2se.Rd index 5878ac6a46f..481bfdd1bee 100644 --- a/base/db/man/fetch.stats2se.Rd +++ b/base/db/man/fetch.stats2se.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/fetch.stats2se.R \name{fetch.stats2se} \alias{fetch.stats2se} \title{Fetch data and transform stats to SE} diff --git a/base/db/man/filter_sunleaf_traits.Rd b/base/db/man/filter_sunleaf_traits.Rd index 30a35d494e6..0e47497f451 100644 --- a/base/db/man/filter_sunleaf_traits.Rd +++ b/base/db/man/filter_sunleaf_traits.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/covariate.functions.R \name{filter_sunleaf_traits} \alias{filter_sunleaf_traits} \alias{filter.sunleaf.traits} diff --git a/base/db/man/get.id.Rd b/base/db/man/get.id.Rd index 9adb4a32a6f..2bdff9a0144 100644 --- a/base/db/man/get.id.Rd +++ b/base/db/man/get.id.Rd @@ -4,7 +4,7 @@ \alias{get.id} \title{get.id} \usage{ -get.id(table, colnames, values, con, create = FALSE, dates = FALSE) +get.id(table, colnames, values, con, create = FALSE, dates = TRUE) } \arguments{ \item{table}{name of table} @@ -17,7 +17,9 @@ get.id(table, colnames, values, con, create = FALSE, dates = FALSE) \item{create}{logical: make a record if none found?} -\item{dates}{logical: update created_at and updated_at timestamps? Used only if `create` is TRUE} +\item{dates}{Ignored. +Formerly indicated whether to set created_at and updated_at timestamps +when `create` was TRUE, but the database now always sets them automatically} } \value{ will numeric diff --git a/base/db/man/get.trait.data.Rd b/base/db/man/get.trait.data.Rd index ce8f0cffccd..d4c1b1a069f 100644 --- a/base/db/man/get.trait.data.Rd +++ b/base/db/man/get.trait.data.Rd @@ -4,8 +4,14 @@ \alias{get.trait.data} \title{Get trait data from the database.} \usage{ -get.trait.data(pfts, modeltype, dbfiles, database, forceupdate, - trait.names = NULL) +get.trait.data( + pfts, + modeltype, + dbfiles, + database, + forceupdate, + trait.names = NULL +) } \arguments{ \item{pfts}{the list of pfts to get traits for} diff --git a/base/db/man/get.trait.data.pft.Rd b/base/db/man/get.trait.data.pft.Rd index 5ad8cce27ee..71635dea4f4 100644 --- a/base/db/man/get.trait.data.pft.Rd +++ b/base/db/man/get.trait.data.pft.Rd @@ -1,11 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.trait.data.R +% Please edit documentation in R/get.trait.data.pft.R \name{get.trait.data.pft} \alias{get.trait.data.pft} \title{Get trait data from the database for a single PFT} \usage{ -get.trait.data.pft(pft, modeltype, dbfiles, dbcon, trait.names, - forceupdate = FALSE) +get.trait.data.pft( + pft, + modeltype, + dbfiles, + dbcon, + trait.names, + forceupdate = FALSE +) } \arguments{ \item{pft}{list of settings for the pft whose traits to retrieve. See details} diff --git a/base/db/man/get_postgres_envvars.Rd b/base/db/man/get_postgres_envvars.Rd new file mode 100644 index 00000000000..c802444d6b4 --- /dev/null +++ b/base/db/man/get_postgres_envvars.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_postgres_envvars.R +\name{get_postgres_envvars} +\alias{get_postgres_envvars} +\title{Look up Postgres connection parameters from environment variables} +\usage{ +get_postgres_envvars(...) +} +\arguments{ +\item{...}{defaults for parameters not found in the environment, +in `name = value` form} +} +\value{ +list of connection parameters suitable for passing on to `db.open` +} +\description{ +Retrieves database connection parameters stored in any of the + environment variables known by Postgres, + using defaults from `...` for parameters not set in the environment. + In a standard PEcAn installation only a few of these parameters + will ever be set, but we check all of them anyway in case you need to do + anything unusual. +} +\details{ +The list of environment variables we check is taken from the + [Postgres 12 manual](https://postgresql.org/docs/12/libpq-envars.html), + but it should apply to older Postgres versions as well. + Note that this function only looks for environment variables that control + connection parameters; it does not retrieve any of the variables related to + per-session behavior (e.g. PGTZ, PGSYSCONFDIR). +} +\examples{ + host <- Sys.getenv("PGHOST") # to restore environment after demo + + Sys.unsetenv("PGHOST") + get_postgres_envvars()$host # NULL + get_postgres_envvars(host = "default", port = 5432)$host # "default" + # defaults are ignored for a variable that exists + Sys.setenv(PGHOST = "localhost") + get_postgres_envvars()$host # "localhost" + get_postgres_envvars(host = "postgres")$host # still "localhost" + + # To override a set variable, edit the returned list before using it + con_parms <- get_postgres_envvars() + con_parms$host # "localhost" + con_parms$host <- "postgres" + # db.open(con_parms) + + Sys.setenv(PGHOST = host) +} diff --git a/base/db/man/insert.format.vars.Rd b/base/db/man/insert.format.vars.Rd index c774b037231..e9adf10a81a 100644 --- a/base/db/man/insert.format.vars.Rd +++ b/base/db/man/insert.format.vars.Rd @@ -4,9 +4,16 @@ \alias{insert.format.vars} \title{Insert Format and Format-Variable Records} \usage{ -insert.format.vars(con, format_name, mimetype_id, notes = NULL, - header = TRUE, skip = 0, formats_variables = NULL, - suppress = TRUE) +insert.format.vars( + con, + format_name, + mimetype_id, + notes = NULL, + header = TRUE, + skip = 0, + formats_variables = NULL, + suppress = TRUE +) } \arguments{ \item{con}{SQL connection to BETYdb} @@ -32,10 +39,10 @@ format_id Insert Format and Format-Variable Records } \details{ -The formats_variables argument must be a 'tibble' and be structured in a specific format so that the SQL query functions properly. All arguments should be passed as vectors so that each entry will correspond with a specific row. All empty values should be specified as NA. +The formats_variables argument must be a 'tibble' and be structured in a specific format so that the SQL query functions properly. All arguments should be passed as vectors so that each entry will correspond with a specific row. All empty values should be specified as NA. \describe{ \item{variable_id}{(Required) Vector of integers.} -\item{name}{(Optional) Vector of character strings. The variable name in the imported data need only be specified if it differs from the BETY variable name.} +\item{name}{(Optional) Vector of character strings. The variable name in the imported data need only be specified if it differs from the BETY variable name.} \item{unit}{(Optional) Vector of type character string. Should be in a format parseable by the udunits library and need only be secified if the units of the data in the file differ from the BETY standard.} \item{storage_type}{(Optional) Vector of character strings. Storage type need only be specified if the variable is stored in a format other than would be expected (e.g. if numeric values are stored as quoted character strings). Additionally, storage_type stores POSIX codes that are used to store any time variables (e.g. a column with a 4-digit year would be \%Y). See also \code{[base::strptime]}} \item{column_number}{Vector of integers that list the column numbers associated with variables in a dataset. Required for text files that lack headers.}} @@ -45,13 +52,20 @@ The formats_variables argument must be a 'tibble' and be structured in a specifi bety <- PEcAn.DB::betyConnect() formats_variables_tibble <- tibble::tibble( - variable_id = c(411, 135, 382), - name = c("NPP", NA, "YEAR"), - unit = c("g C m-2 yr-1", NA, NA), - storage_type = c(NA, NA, "\%Y"), - column_number = c(2, NA, 4), - ) - insert.format.vars(con = bety$con, format_name = "LTER-HFR-103", mimetype_id = 1090, notes = "NPP from Harvard Forest.", header = FALSE, skip = 0, formats_variables = formats_variables_tibble) + variable_id = c(411, 135, 382), + name = c("NPP", NA, "YEAR"), + unit = c("g C m-2 yr-1", NA, NA), + storage_type = c(NA, NA, "\%Y"), + column_number = c(2, NA, 4)) + +insert.format.vars( + con = bety$con, + format_name = "LTER-HFR-103", + mimetype_id = 1090, + notes = "NPP from Harvard Forest.", + header = FALSE, + skip = 0, + formats_variables = formats_variables_tibble) } } \author{ diff --git a/base/db/man/query.covariates.Rd b/base/db/man/query.covariates.Rd index fb7167c526b..ac2081a91ae 100644 --- a/base/db/man/query.covariates.Rd +++ b/base/db/man/query.covariates.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/covariate.functions.R \name{query.covariates} \alias{query.covariates} \title{Queries covariates from database for a given vector of trait id's} diff --git a/base/db/man/query.data.Rd b/base/db/man/query.data.Rd index e8bd1dfe0c8..cc7e6c9cdb9 100644 --- a/base/db/man/query.data.Rd +++ b/base/db/man/query.data.Rd @@ -1,23 +1,29 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/query.data.R \name{query.data} \alias{query.data} \title{Query data and transform stats to SE by calling \code{\link{fetch.stats2se}};} \usage{ -query.data(trait, spstr, - extra.columns = "ST_X(ST_CENTROID(sites.geometry)) AS lon, ST_Y(ST_CENTROID(sites.geometry)) AS lat, ", - con = NULL, store.unconverted = FALSE, ids_are_cultivars = FALSE, - ...) +query.data( + trait, + spstr, + con, + extra.columns = paste("ST_X(ST_CENTROID(sites.geometry)) AS lon,", + "ST_Y(ST_CENTROID(sites.geometry)) AS lat, "), + store.unconverted = FALSE, + ids_are_cultivars = FALSE, + ... +) } \arguments{ \item{trait}{trait to query from the database} \item{spstr}{IDs of species to query from, as a single comma-separated string} -\item{extra.columns}{other query terms to pass in. If unspecified, retrieves latitude and longitude} - \item{con}{database connection} +\item{extra.columns}{other query terms to pass in. If unspecified, retrieves latitude and longitude} + \item{ids_are_cultivars}{if TRUE, ids is a vector of cultivar IDs, otherwise they are species IDs} \item{...}{extra arguments} diff --git a/base/db/man/query.trait.data.Rd b/base/db/man/query.trait.data.Rd index e0488927b69..f179f37f2e4 100644 --- a/base/db/man/query.trait.data.Rd +++ b/base/db/man/query.trait.data.Rd @@ -4,8 +4,14 @@ \alias{query.trait.data} \title{Extract trait data from database} \usage{ -query.trait.data(trait, spstr, con = NULL, update.check.only = FALSE, - ids_are_cultivars = FALSE, ...) +query.trait.data( + trait, + spstr, + con = NULL, + update.check.only = FALSE, + ids_are_cultivars = FALSE, + ... +) } \arguments{ \item{trait}{is the trait name used in the database, stored in variables.name} diff --git a/base/db/man/query.traits.Rd b/base/db/man/query.traits.Rd index 80ce1153d00..fda72bf2e21 100644 --- a/base/db/man/query.traits.Rd +++ b/base/db/man/query.traits.Rd @@ -4,8 +4,13 @@ \alias{query.traits} \title{Query trait data} \usage{ -query.traits(ids, priors, con = NULL, update.check.only = FALSE, - ids_are_cultivars = FALSE) +query.traits( + ids, + priors, + con, + update.check.only = FALSE, + ids_are_cultivars = FALSE +) } \arguments{ \item{ids}{vector of species or cultivar id's from trait database} @@ -26,10 +31,11 @@ Query available trait data associated with a given pft and a list of traits } \examples{ \dontrun{ +con <- db.open(your_settings_here) species <- query.pft_species('ebifarm.c4crop') spstr <- vecpaste(species$id) trvec <- c('leafN', 'SLA') -trait.data <- query.traits(spstr, trvec) +trait.data <- query.traits(spstr, trvec, con) } } \seealso{ diff --git a/base/db/man/query.yields.Rd b/base/db/man/query.yields.Rd index 66e565205f7..1d5d224cd4f 100644 --- a/base/db/man/query.yields.Rd +++ b/base/db/man/query.yields.Rd @@ -1,11 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/query.yields.R \name{query.yields} \alias{query.yields} \title{Query yield data and transform stats to SE by calling \code{\link{fetch.stats2se}};} \usage{ -query.yields(trait = "yield", spstr, extra.columns = "", con = NULL, - ids_are_cultivars = FALSE, ...) +query.yields( + trait = "yield", + spstr, + extra.columns = "", + con = NULL, + ids_are_cultivars = FALSE, + ... +) } \arguments{ \item{trait}{yield trait to query} diff --git a/base/db/man/query_pfts.Rd b/base/db/man/query_pfts.Rd index 3b90fd42ae8..34f0e7c1c93 100644 --- a/base/db/man/query_pfts.Rd +++ b/base/db/man/query_pfts.Rd @@ -9,9 +9,11 @@ query_pfts(dbcon, pft_names, modeltype = NULL, strict = FALSE) \arguments{ \item{dbcon}{Database connection object} -\item{pft_names}{Character vector of PFT names} +\item{pft_names}{character vector of PFT names} -\item{modeltype}{} +\item{modeltype}{character. +If specified, only returns PFTs matching this modeltype. +If NULL, considers all modeltypes.} } \value{ `data.frame` containing PFT ID (`id`), type (`pft_type`), diff --git a/base/db/man/query_priors.Rd b/base/db/man/query_priors.Rd index 65b6e400413..10677150f7d 100644 --- a/base/db/man/query_priors.Rd +++ b/base/db/man/query_priors.Rd @@ -4,8 +4,14 @@ \alias{query_priors} \title{Query priors using prepared statements} \usage{ -query_priors(pft_names = NULL, traits = NULL, pft_ids = NULL, - expand = TRUE, strict = FALSE, ...) +query_priors( + pft_names = NULL, + traits = NULL, + pft_ids = NULL, + expand = TRUE, + strict = FALSE, + ... +) } \arguments{ \item{pft_names}{Character vector of PFT names (`name` column of diff --git a/base/db/man/reexports.Rd b/base/db/man/reexports.Rd index 4e4e1686970..df8fafc42c2 100644 --- a/base/db/man/reexports.Rd +++ b/base/db/man/reexports.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/zzz.R +% Please edit documentation in R/PEcAn.DB-package.R \docType{import} \name{reexports} \alias{reexports} diff --git a/base/db/man/search_references.Rd b/base/db/man/search_references.Rd index e27002b250c..071f2b4fe32 100644 --- a/base/db/man/search_references.Rd +++ b/base/db/man/search_references.Rd @@ -9,12 +9,13 @@ search_references(queries, ...) \arguments{ \item{queries}{Character vector of queries} -\item{...}{Arguments passed on to \code{search_reference_single} -\describe{ - \item{query}{Citation string (length 1) to search for DOI} - \item{min_score}{Minimum match score. Default (85) is fairly strict.} - \item{limit}{Number of results to return} -}} +\item{...}{ + Arguments passed on to \code{\link[=search_reference_single]{search_reference_single}} + \describe{ + \item{\code{query}}{Citation string (length 1) to search for DOI} + \item{\code{min_score}}{Minimum match score. Default (85) is fairly strict.} + \item{\code{limit}}{Number of results to return} + }} } \value{ `data.frame` containing crossref information converted to match bety citations table. diff --git a/base/db/man/symmetric_setdiff.Rd b/base/db/man/symmetric_setdiff.Rd index 920a8007d8c..572a7f20522 100644 --- a/base/db/man/symmetric_setdiff.Rd +++ b/base/db/man/symmetric_setdiff.Rd @@ -1,11 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.trait.data.R +% Please edit documentation in R/symmetric_setdiff.R \name{symmetric_setdiff} \alias{symmetric_setdiff} \title{Symmetric set difference of two data frames} \usage{ -symmetric_setdiff(x, y, xname = "x", yname = "y", namecol = "source", - simplify_types = TRUE) +symmetric_setdiff( + x, + y, + xname = "x", + yname = "y", + namecol = "source", + simplify_types = TRUE +) } \arguments{ \item{x, y}{`data.frame`s to compare} diff --git a/base/db/man/take.samples.Rd b/base/db/man/take.samples.Rd index 94427ab36fb..0c8f693365f 100644 --- a/base/db/man/take.samples.Rd +++ b/base/db/man/take.samples.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/take.samples.R \name{take.samples} \alias{take.samples} \title{Sample from normal distribution, given summary stats} @@ -20,7 +20,7 @@ sample from normal distribution, given summary stats \examples{ ## return the mean when stat = NA take.samples(summary = data.frame(mean = 10, stat = NA)) -## return vector of length \\code{sample.size} from N(mean,stat) +## return vector of length \code{sample.size} from N(mean,stat) take.samples(summary = data.frame(mean = 10, stat = 10), sample.size = 10) } diff --git a/base/db/tests/Rcheck_reference.log b/base/db/tests/Rcheck_reference.log new file mode 100644 index 00000000000..bc7160b8833 --- /dev/null +++ b/base/db/tests/Rcheck_reference.log @@ -0,0 +1,130 @@ +* using log directory ‘/tmp/RtmpcCXxhc/PEcAn.DB.Rcheck’ +* using R version 4.0.2 (2020-06-22) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-manual --as-cran’ +* checking for file ‘PEcAn.DB/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.DB’ version ‘1.7.1’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.DB’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking for future file timestamps ... OK +* checking DESCRIPTION meta-information ... OK +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... OK +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE + + +db.exists: no visible binding for '<<-' assignment to ‘user.permission’ +db.exists: no visible binding for global variable ‘user.permission’ + +load_data_single_run: no visible global function definition for + ‘read.output’ +load_data_single_run: no visible binding for global variable ‘var_name’ +load_data_single_run: no visible binding for global variable ‘vals’ +match_dbcols: no visible global function definition for ‘head’ +match_dbcols: no visible binding for global variable ‘.’ +match_dbcols: no visible binding for global variable ‘as’ + +query.priors: no visible binding for global variable ‘settings’ + + + +Undefined global functions or variables: + . as author author_family author_given citation_id collect + container_id container_type created_at cultivar_id ensemble_id folder + genus greenhouse head id issued machine_id n name name.cv name.mt + pft_id pft_type posix read.output run_id scientificname score + settings site_id specie_id species stat storage_type sync_host_id + trait trt_id updated_at user.permission vals var_name variable_id + workflow_id +Consider adding + importFrom("methods", "as") + importFrom("utils", "head") +to your NAMESPACE file (and ensure that your DESCRIPTION Imports field +contains 'methods'). +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'get_workflow_ids' + ‘all.ids’ + +Undocumented arguments in documentation object 'ncdays2date' + ‘time’ ‘unit’ + +Undocumented arguments in documentation object 'query.data' + ‘store.unconverted’ + +Undocumented arguments in documentation object 'query.file.path' + ‘input.id’ +Documented arguments not in \usage in documentation object 'query.file.path': + ‘input_id’ + +Undocumented arguments in documentation object 'query.format.vars' + ‘input.id’ +Documented arguments not in \usage in documentation object 'query.format.vars': + ‘input_id’ + +Undocumented arguments in documentation object 'query.site' + ‘site.id’ +Documented arguments not in \usage in documentation object 'query.site': + ‘site_id’ + +Undocumented arguments in documentation object 'query.trait.data' + ‘con’ ‘update.check.only’ ‘...’ + +Undocumented arguments in documentation object 'query_pfts' + ‘strict’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking files in ‘vignettes’ ... WARNING +Files in the 'vignettes' directory but no files in 'inst/doc': + ‘betydb_access.Rmd’, ‘create_sites.geometry.Rmd’ +Package has no Sweave vignette sources and no VignetteBuilder field. +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... + Running ‘testthat.R’ + OK +* checking for non-standard things in the check directory ... OK +* checking for detritus in the temp directory ... OK +* DONE + +Status: 2 WARNINGs, 2 NOTEs +See + ‘/tmp/RtmpcCXxhc/PEcAn.DB.Rcheck/00check.log’ +for details. diff --git a/base/db/tests/testthat.R b/base/db/tests/testthat.R index b7d479f0d77..d2515cd48b8 100644 --- a/base/db/tests/testthat.R +++ b/base/db/tests/testthat.R @@ -10,7 +10,12 @@ library(testthat) library(PEcAn.DB) library(RPostgreSQL) -dbparms <- list(host = "localhost", driver = "PostgreSQL", user = "bety", dbname = "bety", password = "bety") +dbparms <- get_postgres_envvars( + host = "localhost", + driver = "PostgreSQL", + user = "bety", + dbname = "bety", + password = "bety") if(db.exists(dbparms)){ con <- db.open(dbparms) diff --git a/base/db/tests/testthat/helper-db-setup.R b/base/db/tests/testthat/helper-db-setup.R index 8cb04d7aa36..0ca845db609 100644 --- a/base/db/tests/testthat/helper-db-setup.R +++ b/base/db/tests/testthat/helper-db-setup.R @@ -3,29 +3,42 @@ get_db_params <- function() { # Set these options by adding something like the following to # `~/.Rprofile`: # ```r - # options(pecan.db.params = list(driver = "PostgreSQL", + # options(pecan.db.params = list(driver = "Postgres", # dbname = "bety", # user = "bety", # password = "bety", # host = "localhost", # port = 5432)) # ``` + # OR by setting Postgres environment parameters in your shell: + # ``` + # export PGHOST=localhost + # export PGUSER=bety + # [etc] + # ``` option_params <- getOption("pecan.db.params") # Check if running on continuous integration (CI) # If yes, skip this test - is_ci <- Sys.getenv('CI') != '' + is_ci <- Sys.getenv("CI") != "" if (!is.null(option_params)) { return(option_params) } else if (is_ci) { - return(list(host = "localhost", user = "bety", password = "bety", - driver = "Postgres")) + return(get_postgres_envvars( + host = "localhost", + user = "bety", + password = "bety", + driver = "Postgres")) } else { if (PEcAn.remote::fqdn() == "pecan2.bu.edu") { return(list(host = "psql-pecan.bu.edu", driver = "PostgreSQL", dbname = "bety", user = "bety", password = "bety")) } else { - return(list(host = "localhost", driver = "PostgreSQL", - user = "bety", dbname = "bety", password = "bety")) + return(get_postgres_envvars( + host = "localhost", + driver = "Postgres", + user = "bety", + dbname = "bety", + password = "bety")) } } } diff --git a/base/db/tests/testthat/test-query.traits.R b/base/db/tests/testthat/test-query.traits.R index ea4b77e8ff6..353d64aa130 100644 --- a/base/db/tests/testthat/test-query.traits.R +++ b/base/db/tests/testthat/test-query.traits.R @@ -59,6 +59,12 @@ test_that("returns empty list if no trait data found", { expect_equal(query.traits(ids=1, priors="not_a_trait", con=con), list()) }) +test_that("connection is required", { + expect_error( + query.traits(ids = 938, priors = "SLA"), + '"con" is missing') +}) + # Test `query_traits` function, which has a slightly different API test_that("query_traits works as expected", { # NOTE: Capture output used here to avoid polluting the testthat diff --git a/base/db/tests/testthat/test.symmetric-setdiff.R b/base/db/tests/testthat/test.symmetric-setdiff.R index eaf1bf961e0..ada630cfb35 100644 --- a/base/db/tests/testthat/test.symmetric-setdiff.R +++ b/base/db/tests/testthat/test.symmetric-setdiff.R @@ -14,3 +14,26 @@ test_that("Symmetric setdiff works", { expect_match(msg, "Detected at least one `integer64` column") expect_equal(nrow(xydiff), 0) }) + +test_that("Unequal dfs compare unequal", { + expect_error( + symmetric_setdiff(data.frame(a = 1L), data.frame(b = 1L)), + "Cols in x but not y") + d <- symmetric_setdiff(data.frame(a = 1:3L), data.frame(a = 1:4L)) + expect_length(d$a, 1L) + expect_equal(d$a, 4L) + expect_equal(d$source, "y") + +}) + +test_that("symmetric inputs give same output", { + x <- data.frame(a=1:3L, b=LETTERS[1:3L]) + y <- data.frame(a=2:5L, b=LETTERS[2:5L]) + xy <- symmetric_setdiff(x, y) + yx <- symmetric_setdiff(y, x) + purrr::walk2(xy, yx, expect_setequal) + expect_equal( + # left input aways labeled x -> xy$source is inverse of yx$source + dplyr::select(xy, -source) %>% dplyr::arrange(a), + dplyr::select(yx, -source) %>% dplyr::arrange(a)) +}) diff --git a/base/logger/.Rbuildignore b/base/logger/.Rbuildignore new file mode 100644 index 00000000000..23d05874bd7 --- /dev/null +++ b/base/logger/.Rbuildignore @@ -0,0 +1 @@ +cran-comments.md diff --git a/base/logger/DESCRIPTION b/base/logger/DESCRIPTION index 62ee18c7062..2a6f19a31ee 100644 --- a/base/logger/DESCRIPTION +++ b/base/logger/DESCRIPTION @@ -1,15 +1,29 @@ Package: PEcAn.logger -Title: Logger functions for PEcAn -Version: 1.7.1 -Date: 2019-09-05 -Authors@R: c(person("Rob","Kooper"), - person("Alexey", "Shiklomanov")) -Author: Rob Kooper, Alexey Shiklomanov -Maintainer: Alexey Shiklomanov -Description: Special logger functions for tracking execution status and the environment. +Title: Logger Functions for 'PEcAn' +Version: 1.8.0 +Date: 2021-07-27 +Authors@R: c(person("Rob", "Kooper", role = c("aut", "cre"), + email = "kooper@illinois.edu"), + person("Alexey", "Shiklomanov", role = c("aut"), + email = "ashiklom@bu.edu"), + person("Shashank", "Singh", role = c("aut"), + email = "shashanksingh819@gmail.com"), + person("Chris", "Black", role = c("ctb")), + person("University of Illinois, NCSA", role = c("cph"))) +Description: Convenience functions for logging outputs from 'PEcAn', + the Predictive Ecosystem Analyzer (LeBauer et al. 2017) + . Enables the user to set what level of messages are + printed, as well as whether these messages are written to the console, + a file, or both. It also allows control over whether severe errors should + stop execution of the 'PEcAn' workflow; this allows strictness when debugging + and lenience when running large batches of simulations that should not be + terminated by errors in individual models. It is loosely based on + the 'log4j' package. +BugReports: https://github.com/PecanProject/pecan/issues +URL: https://pecanproject.github.io/ +Imports: utils Suggests: testthat -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Encoding: UTF-8 -LazyData: true -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 Roxygen: list(markdown = TRUE) diff --git a/base/logger/NEWS.md b/base/logger/NEWS.md new file mode 100644 index 00000000000..c83ce890025 --- /dev/null +++ b/base/logger/NEWS.md @@ -0,0 +1,9 @@ +# PEcAn.logger 1.8.0 +## Fixed + +* Logger calls no longer create a stray `dump.log` object in the global environment + +#PEcAn.logger 1.7.1 + +* All changes in 1.7.1 and earlier were recorded in a single file for all of the PEcAn packages; please see +https://github.com/PecanProject/pecan/blob/v1.7.1/CHANGELOG.md for details. diff --git a/base/logger/R/logger.R b/base/logger/R/logger.R index 9feee614b11..d81ece9a970 100644 --- a/base/logger/R/logger.R +++ b/base/logger/R/logger.R @@ -88,9 +88,9 @@ logger.error <- function(msg, ...) { ##' Prints an severe message and stops execution. ##' ##' This function will print a message and stop execution of the code. This -##' should only be used if the application should terminate. +##' should only be used if the application should terminate. ##' -##' set \code{\link{logger.setQuitOnSevere(FALSE)}}. To avoid terminating +##' set \code{\link{logger.setQuitOnSevere}(FALSE)} to avoid terminating ##' the session. This is set by default to TRUE if interactive or running ##' inside Rstudio. ##' @@ -140,11 +140,10 @@ logger.severe <- function(msg, ..., wrap = TRUE) { ##' } logger.message <- function(level, msg, ..., wrap = TRUE) { if (logger.getLevelNumber(level) >= .utils.logger$level) { - dump.frames(dumpto = "dump.log") - calls <- names(dump.log) + calls <- utils::limitedLabels(sys.calls()) calls <- calls[!grepl("^(#[0-9]+: )?(PEcAn\\.logger::)?logger", calls)] calls <- calls[!grepl("(severe|error|warn|info|debug)ifnot", calls)] - func <- sub("\\(.*", "", tail(calls, 1)) + func <- sub("\\(.*", "", utils::tail(calls, 1)) if (length(func) == 0) { func <- "console" } @@ -191,18 +190,15 @@ logger.setLevel <- function(level) { } # logger.setLevel -##' Returns numeric value for string -##' -##' Given the string representation this will return the numeric value -##' ALL = 0 -##' DEBUG = 10 -##' INFO = 20 -##' WARN = 30 -##' ERROR = 40 -##' ALL = 99 -##' -##' @return level the level of the message -##' @author Rob Kooper +## Given the string representation this will return the numeric value +## DEBUG = 10 +## INFO = 20 +## WARN = 30 +## ERROR = 40 +## ALL = 99 +## +##@return level the level of the message +##@author Rob Kooper logger.getLevelNumber <- function(level) { if (toupper(level) == "ALL") { return(0) diff --git a/base/logger/R/logifnot.R b/base/logger/R/logifnot.R index b368728ce5a..13faa7d084b 100644 --- a/base/logger/R/logifnot.R +++ b/base/logger/R/logifnot.R @@ -1,14 +1,14 @@ #' Logger message if conditions are not met #' -#' Similar to [base::stopifnot], but allows you to use a custom message and +#' Similar to [base::stopifnot], but allows you to use a custom message and #' logger level. If all conditions are `TRUE`, silently exit. #' -#' Conditions can be vectorized, or can return non-logical values.The -#' underlying function automatically applies `isTRUE(all(.))` to the +#' Conditions can be vectorized, or can return non-logical values.The +#' underlying function automatically applies `isTRUE(all(.))` to the #' conditions. #' #' @param msg Logger message to write, as a single character string. -#' @param ... Conditions to evaluate +#' @param ... Conditions to evaluate #' @return Invisibly, `TRUE` if conditions are met, `FALSE` otherwise #' @examples #' a <- 1:5 @@ -18,7 +18,9 @@ #' warnifnot("I would prefer it if you used lists.", is.list(a), is.list(b)) #' errorifnot("You should definitely use lists.", is.list(a), is.list(b)) #' try({ -#' severeifnot("I absolutely cannot deal with the fact that something is not a list.", is.list(a), is.list(b)) +#' severeifnot("I cannot deal with the fact that something is not a list.", +#' is.list(a), +#' is.list(b)) #' }) #' @export severeifnot <- function(msg, ...) { @@ -73,14 +75,14 @@ debugifnot <- function(msg, ...) { } } -#' Check a list of conditions +# Check a list of conditions check_conditions <- function(...) { dots <- list(...) conditions <- vapply(dots, is_definitely_true, logical(1)) all(conditions) } -#' Robust logical check +# Robust logical check is_definitely_true <- function(x) { if (is.null(x) || length(x) == 0 || !is.logical(x)) { return(FALSE) diff --git a/base/logger/R/print2string.R b/base/logger/R/print2string.R index 8eadea51dd3..67089ec6f8c 100644 --- a/base/logger/R/print2string.R +++ b/base/logger/R/print2string.R @@ -17,6 +17,6 @@ #' logger.debug("Current status:\n", print2string(df, row.names = FALSE), wrap = FALSE) #' @export print2string <- function(x, ...) { - cout <- capture.output(print(x, ...)) + cout <- utils::capture.output(print(x, ...)) paste(cout, collapse = "\n") } diff --git a/base/logger/cran-comments.md b/base/logger/cran-comments.md new file mode 100644 index 00000000000..b47a62c78d2 --- /dev/null +++ b/base/logger/cran-comments.md @@ -0,0 +1,21 @@ +## Test environments +* local OS X install, R 4.0.2 +* Ubuntu Linux 20.04.2 LTS (on github), R 4.0.3 +* Ubuntu Linux 20.04.1 LTS (on R-hub), R-release, GCC +* Fedora Linux (on R-hub), R-devel, clang, gfortran +* Windows Server 2008 R2 SP1 (on R-hub), R-devel, 32/64 bit + +## R CMD check results +There were no ERRORs or WARNINGs. + +There are 2 NOTES: + +This is a new submission, which is one of the two notes. + +Possibly mis-spelled words in DESCRIPTION: +- LeBauer +- et al +- workflow + +LeBauer is the last name of one of the authors, the other words are +common words used. diff --git a/base/logger/man/check_conditions.Rd b/base/logger/man/check_conditions.Rd deleted file mode 100644 index 4ef381d29f6..00000000000 --- a/base/logger/man/check_conditions.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logifnot.R -\name{check_conditions} -\alias{check_conditions} -\title{Check a list of conditions} -\usage{ -check_conditions(...) -} -\description{ -Check a list of conditions -} diff --git a/base/logger/man/is_definitely_true.Rd b/base/logger/man/is_definitely_true.Rd deleted file mode 100644 index 4e060c0879c..00000000000 --- a/base/logger/man/is_definitely_true.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logifnot.R -\name{is_definitely_true} -\alias{is_definitely_true} -\title{Robust logical check} -\usage{ -is_definitely_true(x) -} -\description{ -Robust logical check -} diff --git a/base/logger/man/logger.getLevelNumber.Rd b/base/logger/man/logger.getLevelNumber.Rd deleted file mode 100644 index e3f4b0a3a9d..00000000000 --- a/base/logger/man/logger.getLevelNumber.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logger.R -\name{logger.getLevelNumber} -\alias{logger.getLevelNumber} -\title{Returns numeric value for string} -\usage{ -logger.getLevelNumber(level) -} -\value{ -level the level of the message -} -\description{ -Given the string representation this will return the numeric value -ALL = 0 -DEBUG = 10 -INFO = 20 -WARN = 30 -ERROR = 40 -ALL = 99 -} -\author{ -Rob Kooper -} diff --git a/base/logger/man/logger.severe.Rd b/base/logger/man/logger.severe.Rd index 1ea4c76cca9..4bda00ef83a 100644 --- a/base/logger/man/logger.severe.Rd +++ b/base/logger/man/logger.severe.Rd @@ -20,7 +20,7 @@ This function will print a message and stop execution of the code. This should only be used if the application should terminate. } \details{ -set \code{\link{logger.setQuitOnSevere(FALSE)}}. To avoid terminating +set \code{\link{logger.setQuitOnSevere}(FALSE)} to avoid terminating the session. This is set by default to TRUE if interactive or running inside Rstudio. } diff --git a/base/logger/man/print2string.Rd b/base/logger/man/print2string.Rd index 581c1478219..5c1b76b3283 100644 --- a/base/logger/man/print2string.Rd +++ b/base/logger/man/print2string.Rd @@ -20,12 +20,12 @@ Output of \code{print(x, ...)}, captured as string \description{ Note that for this to work properly in the \code{PEcAn.logger} functions, you should always add the \code{wrap = FALSE} argument, and -probably add a newline (\code{"\n"}) before the output of this function. +probably add a newline (\code{"\\n"}) before the output of this function. } \examples{ -logger.info("First few rows of Iris:\\n", print2string(iris[1:10, -5]), wrap = FALSE) +logger.info("First few rows of Iris:\n", print2string(iris[1:10, -5]), wrap = FALSE) df <- data.frame(test = c("download", "process", "plot"), status = c(TRUE, TRUE, FALSE)) -logger.debug("Current status:\\n", print2string(df, row.names = FALSE), wrap = FALSE) +logger.debug("Current status:\n", print2string(df, row.names = FALSE), wrap = FALSE) } \author{ Alexey Shiklomanov diff --git a/base/logger/man/severeifnot.Rd b/base/logger/man/severeifnot.Rd index 82f01737ea6..0bc51df1826 100644 --- a/base/logger/man/severeifnot.Rd +++ b/base/logger/man/severeifnot.Rd @@ -43,6 +43,8 @@ infoifnot("Something is not a list.", is.list(a), is.list(b)) warnifnot("I would prefer it if you used lists.", is.list(a), is.list(b)) errorifnot("You should definitely use lists.", is.list(a), is.list(b)) try({ - severeifnot("I absolutely cannot deal with the fact that something is not a list.", is.list(a), is.list(b)) + severeifnot("I cannot deal with the fact that something is not a list.", + is.list(a), + is.list(b)) }) } diff --git a/base/qaqc/DESCRIPTION b/base/qaqc/DESCRIPTION index 94f3b78f402..28a568be22d 100644 --- a/base/qaqc/DESCRIPTION +++ b/base/qaqc/DESCRIPTION @@ -1,22 +1,43 @@ Package: PEcAn.qaqc Type: Package Title: QAQC -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("David","LeBauer"), person("Tess", "McCabe")) Author: David LeBauer, Tess McCabe Maintainer: David LeBauer Description: PEcAn integration and model skill testing -Depends: - plotrix Imports: - PEcAn.logger + graphics, + PEcAn.logger, + plotrix, + stats Suggests: - testthat -License: FreeBSD + file LICENSE + knitr, + mvbutils, + PEcAn.BIOCRO, + PEcAn.ED2, + PEcAn.SIPNET, + PEcAn.utils, + rmarkdown, + testthat (>= 3.0.4), + vdiffr (>= 1.0.2) +X-Comment-Remotes: + Installing vdiffr from GitHub because as of 2021-09-23, this is the + easiest way to get version >= 1.0.2 onto Docker images that use older + Rstudio Package Manager snapshots. + Ditto for testthat, because we need >= 3.0.4 for vdiffr compatibility. + When building on a system that finds these versions on CRAN, + OK to remove these Remotes lines and this comment. +Remotes: + github::r-lib/testthat@v3.0.4, + github::r-lib/vdiffr@v1.0.2 +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +VignetteBuilder: knitr +Config/testthat/edition: 3 +RoxygenNote: 7.0.2 diff --git a/base/qaqc/R/cull_database_entries.R b/base/qaqc/R/cull_database_entries.R index 56868026162..8f155c95393 100644 --- a/base/qaqc/R/cull_database_entries.R +++ b/base/qaqc/R/cull_database_entries.R @@ -1,20 +1,22 @@ -##' @export cull_database_entries +##' Delete selected records from bety +##' +##' @export ##' @author Tempest McCabe -##' -##' @param outdir Directory from which the file will be read, and where the delete_log_FILE_NAME will be read to -##' @param file_name The name of the file being read in +##' +##' @param table data frame containing records to be deleted. Specify either this or `file_name` +##' @param outdir Directory from which the file will be read, and where the delete_log_FILE_NAME will be read to +##' @param file_name The name of the file being read in. Specify either this or `table` ##' @param con connection the the bety database ##' @param machine_id Optional id of the machine that contains the bety entries. -##' -##' @description This is a fucntion that takes in a table of records and deletes everything in the file. Please do not run this function without -##' 1) Backing Up Bety -##' 2) Checking the the file only contains entries to be deleted. +##' @param table_name database table from which to delete +##' +##' @description This is a fucntion that takes in a table of records and deletes everything in the file. Please do not run this function without +##' 1) Backing Up Bety +##' 2) Checking the the file only contains entries to be deleted. ##' ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder ##' or look at the README -##' -##' - +##' cull_database_entries<-function(table = NULL, outdir, file_name = NULL, con, machine_id = NULL, table_name = NULL){ diff --git a/base/qaqc/R/find_formats_without_inputs.R b/base/qaqc/R/find_formats_without_inputs.R index 9e2ee4d71c2..2ca993f4c87 100644 --- a/base/qaqc/R/find_formats_without_inputs.R +++ b/base/qaqc/R/find_formats_without_inputs.R @@ -1,7 +1,9 @@ -##' @export find_formats_without_inputs +##' Find formats in bety that have no input record in bety +##' ##' @author Tempest McCabe -##' -##' @param user_id Optional parameter to search by user_id +##' +##' @param con database connection object +##' @param user_id_code Optional parameter to search by user_id ##' @param created_after Optional parameter to search by creation date. Date must be in form 'YYYY-MM-DD'. ##' @param created_before Optional parameter to search by creation date. Can be used in conjunciton with created_after to specify a spesific window. Date must be in form 'YYYY-MM-DD'. ##' @param updated_after Optional parameter to search all entried updated after a certain date. Date must be in form 'YYYY-MM-DD'. @@ -13,8 +15,7 @@ ##' ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder ##' or look at the README - - +##' @export find_formats_without_inputs <- function(con, user_id_code = NULL, created_after = NULL, updated_after = NULL, created_before = NULL, updated_before = NULL){ input_command<-dplyr::tbl(con, 'inputs') diff --git a/base/qaqc/R/find_inputs_without_formats.R b/base/qaqc/R/find_inputs_without_formats.R index e68b0b96dfa..25307d4b829 100644 --- a/base/qaqc/R/find_inputs_without_formats.R +++ b/base/qaqc/R/find_inputs_without_formats.R @@ -1,9 +1,9 @@ -##' @export find_inputs_without_formats +##' Find inputs in bety with no format records ##' @author Tempest McCabe ##' ##' @param user_id Optional parameter to search by user_id -##' @param created_after Optional parameter to search by creation date. Date must be in form 'YYYY-MM-DD' -##' @param updated_after Optional parameter to search all entried updated after a certain date. Date must be in form 'YYYY-MM-DD' +##' @param created_before,created_after Optional parameter to search by creation date. Date must be in form 'YYYY-MM-DD' +##' @param updated_before,updated_after Optional parameter to search all entried updated after a certain date. Date must be in form 'YYYY-MM-DD' ##' @param con connection the the bety database ##' ##' @@ -12,7 +12,7 @@ ##' ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder ##' or look at the README - +##' @export find_inputs_without_formats<-function(con, user_id=NULL, created_after=NULL, updated_after=NULL, created_before = NULL, updated_before = NULL){ input_command<-dplyr::tbl(con, 'inputs') diff --git a/base/qaqc/R/get_table_column_names.R b/base/qaqc/R/get_table_column_names.R index 041a7d9407a..8a5a8bfe5ac 100644 --- a/base/qaqc/R/get_table_column_names.R +++ b/base/qaqc/R/get_table_column_names.R @@ -1,4 +1,4 @@ -##' @export get_table_column_names +##' get_table_column_names ##' @author Tempest McCabe ##' ##' @param table a table that is output from one of the find_* functions, @@ -11,6 +11,7 @@ ##' ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder ##' or look at the README +##' @export get_table_column_names<-function(table, con){ if(is.data.frame(table)){ diff --git a/base/qaqc/R/taylor.plot.R b/base/qaqc/R/taylor.plot.R index faa9f1a4c24..00986770518 100644 --- a/base/qaqc/R/taylor.plot.R +++ b/base/qaqc/R/taylor.plot.R @@ -8,27 +8,25 @@ #------------------------------------------------------------------------------- ##' Plot taylor diagram for benchmark sites -##' @title Taylor Diagram -##' @param dataset +##' +##' @param dataset data to plot ##' @param runid a numeric vector with the id(s) of one or more runs (folder in runs) to plot -##' @param siteid +##' @param siteid vector of sites to plot new.taylor <- function(dataset, runid, siteid) { - attach(dataset) for (run in runid) { for (si in siteid) { + sitemask <- dataset$site %in% si + obs <- dataset$obs[sitemask] + mod <- dataset[sitemask, paste0("model", run)] + R <- stats::cor(obs, mod, use = "pairwise") + sd.f <- stats::sd(mod) + lab <- paste(paste0("model", run), paste0("site", si)) if (run == runid[1] && si == siteid[1]) { - taylor.diagram(obs[site %in% si], get(paste0("model", run))[site %in% si], pos.cor = FALSE) - R <- cor(obs[site %in% si], get(paste0("model", run))[site %in% si], use = "pairwise") - sd.f <- sd(get(paste0("model", run))[site %in% si]) - lab <- paste(paste0("model", run), paste0("site", si)) - text(sd.f * R, sd.f * sin(acos(R)), labels = lab, pos = 3) + plotrix::taylor.diagram(obs, mod, pos.cor = FALSE) } else { - taylor.diagram(obs[site %in% si], get(paste0("model", run))[site %in% si], pos.cor = FALSE, add = TRUE) - R <- cor(obs[site %in% si], get(paste0("model", run))[site %in% si], use = "pairwise") - sd.f <- sd(get(paste0("model", run))[site %in% si]) - lab <- paste(paste0("model", run), paste0("site", si)) - text(sd.f * R, sd.f * sin(acos(R)), labels = lab, pos = 3) + plotrix::taylor.diagram(obs, mod, pos.cor = FALSE, add = TRUE) } + graphics::text(sd.f * R, sd.f * sin(acos(R)), labels = lab, pos = 3) } } } # new.taylor diff --git a/base/qaqc/R/write_out_table.R b/base/qaqc/R/write_out_table.R index 2c41f9a21d4..252c7e1c824 100644 --- a/base/qaqc/R/write_out_table.R +++ b/base/qaqc/R/write_out_table.R @@ -1,4 +1,4 @@ -##' @export write_out_table +##' write_out_table ##' @author Tempest McCabe ##' ##' @param table a table that is output from one of the find_* fucntions @@ -11,7 +11,7 @@ ##' ##' For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder ##' or look at the README - +##' @export write_out_table<-function(table,table_name,outdir, relevant_table_columns){ if(!"id" %in% relevant_table_columns){ diff --git a/base/qaqc/man/cull_database_entries.Rd b/base/qaqc/man/cull_database_entries.Rd new file mode 100644 index 00000000000..463c8f2e444 --- /dev/null +++ b/base/qaqc/man/cull_database_entries.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cull_database_entries.R +\name{cull_database_entries} +\alias{cull_database_entries} +\title{Delete selected records from bety} +\usage{ +cull_database_entries( + table = NULL, + outdir, + file_name = NULL, + con, + machine_id = NULL, + table_name = NULL +) +} +\arguments{ +\item{table}{data frame containing records to be deleted. Specify either this or `file_name`} + +\item{outdir}{Directory from which the file will be read, and where the delete_log_FILE_NAME will be read to} + +\item{file_name}{The name of the file being read in. Specify either this or `table`} + +\item{con}{connection the the bety database} + +\item{machine_id}{Optional id of the machine that contains the bety entries.} + +\item{table_name}{database table from which to delete} +} +\description{ +This is a fucntion that takes in a table of records and deletes everything in the file. Please do not run this function without +1) Backing Up Bety +2) Checking the the file only contains entries to be deleted. + +For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder +or look at the README +} +\author{ +Tempest McCabe +} diff --git a/base/qaqc/man/find_formats_without_inputs.Rd b/base/qaqc/man/find_formats_without_inputs.Rd new file mode 100644 index 00000000000..c3ab4efdf67 --- /dev/null +++ b/base/qaqc/man/find_formats_without_inputs.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/find_formats_without_inputs.R +\name{find_formats_without_inputs} +\alias{find_formats_without_inputs} +\title{Find formats in bety that have no input record in bety} +\usage{ +find_formats_without_inputs( + con, + user_id_code = NULL, + created_after = NULL, + updated_after = NULL, + created_before = NULL, + updated_before = NULL +) +} +\arguments{ +\item{con}{connection the the bety database} + +\item{user_id_code}{Optional parameter to search by user_id} + +\item{created_after}{Optional parameter to search by creation date. Date must be in form 'YYYY-MM-DD'.} + +\item{updated_after}{Optional parameter to search all entried updated after a certain date. Date must be in form 'YYYY-MM-DD'.} + +\item{created_before}{Optional parameter to search by creation date. Can be used in conjunciton with created_after to specify a spesific window. Date must be in form 'YYYY-MM-DD'.} + +\item{updated_before}{Optional parameter to search all entried updated before a certain date. Date must be in form 'YYYY-MM-DD'.} +} +\description{ +This is a fucntion that returns a dataframe with all of the format entries that have no assosiated input records. + +For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder +or look at the README +} +\author{ +Tempest McCabe +} diff --git a/base/qaqc/man/find_inputs_without_formats.Rd b/base/qaqc/man/find_inputs_without_formats.Rd new file mode 100644 index 00000000000..72076db503e --- /dev/null +++ b/base/qaqc/man/find_inputs_without_formats.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/find_inputs_without_formats.R +\name{find_inputs_without_formats} +\alias{find_inputs_without_formats} +\title{Find inputs in bety with no format records} +\usage{ +find_inputs_without_formats( + con, + user_id = NULL, + created_after = NULL, + updated_after = NULL, + created_before = NULL, + updated_before = NULL +) +} +\arguments{ +\item{con}{connection the the bety database} + +\item{user_id}{Optional parameter to search by user_id} + +\item{created_before, created_after}{Optional parameter to search by creation date. Date must be in form 'YYYY-MM-DD'} + +\item{updated_before, updated_after}{Optional parameter to search all entried updated after a certain date. Date must be in form 'YYYY-MM-DD'} +} +\description{ +This is a function that returns a dataframe with all of the input entries that have no assosiated format records. +This is very rare in the database. + +For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder +or look at the README +} +\author{ +Tempest McCabe +} diff --git a/base/qaqc/man/get_table_column_names.Rd b/base/qaqc/man/get_table_column_names.Rd new file mode 100644 index 00000000000..44f31c778a5 --- /dev/null +++ b/base/qaqc/man/get_table_column_names.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_table_column_names.R +\name{get_table_column_names} +\alias{get_table_column_names} +\title{get_table_column_names} +\usage{ +get_table_column_names(table, con) +} +\arguments{ +\item{table}{a table that is output from one of the find_* functions, +or a data.frame containing the output from multiple find_* functions. Could also be a vector of table names.} + +\item{con}{a connection to the bety database.} +} +\description{ +This function will return a vector of the column names for a given table(s) in the bety database. +Useful for choseing which columns to include in the written-out table. + +For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder +or look at the README +} +\author{ +Tempest McCabe +} diff --git a/base/qaqc/man/new.taylor.Rd b/base/qaqc/man/new.taylor.Rd index 242b376a2b5..7b0ed1b7221 100644 --- a/base/qaqc/man/new.taylor.Rd +++ b/base/qaqc/man/new.taylor.Rd @@ -2,12 +2,16 @@ % Please edit documentation in R/taylor.plot.R \name{new.taylor} \alias{new.taylor} -\title{Taylor Diagram} +\title{Plot taylor diagram for benchmark sites} \usage{ new.taylor(dataset, runid, siteid) } \arguments{ +\item{dataset}{data to plot} + \item{runid}{a numeric vector with the id(s) of one or more runs (folder in runs) to plot} + +\item{siteid}{vector of sites to plot} } \description{ Plot taylor diagram for benchmark sites diff --git a/base/qaqc/man/write_out_table.Rd b/base/qaqc/man/write_out_table.Rd new file mode 100644 index 00000000000..2eaf9dc57d5 --- /dev/null +++ b/base/qaqc/man/write_out_table.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/write_out_table.R +\name{write_out_table} +\alias{write_out_table} +\title{write_out_table} +\usage{ +write_out_table(table, table_name, outdir, relevant_table_columns) +} +\arguments{ +\item{table}{a table that is output from one of the find_* fucntions} + +\item{table_name}{name of table} + +\item{outdir}{path to folder into which the editable table will be written} + +\item{relevant_table_columns}{a list of all columns to keep. ID and table name will be automatically included.} +} +\description{ +This is a fucntion that returns a dataframe with all of the format entries that have no assosiated input records. + +For more information on how to use this function see the "Pre-release-database-cleanup" script in the 'vignettes' folder +or look at the README +} +\author{ +Tempest McCabe +} diff --git a/base/qaqc/tests/Rcheck_reference.log b/base/qaqc/tests/Rcheck_reference.log new file mode 100644 index 00000000000..0a786774508 --- /dev/null +++ b/base/qaqc/tests/Rcheck_reference.log @@ -0,0 +1,86 @@ +* using log directory ‘/tmp/Rtmp0KMN9Z/PEcAn.qaqc.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.qaqc/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.qaqc’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.qaqc’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Malformed Description field: should contain one or more complete sentences. +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... NOTE +Non-standard file/directory found at top level: + ‘README.Rmd’ +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'::' or ':::' imports not declared from: + ‘dplyr’ ‘PEcAn.DB’ +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +cull_database_entries: no visible global function definition for + ‘read.table’ +cull_database_entries: no visible global function definition for + ‘write.table’ +find_formats_without_inputs: no visible binding for global variable + ‘user_id’ +find_formats_without_inputs: no visible binding for global variable + ‘created_at’ +find_formats_without_inputs: no visible binding for global variable + ‘updated_at’ +find_inputs_without_formats: no visible binding for global variable + ‘user_id_code’ +find_inputs_without_formats: no visible binding for global variable + ‘created_at’ +find_inputs_without_formats: no visible binding for global variable + ‘updated_at’ +write_out_table: no visible global function definition for + ‘write.table’ +Undefined global functions or variables: + created_at read.table updated_at + user_id user_id_code write.table +Consider adding + importFrom("utils", "read.table", "write.table") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... OK +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking files in ‘vignettes’ ... OK +* checking examples ... NONE +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 1 WARNING, 3 NOTEs diff --git a/base/qaqc/tests/testthat/_snaps/taylorplot/taylor-diagram.svg b/base/qaqc/tests/testthat/_snaps/taylorplot/taylor-diagram.svg new file mode 100644 index 00000000000..f7e9d2a9bf6 --- /dev/null +++ b/base/qaqc/tests/testthat/_snaps/taylorplot/taylor-diagram.svg @@ -0,0 +1,1605 @@ + + + + + + + + + + + + +Taylor Diagram +Standard deviation + + + + + + + + + + + + + + + + + + + + +0 +0 +0.2 +-0.2 +0.4 +-0.4 +0.6 +-0.6 +0.8 +-0.8 +0.9 +-0.9 +0.95 +-0.95 +0.99 +-0.99 +1 +-1 + + + + + + + + + + +0.13 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.26 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.4 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.53 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.66 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.79 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.92 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.5 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.6 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.7 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1.8 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +2.1 + + + + + + + + + + + +0 +0 + +0.33 +0.33 + +0.66 +0.66 + +0.99 +0.99 + +1.3 +1.3 +Standard Deviation +Centered RMS Difference + +Correlation Coefficient + +model1 site1 + +model1 site2 + +model2 site1 + +model2 site2 + + diff --git a/base/qaqc/tests/testthat/test-taylorplot.R b/base/qaqc/tests/testthat/test-taylorplot.R new file mode 100644 index 00000000000..012a380bb3e --- /dev/null +++ b/base/qaqc/tests/testthat/test-taylorplot.R @@ -0,0 +1,23 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +test_that("taylor diagram", { + + set.seed(1) + testdata <- data.frame( + site = c(1, 1, 1, 2, 2, 3), + date = c(2001, 2001, 2002, 2003, 2004, 2005), + obs = rnorm(6, 10, 2), + model1 = rnorm(6, 10, 3) + 2, + model2 = rnorm(6, 11, 3) + 2) + + vdiffr::expect_doppelganger( + "taylor diagram", + function() new.taylor(testdata, siteid = 1:3, runid = 1:2)) +}) diff --git a/base/qaqc/tests/testthat/test.taylor.plot.R b/base/qaqc/tests/testthat/test.taylor.plot.R deleted file mode 100644 index 5c69bea6c2f..00000000000 --- a/base/qaqc/tests/testthat/test.taylor.plot.R +++ /dev/null @@ -1,23 +0,0 @@ -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - - -library("plotrix") -set.seed(5) -testdata <- data.frame(site=c(1,1,1,2,2,3), - date=c(2001,2001,2002,2003,2004,2005), - obs=rnorm(6,10,2),model1=rnorm(6,10,3),model2=rnorm(6,10,3)) - -set.seed(1) -testdata <- data.frame(site=c(1,1,1,2,2,3), - date=c(2001,2001,2002,2003,2004,2005), - obs=rnorm(6,10,2),model1=rnorm(6,10,3)+2,model2=rnorm(6,11,3)+2) - -taylor.diagram(testdata$obs,testdata$model1,pos.cor=FALSE) -taylor.diagram(testdata$obs,model=testdata$model2,add=TRUE,col="blue") diff --git a/base/qaqc/vignettes/Pre-release-database-cleanup.Rmd b/base/qaqc/vignettes/Pre-release-database-cleanup.Rmd index ffbe5e31f60..db9ecf221cd 100644 --- a/base/qaqc/vignettes/Pre-release-database-cleanup.Rmd +++ b/base/qaqc/vignettes/Pre-release-database-cleanup.Rmd @@ -1,13 +1,16 @@ --- title: "Pre Release database Cleanup" -output: html_notebook +output: html_vignette +vignette: > + %\VignetteIndexEntry{Pre Release database Cleanup} + %\VignetteEngine{knitr::rmarkdown} --- This is an quick script for cleaning up the database. For further documentation see the README.rmd file in the main `qaqc` folder. **Step 1: set up an outdir and a connection to bety** The outdir is where temporary editing files will be written, and where a backup of bety will be stored. -```{r} +```{r, eval=FALSE} con <- RPostgreSQL::dbConnect(RPostgreSQL::PostgreSQL(), dbname = "bety", password = 'bety', @@ -21,7 +24,7 @@ options(scipen=999) #To view full id values **Step 2: Back up bety** Before any major deletion processes, it makes sense to make a back-up version of the database. Don't skip this step. -```{r} +```{r, eval=FALSE} system('TODAY=$( date +"%d" )') backup_dir<-paste('pg_dump -U bety -d bety | gzip -9 > ', bety_backup_directory,'/bety-pre-culling${TODAY}.sql.gz', sep="") @@ -29,7 +32,7 @@ system(backup_dir) ``` **Step 3: find all of the entries that should be deleted *** -```{r} +```{r, eval=FALSE} formats<-find_formats_without_inputs(con=con, created_before = "2016-01-01", user_id = NULL, updated_after = "2016-01-01") #Ideally, date should be set to the date of the last release @@ -38,7 +41,7 @@ inputs<-find_inputs_without_formats(con=con, created_before = "2014-01-01",updat ``` Since just a dump of every column can be hard to read, just choose the columns that are important. -```{r} +```{r,eval=FALSE} column_names<-get_table_column_names(table = formats, con = con) column_names$formats @@ -49,7 +52,7 @@ column_names ** Option 1: Edit an R object *** This is the most important step! Navigate to the written out table and *delete entries that should remain in the database*. -```{r} +```{r, eval=FALSE} formats<-formats[colnames(formats) %in% column_names] #subset for easy viewing View(formats) @@ -61,7 +64,7 @@ View(formats) This is also the most important step! Navigate to the written out table and *delete entries that should remain in the database*. If the tables are difficult to read, change what columns are retained by editing the "relevant_table_columns" parameter. -```{r} +```{r, eval=FALSE} write_out_table(table = formats, outdir = outdir, relevant_table_columns = column_names, table_name = "formats") write_out_table(table = inputs,outdir = outdir, relevant_table_columns =c("id", "created_at", "name"), table_name = "inputs") ``` diff --git a/base/qaqc/vignettes/compare_ED2.Rmd b/base/qaqc/vignettes/compare_ED2.Rmd deleted file mode 100644 index a2b273c490c..00000000000 --- a/base/qaqc/vignettes/compare_ED2.Rmd +++ /dev/null @@ -1,16 +0,0 @@ -Title -============ - -looking at how read.output works ------- - -```{r, echo=FALSE, message=FALSE, eval = FALSE} -library(ncdf4) -library(PEcAn.utils) -ed2.2008 <- nc_open ('../output/PEcAn_9/out/9/2004.nc'); -xx <- nc_open ('../output/PEcAn_13/out/13/2004.nc') -read.output(run.id=1, outdir='../output/PEcAn_1/out/1', - start.year=2004, end.year=2009, - variables="GPP", - model="SIPNET") -``` diff --git a/base/qaqc/vignettes/function_relationships.Rmd b/base/qaqc/vignettes/function_relationships.Rmd index 6bee9bf5717..1de4de04f7b 100644 --- a/base/qaqc/vignettes/function_relationships.Rmd +++ b/base/qaqc/vignettes/function_relationships.Rmd @@ -1,3 +1,11 @@ +--- +title: "Package Interdependencies" +output: html_vignette +vignette: > + %\VignetteIndexEntry{Package Interdependencies} + %\VignetteEngine{knitr::rmarkdown} +--- + -Package Interdependencies -========================= - This some code helps to visualize the interdependence of functions within PEcAn diff --git a/base/qaqc/vignettes/lebauer2013ffb.Rmd b/base/qaqc/vignettes/lebauer2013ffb.Rmd deleted file mode 100644 index 5b769e5a31f..00000000000 --- a/base/qaqc/vignettes/lebauer2013ffb.Rmd +++ /dev/null @@ -1,15 +0,0 @@ -LeBauer 2013 analysis -======================================================== - - - -```{r} - -``` - - - -```{r fig.width=7, fig.height=6} - -``` - diff --git a/base/qaqc/vignettes/module_output.Rmd b/base/qaqc/vignettes/module_output.Rmd index 251f1f505d6..4ab3566b0ca 100644 --- a/base/qaqc/vignettes/module_output.Rmd +++ b/base/qaqc/vignettes/module_output.Rmd @@ -1,3 +1,11 @@ +--- +title: "Modules and outputs" +output: html_vignette +vignette: > + %\VignetteIndexEntry{Modules and outputs} + %\VignetteEngine{knitr::rmarkdown} +--- + -Modules and outputs -=================== - To get a better understanding on what files are created where, Rob created a workflow as an SVG diagram. You can find the diagram at http://isda.ncsa.illinois.edu/~kooper/EBI/workflow.svg @@ -22,7 +27,8 @@ are inputs and outputs. To create this I used the trace functionality in R to capture the files saved/loaded -```{r} +```{r, eval = FALSE} +library("ncdf4") trace(nc_open, quote(cat(c("LOAD : ", filename, "\n"), file="files.txt", append=TRUE))) trace(nc_create, quote(cat(c("SAVE : ", filename, "\n"), file="files.txt", append=TRUE))) trace(save, quote(cat(c("SAVE : ", file, "\n"), file="files.txt", append=TRUE))) diff --git a/base/remote/DESCRIPTION b/base/remote/DESCRIPTION index 23b195b4466..fcb5f3873bf 100644 --- a/base/remote/DESCRIPTION +++ b/base/remote/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAn.remote Type: Package Title: PEcAn model execution utilities -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("David","LeBauer"), person("Rob","Kooper"), person("Shawn", "Serbin"), @@ -12,13 +12,16 @@ Maintainer: Alexey Shiklomanov Description: This package contains utilities for communicating with and executing code on local and remote hosts. In particular, it has PEcAn-specific utilities for starting ecosystem model runs. Imports: - PEcAn.logger + PEcAn.logger, + httr, + jsonlite, + urltools Suggests: testthat, tools, getPass -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/base/remote/NAMESPACE b/base/remote/NAMESPACE index c91a6b220e9..ec730637600 100644 --- a/base/remote/NAMESPACE +++ b/base/remote/NAMESPACE @@ -7,6 +7,8 @@ export(kill.tunnel) export(open_tunnel) export(qsub_get_jobid) export(qsub_run_finished) +export(rabbitmq_get_message) +export(rabbitmq_post_message) export(remote.copy.from) export(remote.copy.to) export(remote.copy.update) diff --git a/base/remote/R/rabbitmq.R b/base/remote/R/rabbitmq.R new file mode 100644 index 00000000000..1a9eef3e3fd --- /dev/null +++ b/base/remote/R/rabbitmq.R @@ -0,0 +1,222 @@ +#' parse the RabbiMQ URI. +#' +#' This will parse the uri into smaller pieces that can be used to talk to the +#' rest endpoint for RabbitMQ. +#' +#' @param uri the amqp URI +#' @param prefix the prefix that the RabbitMQ managmenet interface uses +#' @param port the port for rabbitmq managment interface +#' @return a list that contains the url to the mangement interface, username +#' password and vhost. +rabbitmq_parse_uri <- function(uri, prefix="", port=15672) { + # save username/password + if (!grepl("@", uri, fixed = TRUE)) { + PEcAn.logger::logger.info("rabbitmq uri is not recognized, missing username and password, assuming guest/guest") + upw <- c("guest", "guest") + } else { + upw <- strsplit(sub(".*://([^@]*).*", "\\1", uri), ":")[[1]] + if (length(upw) != 2) { + PEcAn.logger::logger.error("rabbitmq uri is not recognized, missing username or password") + return(NA) + } + } + + # split uri and check scheme + url_split <- urltools::url_parse(uri) + if (!startsWith(url_split$scheme, "amqp")) { + PEcAn.logger::logger.error("rabbitmq uri is not recognized, invalid scheme (need amqp(s) or http(s))") + return(NA) + } + + # convert uri to rabbitmq rest/management call + url_split["scheme"] <- sub("amqp", "http", url_split["scheme"]) + url_split["port"] <- port + vhost <- url_split["path"] + prefix <- sub("^/+", "", prefix) + if (prefix == "") { + url_split["path"] <- "" + } else if (endsWith(prefix, "/")) { + url_split["path"] <- prefix + } else { + url_split["path"] <- paste0(prefix, "/") + } + + url <- urltools::url_compose(url_split) + + return(list(url=url, vhost=vhost, username=upw[[1]], password=upw[[2]])) +} + +#' Send a message to RabbitMQ rest API. +#' +#' It will check the resulting status code and print a message in case +#' something goes wrong. +#' +#' @param url the full endpoint rest url +#' @param auth authentication for rabbitmq in httr:auth +#' @param body the actual body to send, this is a rabbitmq message. +#' @param action the rest action to perform +#' @param silent boolean to indicate if logging should be performed. +#' @return will return NA if message failed, otherwise it will either +#' return the resulting message, or if not availble an empty string "". +rabbitmq_send_message <- function(url, auth, body, action = "POST", silent = FALSE) { + if (action == "GET") { + if (is.na(body)) { + result <- httr::GET(url, auth) + } else { + result <- httr::GET(url, auth, body = jsonlite::toJSON(body, auto_unbox = TRUE)) + } + } else if (action == "PUT") { + result <- httr::PUT(url, auth, body = jsonlite::toJSON(body, auto_unbox = TRUE)) + } else if (action == "DELETE") { + result <- httr::DELETE(url, auth, body = jsonlite::toJSON(body, auto_unbox = TRUE)) + } else if (action == "POST") { + result <- httr::POST(url, auth, body = jsonlite::toJSON(body, auto_unbox = TRUE)) + } else { + if (!silent) { + PEcAn.logger::logger.error(paste("error sending message to rabbitmq, uknown action", action)) + } + return(NA) + } + + if (result$status_code >= 200 && result$status_code <= 299) { + content <- httr::content(result) + if (length(content) == 0) { + return("") + } else { + return(content) + } + } else if (result$status_code == 401) { + PEcAn.logger::logger.error("error sending message to rabbitmq, make sure username/password is correct") + return(NA) + } else { + if (!silent) { + output <- httr::content(result) + if ("reason" %in% names(output)) { + PEcAn.logger::logger.error(paste0("error sending message to rabbitmq [", result$status_code, "], ", output$reason)) + } else { + PEcAn.logger::logger.error("error sending message to rabbitmq") + } + } + return(NA) + } +} + +#' Create a queue in RabbitMQ. +#' +#' This will first check to see if the queue already exists in RabbitMQ, if not +#' it will create the queue. If the queue exists, or is created it will return +#' TRUE, it will return FALSE otherwise. +#' +#' @param url parsed RabbitMQ URL. +#' @param auth the httr authentication object to use. +#' @param vhost the vhost where to create the queue. +#' @param queue the queue that should be checked/created. +#' @param auto_delete should the queue be deleted afterwards (FALSE is default) +#' @param durable should the messages exists after a server restart (TRUE is default) +#' @return TRUE if the queue now exists, FALSE otherwise. +#' @author Rob Kooper +rabbitmq_create_queue <- function(url, auth, vhost, queue, auto_delete = FALSE, durable = TRUE) { + resturl <- paste0(url, "api/queues/", vhost, "/", queue) + + # check if queue exists + result <- rabbitmq_send_message(resturl, auth, NA, "GET", silent = TRUE) + if (length(result) > 1 || !is.na(result)) { + return(TRUE) + } + + # create the queue + PEcAn.logger::logger.info("creating queue", queue, "in rabbitmq") + body <- list( + auto_delete = auto_delete, + durable = durable + ) + result <- rabbitmq_send_message(resturl, auth, body, "PUT") + return(length(result) > 1 || !is.na(result)) +} + +#' Post message to RabbitMQ. +#' +#' This will submit a message to RabbitMQ, if the queue does not exist it will +#' be created. The message will be converted to a json message that is +#' submitted. +#' +#' @param uri RabbitMQ URI or URL to rest endpoint +#' @param queue the queue the message is submitted to +#' @param message the message to submit, will beconverted to json. +#' @param prefix prefix for the rabbitmq api endpoint, default is for no prefix. +#' @param port port for the management interface, the default is 15672. +#' @return the result of the post if message was send, or NA if it failed. +#' @author Alexey Shiklomanov, Rob Kooper +#' @export +rabbitmq_post_message <- function(uri, queue, message, prefix="", port=15672) { + # parse rabbitmq URI + rabbitmq <- rabbitmq_parse_uri(uri, prefix, port) + if (length(rabbitmq) != 4) { + return(NA) + } + + # create authentication + auth <- httr::authenticate(rabbitmq$username, rabbitmq$password) + + # make sure the queue exists + if (!rabbitmq_create_queue(rabbitmq$url, auth, rabbitmq$vhost, queue)) { + return(NA) + } + + # send actual message to queue + body <- list( + properties = list(delivery_mode = 2), + routing_key = queue, + payload = jsonlite::toJSON(message, auto_unbox = TRUE), + payload_encoding = "string" + ) + url <- paste0(rabbitmq$url, "api/exchanges/", rabbitmq$vhost, "//publish") + return(rabbitmq_send_message(url, auth, body, "POST")) +} + +#' Get message from RabbitMQ. +#' +#' This will get a message from RabbitMQ, if the queue does not exist it will +#' be created. The message will be converted to a json message that is returned. +#' +#' @param uri RabbitMQ URI or URL to rest endpoint +#' @param queue the queue the message is received from. +#' @param count the number of messages to retrieve from the queue. +#' @param prefix prefix for the rabbitmq api endpoint, default is for no prefix. +#' @param port port for the management interface, the default is 15672. +#' @return NA if no message was retrieved, or a list of the messages payload. +#' @author Alexey Shiklomanov, Rob Kooper +#' @export +rabbitmq_get_message <- function(uri, queue, count=1, prefix="", port=15672) { + # parse rabbitmq URI + rabbitmq <- rabbitmq_parse_uri(uri, prefix, port) + if (length(rabbitmq) != 4) { + return(NA) + } + + # create authentication + auth <- httr::authenticate(rabbitmq$username, rabbitmq$password) + + # make sure the queue exists + if (!rabbitmq_create_queue(rabbitmq$url, auth, rabbitmq$vhost, queue)) { + return(NA) + } + + # get actual message from queue + body <- list( + count = count, + ackmode = "ack_requeue_false", + encoding = "auto" + ) + url <- paste0(rabbitmq$url, "api/queues/", rabbitmq$vhost, "/", queue, "/get") + result <- rabbitmq_send_message(url, auth, body, "POST") + if (length(result) == 1 && is.na(result)) { + return(NA) + } else { + if (length(result) == 1 && result == "") { + return(c()) + } else { + return(lapply(result, function(x) { tryCatch(jsonlite::fromJSON(x$payload), error=function(e) { x$payload }) })) + } + } +} diff --git a/base/remote/R/remote.execute.R.R b/base/remote/R/remote.execute.R.R index b0eb7b53884..cb7a74e878b 100644 --- a/base/remote/R/remote.execute.R.R +++ b/base/remote/R/remote.execute.R.R @@ -22,6 +22,7 @@ remote.execute.R <- function(script, host = "localhost", user = NA, verbose = FA if (is.character(host)) { host <- list(name = host) } + dir.create(scratchdir, showWarnings = FALSE, recursive = TRUE) uuid <- paste0("pecan-", paste(sample(c(letters[1:6], 0:9), 30, replace = TRUE), collapse = "")) tmpfile <- file.path(scratchdir, uuid) @@ -41,7 +42,7 @@ remote.execute.R <- function(script, host = "localhost", user = NA, verbose = FA } result <- try(system2(R, "--no-save","--no-restore", stdout = verbose, stderr = verbose, input = input)) - print(result) + PEcAn.logger::logger.debug(result) if (!file.exists(tmpfile)) { fp <- file(tmpfile, "w") serialize(result, fp) @@ -52,6 +53,7 @@ remote.execute.R <- function(script, host = "localhost", user = NA, verbose = FA result <- unserialize(fp) close(fp) file.remove(tmpfile) + PEcAn.logger::logger.debug(result) return(invisible(result)) } else { diff --git a/base/remote/R/start.model.runs.R b/base/remote/R/start.model.runs.R index f8c5a79882e..d1980ab1f63 100644 --- a/base/remote/R/start.model.runs.R +++ b/base/remote/R/start.model.runs.R @@ -66,7 +66,7 @@ start.model.runs <- function(settings, write = TRUE, stop.on.error = TRUE) { # create database connection if (write) { dbcon <- db.open(settings$database$bety) - on.exit(db.close(dbcon)) + on.exit(db.close(dbcon), add = TRUE) } else { dbcon <- NULL } diff --git a/base/remote/R/start_rabbitmq.R b/base/remote/R/start_rabbitmq.R index f61a813f217..20f9bf831f3 100644 --- a/base/remote/R/start_rabbitmq.R +++ b/base/remote/R/start_rabbitmq.R @@ -1,7 +1,10 @@ #' Start model execution using rabbitmq #' -#' @return Output of execution command, as a character (see [remote.execute.cmd()]). +#' @return Output of execution command, as a character (see [rabbitmq_post_message()]). start_rabbitmq <- function(folder, rabbitmq_uri, rabbitmq_queue) { - out <- system2('python3', c('/work/sender.py', rabbitmq_uri, rabbitmq_queue, folder), stdout = TRUE, stderr = TRUE) + message <- list("folder"=folder) + prefix <- Sys.getenv("RABBITMQ_PREFIX", "") + port <- Sys.getenv("RABBITMQ_PORT", "15672") + out <- rabbitmq_post_message(rabbitmq_uri, rabbitmq_queue, message, prefix, port) return(out) } diff --git a/base/remote/man/open_tunnel.Rd b/base/remote/man/open_tunnel.Rd index 7c577a73f4e..8e0f06d5260 100644 --- a/base/remote/man/open_tunnel.Rd +++ b/base/remote/man/open_tunnel.Rd @@ -4,9 +4,14 @@ \alias{open_tunnel} \title{Open an SSH tunnel, prompting for passwords as needed} \usage{ -open_tunnel(remote_host, user = NULL, password = NULL, - tunnel_dir = "~/.pecan/tunnel/", wait.time = 15, - tunnel_script = "~/pecan/web/sshtunnel.sh") +open_tunnel( + remote_host, + user = NULL, + password = NULL, + tunnel_dir = "~/.pecan/tunnel/", + wait.time = 15, + tunnel_script = "~/pecan/web/sshtunnel.sh" +) } \arguments{ \item{remote_host}{name of remote server to connect to (e.g. geo.bu.edu)} diff --git a/base/remote/man/rabbitmq_create_queue.Rd b/base/remote/man/rabbitmq_create_queue.Rd new file mode 100644 index 00000000000..6e9c5f4175b --- /dev/null +++ b/base/remote/man/rabbitmq_create_queue.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rabbitmq.R +\name{rabbitmq_create_queue} +\alias{rabbitmq_create_queue} +\title{Create a queue in RabbitMQ.} +\usage{ +rabbitmq_create_queue( + url, + auth, + vhost, + queue, + auto_delete = FALSE, + durable = TRUE +) +} +\arguments{ +\item{url}{parsed RabbitMQ URL.} + +\item{auth}{the httr authentication object to use.} + +\item{vhost}{the vhost where to create the queue.} + +\item{queue}{the queue that should be checked/created.} + +\item{auto_delete}{should the queue be deleted afterwards (FALSE is default)} + +\item{durable}{should the messages exists after a server restart (TRUE is default)} +} +\value{ +TRUE if the queue now exists, FALSE otherwise. +} +\description{ +This will first check to see if the queue already exists in RabbitMQ, if not +it will create the queue. If the queue exists, or is created it will return +TRUE, it will return FALSE otherwise. +} +\author{ +Rob Kooper +} diff --git a/base/remote/man/rabbitmq_get_message.Rd b/base/remote/man/rabbitmq_get_message.Rd new file mode 100644 index 00000000000..233a1dcaae5 --- /dev/null +++ b/base/remote/man/rabbitmq_get_message.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rabbitmq.R +\name{rabbitmq_get_message} +\alias{rabbitmq_get_message} +\title{Get message from RabbitMQ.} +\usage{ +rabbitmq_get_message(uri, queue, count = 1, prefix = "", port = 15672) +} +\arguments{ +\item{uri}{RabbitMQ URI or URL to rest endpoint} + +\item{queue}{the queue the message is received from.} + +\item{count}{the number of messages to retrieve from the queue.} + +\item{prefix}{prefix for the rabbitmq api endpoint, default is for no prefix.} + +\item{port}{port for the management interface, the default is 15672.} +} +\value{ +NA if no message was retrieved, or a list of the messages payload. +} +\description{ +This will get a message from RabbitMQ, if the queue does not exist it will +be created. The message will be converted to a json message that is returned. +} +\author{ +Alexey Shiklomanov, Rob Kooper +} diff --git a/base/remote/man/rabbitmq_parse_uri.Rd b/base/remote/man/rabbitmq_parse_uri.Rd new file mode 100644 index 00000000000..2bf82667238 --- /dev/null +++ b/base/remote/man/rabbitmq_parse_uri.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rabbitmq.R +\name{rabbitmq_parse_uri} +\alias{rabbitmq_parse_uri} +\title{parse the RabbiMQ URI.} +\usage{ +rabbitmq_parse_uri(uri, prefix = "", port = 15672) +} +\arguments{ +\item{uri}{the amqp URI} + +\item{prefix}{the prefix that the RabbitMQ managmenet interface uses} + +\item{port}{the port for rabbitmq managment interface} +} +\value{ +a list that contains the url to the mangement interface, username +password and vhost. +} +\description{ +This will parse the uri into smaller pieces that can be used to talk to the +rest endpoint for RabbitMQ. +} diff --git a/base/remote/man/rabbitmq_post_message.Rd b/base/remote/man/rabbitmq_post_message.Rd new file mode 100644 index 00000000000..3eda68eebe5 --- /dev/null +++ b/base/remote/man/rabbitmq_post_message.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rabbitmq.R +\name{rabbitmq_post_message} +\alias{rabbitmq_post_message} +\title{Post message to RabbitMQ.} +\usage{ +rabbitmq_post_message(uri, queue, message, prefix = "", port = 15672) +} +\arguments{ +\item{uri}{RabbitMQ URI or URL to rest endpoint} + +\item{queue}{the queue the message is submitted to} + +\item{message}{the message to submit, will beconverted to json.} + +\item{prefix}{prefix for the rabbitmq api endpoint, default is for no prefix.} + +\item{port}{port for the management interface, the default is 15672.} +} +\value{ +the result of the post if message was send, or NA if it failed. +} +\description{ +This will submit a message to RabbitMQ, if the queue does not exist it will +be created. The message will be converted to a json message that is +submitted. +} +\author{ +Alexey Shiklomanov, Rob Kooper +} diff --git a/base/remote/man/rabbitmq_send_message.Rd b/base/remote/man/rabbitmq_send_message.Rd new file mode 100644 index 00000000000..bdc6eae85b2 --- /dev/null +++ b/base/remote/man/rabbitmq_send_message.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rabbitmq.R +\name{rabbitmq_send_message} +\alias{rabbitmq_send_message} +\title{Send a message to RabbitMQ rest API.} +\usage{ +rabbitmq_send_message(url, auth, body, action = "POST", silent = FALSE) +} +\arguments{ +\item{url}{the full endpoint rest url} + +\item{auth}{authentication for rabbitmq in httr:auth} + +\item{body}{the actual body to send, this is a rabbitmq message.} + +\item{action}{the rest action to perform} + +\item{silent}{boolean to indicate if logging should be performed.} +} +\value{ +will return NA if message failed, otherwise it will either +return the resulting message, or if not availble an empty string "". +} +\description{ +It will check the resulting status code and print a message in case +something goes wrong. +} diff --git a/base/remote/man/remote.copy.from.Rd b/base/remote/man/remote.copy.from.Rd index 53b15801c79..794aaa06c21 100644 --- a/base/remote/man/remote.copy.from.Rd +++ b/base/remote/man/remote.copy.from.Rd @@ -4,8 +4,14 @@ \alias{remote.copy.from} \title{Copy file from remote to local} \usage{ -remote.copy.from(host, src, dst, options = NULL, delete = FALSE, - stderr = FALSE) +remote.copy.from( + host, + src, + dst, + options = NULL, + delete = FALSE, + stderr = FALSE +) } \arguments{ \item{host}{list with server, user and optionally tunnel to use.} diff --git a/base/remote/man/remote.copy.to.Rd b/base/remote/man/remote.copy.to.Rd index 7f6357ead3f..1130c3b3501 100644 --- a/base/remote/man/remote.copy.to.Rd +++ b/base/remote/man/remote.copy.to.Rd @@ -4,8 +4,7 @@ \alias{remote.copy.to} \title{Copy file/dir to remote server from local server} \usage{ -remote.copy.to(host, src, dst, options = NULL, delete = FALSE, - stderr = FALSE) +remote.copy.to(host, src, dst, options = NULL, delete = FALSE, stderr = FALSE) } \arguments{ \item{host}{host structure to execute command on} diff --git a/base/remote/man/remote.copy.update.Rd b/base/remote/man/remote.copy.update.Rd index aa36139502b..99a849312ca 100644 --- a/base/remote/man/remote.copy.update.Rd +++ b/base/remote/man/remote.copy.update.Rd @@ -4,8 +4,14 @@ \alias{remote.copy.update} \title{Copy to remote and update DB} \usage{ -remote.copy.update(input_id, remote_dir, local_file_path, - remote_file_name = NULL, host, con) +remote.copy.update( + input_id, + remote_dir, + local_file_path, + remote_file_name = NULL, + host, + con +) } \arguments{ \item{input_id}{Input ID, as a numeric or character} diff --git a/base/remote/man/remote.execute.R.Rd b/base/remote/man/remote.execute.R.Rd index 9c00555ba5e..08a472fc5ea 100644 --- a/base/remote/man/remote.execute.R.Rd +++ b/base/remote/man/remote.execute.R.Rd @@ -4,8 +4,14 @@ \alias{remote.execute.R} \title{Execute command remotely} \usage{ -remote.execute.R(script, host = "localhost", user = NA, - verbose = FALSE, R = "R", scratchdir = tempdir()) +remote.execute.R( + script, + host = "localhost", + user = NA, + verbose = FALSE, + R = "R", + scratchdir = tempdir() +) } \arguments{ \item{script}{the script to be invoked, as a list of commands.} diff --git a/base/remote/man/start.model.runs.Rd b/base/remote/man/start.model.runs.Rd index 02985be0760..85d06d5fbd9 100644 --- a/base/remote/man/start.model.runs.Rd +++ b/base/remote/man/start.model.runs.Rd @@ -4,8 +4,7 @@ \alias{start.model.runs} \title{Start selected ecosystem model runs within PEcAn workflow} \usage{ -\method{start}{model.runs}(settings, write = TRUE, - stop.on.error = TRUE) +\method{start}{model.runs}(settings, write = TRUE, stop.on.error = TRUE) } \arguments{ \item{settings}{pecan settings object} diff --git a/base/remote/man/start_qsub.Rd b/base/remote/man/start_qsub.Rd index 4c135b3d151..d8d8353f984 100644 --- a/base/remote/man/start_qsub.Rd +++ b/base/remote/man/start_qsub.Rd @@ -4,8 +4,18 @@ \alias{start_qsub} \title{Start qsub runs} \usage{ -start_qsub(run, qsub_string, rundir, host, host_rundir, host_outdir, - stdout_log, stderr_log, job_script, qsub_extra = NULL) +start_qsub( + run, + qsub_string, + rundir, + host, + host_rundir, + host_outdir, + stdout_log, + stderr_log, + job_script, + qsub_extra = NULL +) } \arguments{ \item{run}{(numeric) run ID, as an integer} diff --git a/base/remote/man/start_rabbitmq.Rd b/base/remote/man/start_rabbitmq.Rd index 209d06e1c4e..cf7b2fd7592 100644 --- a/base/remote/man/start_rabbitmq.Rd +++ b/base/remote/man/start_rabbitmq.Rd @@ -7,7 +7,7 @@ start_rabbitmq(folder, rabbitmq_uri, rabbitmq_queue) } \value{ -Output of execution command, as a character (see \code{\link[=remote.execute.cmd]{remote.execute.cmd()}}). +Output of execution command, as a character (see \code{\link[=rabbitmq_post_message]{rabbitmq_post_message()}}). } \description{ Start model execution using rabbitmq diff --git a/base/remote/tests/Rcheck_reference.log b/base/remote/tests/Rcheck_reference.log new file mode 100644 index 00000000000..705e0f9fde4 --- /dev/null +++ b/base/remote/tests/Rcheck_reference.log @@ -0,0 +1,124 @@ +* using log directory ‘/tmp/RtmpUHZsfY/PEcAn.remote.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-manual --as-cran’ +* checking for file ‘PEcAn.remote/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.remote’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.remote’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'::' or ':::' import not declared from: ‘PEcAn.DB’ +* checking S3 generic/method consistency ... WARNING +start: + function(x, ...) +start.model.runs: + function(settings, write, stop.on.error) + +See section ‘Generic functions and methods’ in the ‘Writing R +Extensions’ manual. + +Found the following apparent S3 methods exported but not registered: + start.model.runs +See section ‘Registering S3 methods’ in the ‘Writing R Extensions’ +manual. +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +remote.copy.update: no visible global function definition for + ‘db.query’ +remote.copy.update: no visible binding for global variable ‘putveg.id’ +remote.copy.update: no visible binding for global variable ‘i’ +runModule.start.model.runs: no visible global function definition for + ‘is.MultiSettings’ +runModule.start.model.runs: no visible global function definition for + ‘is.Settings’ +stamp_finished: no visible global function definition for ‘db.query’ +stamp_started: no visible global function definition for ‘db.query’ +start.model.runs: no visible global function definition for + ‘txtProgressBar’ +start.model.runs: no visible global function definition for ‘db.open’ +start.model.runs: no visible global function definition for ‘db.close’ +start.model.runs: no visible global function definition for + ‘setTxtProgressBar’ +Undefined global functions or variables: + db.close db.open db.query i is.MultiSettings is.Settings putveg.id + setTxtProgressBar txtProgressBar +Consider adding + importFrom("utils", "setTxtProgressBar", "txtProgressBar") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... WARNING +Undocumented code objects: + ‘runModule.start.model.runs’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'kill.tunnel' + ‘settings’ ‘exe’ ‘data’ + +Documented arguments not in \usage in documentation object 'remote.copy.update': + ‘stderr’ + +Undocumented arguments in documentation object 'remote.execute.R' + ‘R’ ‘scratchdir’ +Documented arguments not in \usage in documentation object 'remote.execute.R': + ‘args’ + +Undocumented arguments in documentation object 'remote.execute.cmd' + ‘cmd’ +Documented arguments not in \usage in documentation object 'remote.execute.cmd': + ‘command’ + +Undocumented arguments in documentation object 'start_rabbitmq' + ‘folder’ ‘rabbitmq_uri’ ‘rabbitmq_queue’ + +Undocumented arguments in documentation object 'test_remote' + ‘...’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... + OK +* DONE +Status: 4 WARNINGs, 2 NOTEs diff --git a/base/settings/DESCRIPTION b/base/settings/DESCRIPTION index 9c13adf3139..2a0c13bd227 100644 --- a/base/settings/DESCRIPTION +++ b/base/settings/DESCRIPTION @@ -1,27 +1,28 @@ Package: PEcAn.settings Title: PEcAn Settings package -Authors@R: c(person("David","LeBauer"), - person("Rob","Kooper")) -Maintainer: David LeBauer -Author: David LeBauer, Rob Kooper -Version: 1.7.1 -Date: 2019-09-05 -License: FreeBSD + file LICENSE +Authors@R: c(person("David","LeBauer", role = c("aut", "cre"), + email = "dlebauer@arizona.edu"), + person("Rob","Kooper", rol="aut")) +Version: 1.7.2 +Date: 2021-10-04 +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Require: hdf5 -Description: Contains functions to read PEcAn settings files +Description: Contains functions to read PEcAn settings files. Depends: - PEcAn.DB, methods Imports: + PEcAn.DB, PEcAn.logger, PEcAn.remote, PEcAn.utils, lubridate (>= 1.6.0), - XML (>= 3.98-1.3) + purrr, + XML (>= 3.98-1.3), + optparse Suggests: testthat (>= 2.0.0) Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/base/settings/NAMESPACE b/base/settings/NAMESPACE index ac55ab62b63..c185b4a03e4 100644 --- a/base/settings/NAMESPACE +++ b/base/settings/NAMESPACE @@ -36,6 +36,7 @@ export(createSitegroupMultiSettings) export(expandMultiSettings) export(fix.deprecated.settings) export(getRunSettings) +export(get_args) export(is.MultiSettings) export(is.SafeList) export(is.Settings) @@ -53,3 +54,4 @@ export(site.pft.linkage) export(update.settings) export(write.settings) import(XML) +importFrom(purrr,"%>%") diff --git a/base/settings/R/MultiSettings.R b/base/settings/R/MultiSettings.R index 31d3b3b0b9d..cfc1ef3e712 100644 --- a/base/settings/R/MultiSettings.R +++ b/base/settings/R/MultiSettings.R @@ -1,14 +1,12 @@ -##' Create a PEcAn MultiSettings object -##' -##' -##' @title Create a PEcAn MultiSettings object -##' @param -##' @return -##' @export -##' @author Ryan Kelly +#' Create a PEcAn MultiSettings object +#' +#' @param ... Settings objects to concatenate +#' @return list with class "Multisettings" +#' @export +#' @author Ryan Kelly MultiSettings <- function(...) { result <- list(...) - + if (length(result) == 1) { if (is.MultiSettings(result[[1]])) { return(result[[1]]) @@ -16,11 +14,13 @@ MultiSettings <- function(...) { result <- result[[1]] } } - + if (!all(sapply(result, is.Settings))) { - stop("MultiSettings can only be made from Setting, MultiSettings, or a list of Settings") + stop( + "MultiSettings can only be made from Setting,", + " MultiSettings, or a list of Settings") } - + if (length(result) > 0 && is.null(names(result))) { names(result) <- paste("settings", seq_along(result), sep = ".") } @@ -29,23 +29,25 @@ MultiSettings <- function(...) { } # MultiSettings -##' @export -##' @describeIn +#' @export +#' @describeIn MultiSettings coerce an existing object to MultiSettings +#' @param x object to test or coerce as.MultiSettings <- function(x) { return(MultiSettings(x)) } -##' @export +#' @export +#' @describeIn MultiSettings test if an object is a MultiSettings is.MultiSettings <- function(x) { return(inherits(x, "MultiSettings")) } -##' @export +#' @export "[[<-.MultiSettings" <- function(x, value, i, global = TRUE) { if (is.character(i)) { if (global) { value <- replicate(length(x), value, simplify = FALSE) - x[[i, global = F]] <- value + x[[i, global = FALSE]] <- value } else { if (length(x) == length(value)) { value <- as.list(value) @@ -72,17 +74,17 @@ is.MultiSettings <- function(x) { } } # "[[<-.MultiSettings" -##' @export +#' @export "$<-.MultiSettings" <- function(x, value, i, global = TRUE) { return(`[[<-.MultiSettings`(x, value, i, global)) } -##' @export +#' @export "[<-.MultiSettings" <- function(x, value, i) { stop("MultiSettings don't support assignments using '['") } -##' @export +#' @export "[[.MultiSettings" <- function(x, i, collapse = TRUE, setAttributes = FALSE) { if (is.character(i)) { result <- lapply(x, function(y) y[[i]]) @@ -104,16 +106,20 @@ is.MultiSettings <- function(x) { .allListElementsEqual <- function(x) { firstElement <- x[[1]] - replicatedFirstElement <- replicate(length(x), firstElement, simplify = FALSE) - return(isTRUE(all.equal(replicatedFirstElement, x, check.attributes = FALSE))) + replicatedFirstElement <- replicate( + length(x), + firstElement, + simplify = FALSE) + return(isTRUE( + all.equal(replicatedFirstElement, x, check.attributes = FALSE))) } # .allListElementsEqual -##' @export +#' @export "$.MultiSettings" <- function(x, i) { return(x[[i]]) } -##' @export +#' @export "[.MultiSettings" <- function(x, i) { if (is.character(i)) { stop("MultiSettings don't support selecting by '[' with character indices") @@ -122,17 +128,17 @@ is.MultiSettings <- function(x) { } } # "[.MultiSettings" -##' @export +#' @export names.MultiSettings <- function(x) { return(unique(unlist(lapply(x, names)))) } -##' @export +#' @export "names<-.MultiSettings" <- function(x, value) { stop("Can't name MultiSettings this way. Use settingNames() instead.") } -##' @export +#' @export settingNames <- function(multiSettings, settingNames) { if (missing(settingNames)) { return(attr(multiSettings, "names")) @@ -142,59 +148,61 @@ settingNames <- function(multiSettings, settingNames) { } } # settingNames -##' @export +#' @export print.MultiSettings <- function(x, printAll = FALSE, ...) { if (printAll) { NextMethod() } else { - print(paste0("A MultiSettings object containing ", length(x), " Settings."), ...) + print( + paste0("A MultiSettings object containing ", length(x), " Settings."), + ...) } } -##' @export +#' @export printAll <- function(x) { UseMethod("printAll", x) } -##' @export -printAll.MultiSettings <- function(multiSettings) { - return(print(multiSettings, TRUE)) +#' @export +printAll.MultiSettings <- function(x) { + return(print(x, TRUE)) } .expandableItemsTag <- "multisettings" -##' @export +#' @export listToXml.MultiSettings <- function(item, tag, collapse = TRUE) { if (collapse && length(item) > 1) { if (.expandableItemsTag %in% names(item)) { stop("Settings can't contain reserved tag 'multisettings'.") } - + tmp <- list() expandableItems <- list() for (setting in names(item)) { - value <- item[[setting, setAttributes = T]] + value <- item[[setting, setAttributes = TRUE]] tmp[[setting]] <- value if (attr(value, "settingType") == "multi") { expandableItems <- c(expandableItems, setting) } } item <- tmp - + names(expandableItems) <- rep(.expandableItemsTag, length(expandableItems)) item[[.expandableItemsTag]] <- expandableItems } - + NextMethod() } # listToXml.MultiSettings -##' @export +#' @export expandMultiSettings <- function(x) { UseMethod("expandMultiSettings") } -##' @export +#' @export expandMultiSettings.list <- function(x) { if (!(.expandableItemsTag %in% names(x))) { return(x) @@ -203,9 +211,9 @@ expandMultiSettings.list <- function(x) { for (setting in x[[.expandableItemsTag]]) { result[[setting, global = FALSE]] <- x[[setting]] } - + result[[.expandableItemsTag]] <- NULL - + return(result) } } # expandMultiSettings.list diff --git a/base/settings/R/SafeList.R b/base/settings/R/SafeList.R index 9e174de77fb..d0b6681ab4c 100644 --- a/base/settings/R/SafeList.R +++ b/base/settings/R/SafeList.R @@ -7,22 +7,25 @@ # http://opensource.ncsa.illinois.edu/license.html #------------------------------------------------------------------------------- -##' Create a SafeList object -##' -##' SafeList is a wrapper class for the normal R list. It should behave identically, except for -##' the $ operator being overridden to require exact matches. -##' -##' The constructor works identical to list(...) unless: -##' -##' 1) The only argument is a list, in which case the result is the same list, with its class -##' attribute updated to include 'SafeList', or -##' 2) The only argument is a SafeList, in which case that argument is returned unchanged -##' -##' @title Constrct SafeList Object -##' @param ... A list to upgrade to SafeList, or elements to be added to a new SafeList -##' @return The resulting SafeList -##' @export -##' @author Ryan Kelly +#' Create a SafeList object +#' +#' SafeList is a wrapper class for the normal R list. +#' It should behave identically, except for the $ operator being overridden +#' to require exact matches. +#' +#' The constructor works identical to list(...) unless: +#' +#' 1) The only argument is a list, in which case the result is the same list, +#' with its class attribute updated to include 'SafeList', or +#' 2) The only argument is a SafeList, in which case that argument is returned +#' unchanged +#' +#' @title Construct SafeList Object +#' @param ... A list to upgrade to SafeList, +#' or elements to be added to a new SafeList +#' @return The resulting SafeList +#' @export +#' @author Ryan Kelly SafeList <- function(...) { result <- list(...) if (length(result) == 1) { @@ -37,35 +40,34 @@ SafeList <- function(...) { } # SafeList -##' @export -##' @describeIn SafeList Coerce an object to SafeList. -##' @param x list to coerce -##' @return a SafeList version of x +#' @export +#' @describeIn SafeList Coerce an object to SafeList. +#' @param x list object to be tested or coerced +#' @return a SafeList version of x as.SafeList <- function(x) { return(SafeList(x)) } # as.SafeList -##' @export -##' @describeIn SafeList Test if object is already a SafeList. -##' @param x list object to be tested -##' @return logical +#' @export +#' @describeIn SafeList Test if object is already a SafeList. +#' @return logical is.SafeList <- function(x) { inherits(x, "SafeList") } # is.SafeList -##' Extract SafeList component by name -##' -##' Overrides `$`.list, and works just like it except forces exact match -##' (i.e., makes x$name behave exactly like x[[name, exact=T]]) -##' -##' @title Extract SafeList component by name -##' @param x the SafeList object -##' @param name the name of the component -##' @return The specified component -##' @export -##' @author Ryan Kelly +#' Extract SafeList component by name +#' +#' Overrides `$`.list, and works just like it except forces exact match +#' (i.e., makes x$name behave exactly like x[[name, exact=T]]) +#' +#' @title Extract SafeList component by name +#' @param x the SafeList object +#' @param name the name of the component +#' @return The specified component +#' @export +#' @author Ryan Kelly "$.SafeList" <- function(x, name) { return(x[[name, exact = TRUE]]) } # "$.SafeList" diff --git a/base/settings/R/Settings.R b/base/settings/R/Settings.R index 7cd168f3856..a3ec1cfcd06 100644 --- a/base/settings/R/Settings.R +++ b/base/settings/R/Settings.R @@ -1,36 +1,39 @@ -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -##------------------------------------------------------------------------------- -##' Create a PEcAn Settings object -##' -##' @title Create a PEcAn Settings object -##' @param ... TODO -##' @return -##' @export -##' @author Ryan Kelly +##----------------------------------------------------------------------------- +#' Create a PEcAn Settings object +#' +#' @title Create a PEcAn Settings object +#' @param ... objects to concatenate +#' @return a list containing all objects in `...`, +#' with class c("Settings", "SafeList", "list"). +#' @export +#' @author Ryan Kelly Settings <- function(...) { args <- list(...) if (length(args) == 1 && inherits(args[[1]], "Settings")) { return(args[[1]]) } - + result <- SafeList(...) class(result) <- c("Settings", class(result)) return(result) } -##' @export -##' @describeIn +#' @export +#' @describeIn Settings coerce an object to Settings +#' @param x object to test or coerce as.Settings <- function(x) { return(Settings(x)) } -##' @export +#' @export +#' @describeIn Settings test if object is already a Settings is.Settings <- function(x) { return(inherits(x, "Settings")) } diff --git a/base/settings/R/addSecrets.R b/base/settings/R/addSecrets.R index 9914d483e52..032f33af046 100644 --- a/base/settings/R/addSecrets.R +++ b/base/settings/R/addSecrets.R @@ -1,45 +1,47 @@ -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -##------------------------------------------------------------------------------- -##' Add secret information from ~/.pecan.xml -##' -##' Copies certains sections from ~/.pecan.xml to the settings. This allows -##' a user to have their own unique parameters also when sharing the -##' pecan.xml file we don't expose these secrets. -##' Currently this will copy the database and browndog sections -##' -##' @title Add Users secrets -##' @param settings settings file -##' @return will return the updated settings values -##' @author Rob Kooper -##' @export addSecrets -addSecrets <- function(settings, force=FALSE) { +##----------------------------------------------------------------------------- +#' Add secret information from ~/.pecan.xml +#' +#' Copies certains sections from ~/.pecan.xml to the settings. This allows +#' a user to have their own unique parameters also when sharing the +#' pecan.xml file we don't expose these secrets. +#' Currently this will copy the database and browndog sections +#' +#' @title Add Users secrets +#' @param settings settings file +#' @return will return the updated settings values +#' @author Rob Kooper +#' @export addSecrets +addSecrets <- function(settings, force = FALSE) { if (!file.exists("~/.pecan.xml")) { return(invisible(settings)) } - - if(!force && !is.null(settings$settings.info$secrets.added) && - settings$settings.info$secrets.added==TRUE) { - PEcAn.logger::logger.info("Secret settings have been added already. Skipping.") + + if (!force + && !is.null(settings$settings.info$secrets.added) + && settings$settings.info$secrets.added == TRUE) { + PEcAn.logger::logger.info( + "Secret settings have been added already. Skipping.") return(invisible(settings)) } else { PEcAn.logger::logger.info("Adding secret settings...") } - - if(is.MultiSettings(settings)) { - return(invisible(papply(settings, addSecrets, force=force))) + + if (is.MultiSettings(settings)) { + return(invisible(papply(settings, addSecrets, force = force))) } - + pecan <- xmlToList(xmlParse("~/.pecan.xml")) - + # always copy following sections - for(key in c('database')) { - for(section in names(pecan[[key]])) { + for (key in c("database")) { + for (section in names(pecan[[key]])) { if (section %in% names(settings[section])) { PEcAn.logger::logger.info("Already have a section for", section) } else { @@ -48,12 +50,12 @@ addSecrets <- function(settings, force=FALSE) { } } } - + # only copy these sections if tag exists - for(key in c('browndog')) { + for (key in c("browndog")) { if (! key %in% names(settings)) next - - for(section in names(pecan[[key]])) { + + for (section in names(pecan[[key]])) { if (section %in% names(settings[section])) { PEcAn.logger::logger.info("Already have a section for", section) } else { @@ -61,7 +63,7 @@ addSecrets <- function(settings, force=FALSE) { settings[[key]][section] <- pecan[[key]][section] } } - } - + } + return(invisible(settings)) } diff --git a/base/settings/R/check.all.settings.R b/base/settings/R/check.all.settings.R index e2466d22d51..44c5dd7465c 100644 --- a/base/settings/R/check.all.settings.R +++ b/base/settings/R/check.all.settings.R @@ -1,42 +1,45 @@ -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -##------------------------------------------------------------------------------- -##' check to see if inputs are specified - this should be part of the model code -##' @title Check Inputs -##' @param settings settings file -##' @export check.inputs +##----------------------------------------------------------------------------- + +#' check to see if inputs are specified - this should be part of the model code +#' @title Check Inputs +#' @param settings settings file +#' @export check.inputs check.inputs <- function(settings) { if (is.null(settings$model$type)) return(settings) - + # don't know how to check inputs if (is.null(settings$database$bety)) { PEcAn.logger::logger.info("No database connection, can't check inputs.") - return (settings) + return(settings) } - + # get list of inputs associated with model type dbcon <- PEcAn.DB::db.open(settings$database$bety) - on.exit(PEcAn.DB::db.close(dbcon)) - - inputs <- PEcAn.DB::db.query(paste0( - "SELECT tag, format_id, required FROM modeltypes, modeltypes_formats ", - "WHERE modeltypes_formats.modeltype_id = modeltypes.id ", - "AND modeltypes.name='", settings$model$type, "' ", - "AND modeltypes_formats.input"), con=dbcon) - - # check list of inputs + on.exit(PEcAn.DB::db.close(dbcon), add = TRUE) + + inputs <- PEcAn.DB::db.query( + paste0( + "SELECT tag, format_id, required FROM modeltypes, modeltypes_formats ", + "WHERE modeltypes_formats.modeltype_id = modeltypes.id ", + "AND modeltypes.name='", settings$model$type, "' ", + "AND modeltypes_formats.input"), + con = dbcon) + + # check list of inputs allinputs <- names(settings$run$inputs) if (nrow(inputs) > 0) { - for(i in 1:nrow(inputs)) { + for (i in seq_len(nrow(inputs))) { tag <- inputs$tag[i] hostname <- settings$host$name allinputs <- allinputs[allinputs != tag] - + # check if tag exists if (is.null(settings$run$inputs[[tag]])) { if (inputs$required[i]) { @@ -46,58 +49,76 @@ check.inputs <- function(settings) { } next } - + # check if exists if ("id" %in% names(settings$run$inputs[[tag]])) { - id <- settings$run$inputs[[tag]][['id']] + id <- settings$run$inputs[[tag]][["id"]] file <- PEcAn.DB::dbfile.file("Input", id, dbcon, hostname) if (is.na(file)) { - PEcAn.logger::logger.error("No file found for", tag, " and id", id, "on host", hostname) + PEcAn.logger::logger.error( + "No file found for", tag, " and id", id, "on host", hostname) } else { - if (is.null(settings$run$inputs[[tag]][['path']])) { - settings$run$inputs[[tag]]['path'] <- file - } else if (file != settings$run$inputs[[tag]][['path']]) { - PEcAn.logger::logger.warn("Input file and id do not match for ", tag) + if (is.null(settings$run$inputs[[tag]][["path"]])) { + settings$run$inputs[[tag]]["path"] <- file + } else if (file != settings$run$inputs[[tag]][["path"]]) { + PEcAn.logger::logger.warn( + "Input file and id do not match for ", tag) } } } else if ("path" %in% names(settings$run$inputs[[tag]])) { # can we find the file so we can set the tag.id - id <- PEcAn.DB::dbfile.id('Input', settings$run$inputs[[tag]][['path']], dbcon, hostname) + id <- PEcAn.DB::dbfile.id( + "Input", + settings$run$inputs[[tag]][["path"]], + dbcon, + hostname) if (!is.na(id)) { - settings$run$inputs[[tag]][['id']] <- id + settings$run$inputs[[tag]][["id"]] <- id } } - PEcAn.logger::logger.info("path",settings$run$inputs[[tag]][['path']]) + PEcAn.logger::logger.info("path", settings$run$inputs[[tag]][["path"]]) # check to see if format is right type if ("id" %in% names(settings$run$inputs[[tag]])) { - formats <- PEcAn.DB::db.query(paste0("SELECT format_id FROM inputs WHERE id=", settings$run$inputs[[tag]][['id']]), con=dbcon) + formats <- PEcAn.DB::db.query( + paste0( + "SELECT format_id FROM inputs WHERE id=", + settings$run$inputs[[tag]][["id"]]), + con = dbcon) if (nrow(formats) >= 1) { - if (formats[1, 'format_id'] != inputs$format_id[i]) { - PEcAn.logger::logger.warn("@Format of input", tag, "does not match specified input: ",formats[1, 'format_id'],inputs$format_id[i]) - settings$run$inputs[[tag]][['path']] <- NULL ## zero out path, do_conversions will need to convert specified input ID to model format + if (formats[1, "format_id"] != inputs$format_id[i]) { + PEcAn.logger::logger.warn( + "@Format of input", tag, + "does not match specified input:", + formats[1, "format_id"], inputs$format_id[i]) + # zero out path, do_conversions will need to convert specified + # input ID to model format + settings$run$inputs[[tag]][["path"]] <- NULL } } else { PEcAn.logger::logger.error("Could not check format of", tag, ".") } } - PEcAn.logger::logger.info("path",settings$run$inputs[[tag]][['path']]) + PEcAn.logger::logger.info("path", settings$run$inputs[[tag]][["path"]]) } } - + if (length(allinputs) > 0) { - PEcAn.logger::logger.info("Unused inputs found :", paste(allinputs, collapse=" ")) + PEcAn.logger::logger.info( + "Unused inputs found :", + paste(allinputs, collapse = " ")) } - + return(settings) } # check database section -##' @title Check Database -##' @param settings settings file -##' @export check.database +#' @title Check Database +#' @param database settings list to check. +#' You'll probably use `settings$database` +#' @export check.database check.database <- function(database) { if (is.null(database)) return(NULL) - + ## check database settings if (is.null(database$driver)) { database$driver <- "PostgreSQL" @@ -106,7 +127,6 @@ check.database <- function(database) { } is_postgres_like <- database$driver %in% c("PostgreSQL", "Postgres") - is_postgresql <- database$driver == "PostgreSQL" if (!is_postgres_like) { PEcAn.logger::logger.severe( @@ -121,13 +141,13 @@ check.database <- function(database) { "Use at your own risk!." ) } - + # Attempt to load the driver rdriver <- paste0("R", database$driver) if (!requireNamespace(rdriver, quietly = TRUE)) { PEcAn.logger::logger.severe("Could not load the database driver: ", rdriver) } - + # PostgreSQL specific checks if (is_postgres_like) { if (!is.null(database$passwd)) { @@ -147,156 +167,180 @@ check.database <- function(database) { database$name <- NULL } } - + ## The following hack handles *.illinois.* to *.uiuc.* aliases of ebi-forecast - if(!is.null(database$host)){ + if (!is.null(database$host)) { forcastnames <- c("ebi-forecast.igb.uiuc.edu", - "ebi-forecast.igb.illinois.edu") - if((database$host %in% forcastnames) & - (Sys.info()['nodename'] %in% forcastnames)){ + "ebi-forecast.igb.illinois.edu") + if ((database$host %in% forcastnames) + && (Sys.info()["nodename"] %in% forcastnames)) { database$host <- "localhost" } - } else if(is.null(database$host)){ + } else if (is.null(database$host)) { database$host <- "localhost" } - + ## convert strings around from old format to new format - if(is.null(database[["user"]])){ + if (is.null(database[["user"]])) { if (!is.null(database$userid)) { PEcAn.logger::logger.info("'userid' in database section should be 'user'") database$user <- database$userid - + } else if (!is.null(database$username)) { - PEcAn.logger::logger.info("'username' in database section should be 'user'") + PEcAn.logger::logger.info( + "'username' in database section should be 'user'") database$user <- database$username - + } else { PEcAn.logger::logger.info("no database user specified, using 'bety'") database$user <- "bety" } - } + } database$userid <- database$username <- NULL - + # fill in defaults for the database - if(is.null(database$password)) { + if (is.null(database$password)) { database$password <- "bety" } - if(is.null(database$dbname)) { + if (is.null(database$dbname)) { database$dbname <- "bety" } - - if (!PEcAn.DB::db.exists(params=database, FALSE, table=NA)) { - PEcAn.logger::logger.severe("Invalid Database Settings : ", unlist(database)) + + if (!PEcAn.DB::db.exists(params = database, FALSE, table = NA)) { + PEcAn.logger::logger.severe( + "Invalid Database Settings : ", unlist(database)) } - + # connected - PEcAn.logger::logger.info("Successfully connected to database : ", unlist(database)) - + PEcAn.logger::logger.info( + "Successfully connected to database : ", unlist(database)) + # return fixed up database return(database) -} +} -# check to make sure BETY is up to date -##' @title Check BETY Version -##' @param settings settings file -##' @export check.bety.version +#' check to make sure BETY is up to date +#' @title Check BETY Version +#' @param dbcon database connection object +#' @export check.bety.version check.bety.version <- function(dbcon) { - versions <- PEcAn.DB::db.query("SELECT version FROM schema_migrations;", con=dbcon)[['version']] - - # there should always be a versin 1 + versions <- PEcAn.DB::db.query( + "SELECT version FROM schema_migrations;", + con = dbcon)[["version"]] + + # there should always be a version 1 if (! ("1" %in% versions)) { - PEcAn.logger::logger.severe("No version 1, how did this database get created?") + PEcAn.logger::logger.severe( + "No version 1, how did this database get created?") } - + # check for specific version if (! ("20140617163304" %in% versions)) { - PEcAn.logger::logger.severe("Missing migration 20140617163304, this associates files with models.") + PEcAn.logger::logger.severe( + "Missing migration 20140617163304, this associates files with models.") } if (! ("20140708232320" %in% versions)) { - PEcAn.logger::logger.severe("Missing migration 20140708232320, this introduces geometry column in sites") + PEcAn.logger::logger.severe( + "Missing migration 20140708232320,", + "this introduces geometry column in sites") } if (! ("20140729045640" %in% versions)) { - PEcAn.logger::logger.severe("Missing migration 20140729045640, this introduces modeltypes table") + PEcAn.logger::logger.severe("Missing migration 20140729045640,", + "this introduces modeltypes table") } if (! ("20151011190026" %in% versions)) { - PEcAn.logger::logger.severe("Missing migration 20151011190026, this introduces notes and user_id in workflows") + PEcAn.logger::logger.severe("Missing migration 20151011190026,", + "this introduces notes and user_id in workflows") } - + # check if database is newer - if (tail(versions, n=1) > "20141009160121") { - PEcAn.logger::logger.warn("Last migration", tail(versions, n=1), "is more recent than expected 20141009160121.", - "This could result in PEcAn not working as expected.") + last_migration_date <- lubridate::ymd_hms(utils::tail(versions, n = 1)) + pecan_release_date <- lubridate::ymd( + utils::packageDescription("PEcAn.DB")$Date) + if (last_migration_date > pecan_release_date) { + PEcAn.logger::logger.warn( + "Last database migration", utils::tail(versions, n = 1), + "is more recent than this", pecan_release_date, "release of PEcAn.", + "This could result in PEcAn not working as expected.") } } -##' Sanity checks. Checks the settings file to make sure expected fields exist. It will try to use -##' default values for any missing values, or stop the exection if no defaults are possible. -##' -##' Expected fields in settings file are: -##' - pfts with at least one pft defined -##' @title Check Settings -##' @param settings settings file -##' @return will return the updated settings values with defaults set. -##' @author Rob Kooper, David LeBauer -##' @export check.settings -check.settings <- function(settings, force=FALSE) { - if(!force && !is.null(settings$settings.info$checked) && settings$settings.info$checked==TRUE) { +#' Sanity checks. Checks the settings file to make sure expected fields exist. +#' It will try to use default values for any missing values, +#' or stop the exection if no defaults are possible. +#' +#' Expected fields in settings file are: +#' - pfts with at least one pft defined +#' @title Check Settings +#' @param settings settings file +#' @return will return the updated settings values with defaults set. +#' @author Rob Kooper, David LeBauer +#' @export check.settings +check.settings <- function(settings, force = FALSE) { + if (!force + && !is.null(settings$settings.info$checked) + && settings$settings.info$checked == TRUE) { PEcAn.logger::logger.info("Settings have been checked already. Skipping.") return(invisible(settings)) } else { PEcAn.logger::logger.info("Checking settings...") } - - if(is.MultiSettings(settings)) { - return(invisible(papply(settings, check.settings, force=force))) + + if (is.MultiSettings(settings)) { + return(invisible(papply(settings, check.settings, force = force))) } - - scipen = getOption("scipen") - on.exit(options(scipen=scipen)) - options(scipen=12) - + + scipen <- getOption("scipen") + on.exit(options(scipen = scipen), add = TRUE) + options(scipen = 12) + settings <- check.database.settings(settings) #checking the ensemble tag in settings settings <- check.ensemble.settings(settings) - - if(!is.null(settings$database$bety)) { + + if (!is.null(settings$database$bety)) { dbcon <- PEcAn.DB::db.open(settings$database$bety) - on.exit(PEcAn.DB::db.close(dbcon), add=TRUE) + on.exit(PEcAn.DB::db.close(dbcon), add = TRUE) } else { dbcon <- NULL } - + # make sure there are pfts defined if (is.null(settings$pfts) || (length(settings$pfts) == 0)) { PEcAn.logger::logger.warn("No PFTS specified.") } - + # check to make sure a host is given if (is.null(settings$host$name)) { PEcAn.logger::logger.info("Setting localhost for execution host.") settings$host$name <- "localhost" } - + # check if there is either ensemble or sensitivy.analysis if (is.null(settings$ensemble) && is.null(settings$sensitivity.analysis)) { - PEcAn.logger::logger.warn("No ensemble or sensitivity analysis specified, no models will be executed!") + PEcAn.logger::logger.warn( + "No ensemble or sensitivity analysis specified.", + "No models will be executed!") } - - settings <- papply(settings, check.run.settings, dbcon=dbcon) - + + settings <- papply(settings, check.run.settings, dbcon = dbcon) + # check meta-analysis - if(!is.null(settings$meta.analysis)){ + if (!is.null(settings$meta.analysis)) { if (is.null(settings$meta.analysis$iter)) { settings$meta.analysis$iter <- 3000 - PEcAn.logger::logger.info("Setting meta.analysis iterations to ", settings$meta.analysis$iter) + PEcAn.logger::logger.info( + "Setting meta.analysis iterations to ", settings$meta.analysis$iter) } if (is.null(settings$meta.analysis$random.effects)) { settings$meta.analysis$random.effects <- list() settings$meta.analysis$random.effects$on <- FALSE settings$meta.analysis$random.effects$use_ghs <- TRUE - PEcAn.logger::logger.info("Setting meta.analysis random effects to ", settings$meta.analysis$random.effects$on) - } else if(!is.list(settings$meta.analysis$random.effects)){ + PEcAn.logger::logger.info( + "Setting meta.analysis random effects to ", + settings$meta.analysis$random.effects$on) + } else if (!is.list(settings$meta.analysis$random.effects)) { # this handles the previous usage # # FALSE @@ -307,374 +351,498 @@ check.settings <- function(settings, force=FALSE) { settings$meta.analysis$random.effects$use_ghs <- TRUE } else { # everything is used as defined - settings$meta.analysis$random.effects$on <- as.logical(settings$meta.analysis$random.effects$on) - if(!is.null(settings$meta.analysis$random.effects$use_ghs)){ - settings$meta.analysis$random.effects$use_ghs <- as.logical(settings$meta.analysis$random.effects$use_ghs) - }else{ + settings$meta.analysis$random.effects$on <- as.logical( + settings$meta.analysis$random.effects$on) + if (!is.null(settings$meta.analysis$random.effects$use_ghs)) { + settings$meta.analysis$random.effects$use_ghs <- as.logical( + settings$meta.analysis$random.effects$use_ghs) + } else { settings$meta.analysis$random.effects$use_ghs <- TRUE } } if (is.null(settings$meta.analysis$threshold)) { settings$meta.analysis$threshold <- 1.2 - PEcAn.logger::logger.info("Setting meta.analysis threshold to ", settings$meta.analysis$threshold) + PEcAn.logger::logger.info( + "Setting meta.analysis threshold to ", settings$meta.analysis$threshold) } if (is.null(settings$meta.analysis$update)) { - settings$meta.analysis$update <- 'AUTO' - PEcAn.logger::logger.info("Setting meta.analysis update to only update if no previous meta analysis was found") + settings$meta.analysis$update <- "AUTO" + PEcAn.logger::logger.info( + "Setting meta.analysis update to only update if no previous", + "meta analysis was found") } - if ((settings$meta.analysis$update != 'AUTO') && is.na(as.logical(settings$meta.analysis$update))) { - PEcAn.logger::logger.info("meta.analysis update can only be AUTO/TRUE/FALSE, defaulting to FALSE") + if ((settings$meta.analysis$update != "AUTO") + && is.na(as.logical(settings$meta.analysis$update))) { + PEcAn.logger::logger.info( + "meta.analysis update can only be AUTO/TRUE/FALSE, defaulting to FALSE") settings$meta.analysis$update <- FALSE } } - + settings <- check.model.settings(settings, dbcon) - + ## if run$host is localhost, set to "localhost - if (any(settings$host %in% c(Sys.info()['nodename'], gsub("illinois", "uiuc", Sys.info()['nodename'])))){ + if (any( + settings$host %in% c( + Sys.info()["nodename"], + gsub("illinois", "uiuc", Sys.info()["nodename"])))) { settings$host$name <- "localhost" } - + # check if we need to use qsub if ("qsub" %in% names(settings$host)) { if (is.null(settings$host$qsub)) { settings$host$qsub <- "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash" - PEcAn.logger::logger.info("qsub not specified using default value :", settings$host$qsub) + PEcAn.logger::logger.info( + "qsub not specified using default value :", settings$host$qsub) } if (is.null(settings$host$qsub.jobid)) { settings$host$qsub.jobid <- "Your job ([0-9]+) .*" - PEcAn.logger::logger.info("qsub.jobid not specified using default value :", settings$host$qsub.jobid) + PEcAn.logger::logger.info( + "qsub.jobid not specified using default value :", + settings$host$qsub.jobid) } if (is.null(settings$host$qstat)) { settings$host$qstat <- "qstat -j @JOBID@ &> /dev/null || echo DONE" - PEcAn.logger::logger.info("qstat not specified using default value :", settings$host$qstat) + PEcAn.logger::logger.info( + "qstat not specified using default value :", settings$host$qstat) } } - + # modellauncher to launch on multiple nodes/cores if ("modellauncher" %in% names(settings$host)) { if (is.null(settings$host$modellauncher$binary)) { settings$host$modellauncher$binary <- "modellauncher" - PEcAn.logger::logger.info("binary not specified using default value :", settings$host$modellauncher$binary) + PEcAn.logger::logger.info( + "binary not specified using default value :", + settings$host$modellauncher$binary) } if (is.null(settings$host$modellauncher$qsub.extra)) { - PEcAn.logger::logger.severe("qsub.extra not specified, can not launch in parallel environment.") + PEcAn.logger::logger.severe( + "qsub.extra not specified, can not launch in parallel environment.") } if (is.null(settings$host$modellauncher$mpirun)) { settings$host$modellauncher$mpirun <- "mpirun" - PEcAn.logger::logger.info("mpirun not specified using default value :", settings$host$modellauncher$mpirun) + PEcAn.logger::logger.info( + "mpirun not specified using default value :", + settings$host$modellauncher$mpirun) } } - + # some warnings for deprecated job.sh if ("job.sh" %in% names(settings$model)) { if ("prerun" %in% names(settings$model)) { - PEcAn.logger::logger.severe("You have both settings$model$job.sh and settings$model$prerun, please combine.") + PEcAn.logger::logger.severe( + "You have both settings$model$job.sh and settings$model$prerun,", + "please combine.") } - PEcAn.logger::logger.info("settings$model$job.sh is deprecated use settings$model$prerun instead.") + PEcAn.logger::logger.info( + "settings$model$job.sh is deprecated use settings$model$prerun instead.") settings$model$prerun <- settings$model$job.sh settings$model$job.sh <- NULL } if ("job.sh" %in% names(settings$host)) { if ("prerun" %in% names(settings$host)) { - PEcAn.logger::logger.severe("You have both settings$host$job.sh and settings$host$prerun, please combine.") + PEcAn.logger::logger.severe( + "You have both settings$host$job.sh and settings$host$prerun,", + "please combine.") } - PEcAn.logger::logger.info("settings$host$job.sh is deprecated use settings$host$prerun instead.") + PEcAn.logger::logger.info( + "settings$host$job.sh is deprecated use settings$host$prerun instead.") settings$host$prerun <- settings$host$job.sh settings$host$job.sh <- NULL } - + # Check folder where outputs are written before adding to dbfiles - if(is.null(settings$database$dbfiles)) { + if (is.null(settings$database$dbfiles)) { settings$database$dbfiles <- PEcAn.utils::full.path("~/.pecan/dbfiles") } else { - if (substr(settings$database$dbfiles, 1, 1) != '/'){ - PEcAn.logger::logger.warn("settings$database$dbfiles pathname", settings$database$dbfiles, " is invalid\n - placing it in the home directory ", Sys.getenv("HOME")) - settings$database$dbfiles <- file.path(Sys.getenv("HOME"), settings$database$dbfiles) - } - - settings$database$dbfiles <- normalizePath(settings$database$dbfiles, mustWork=FALSE) + if (substr(settings$database$dbfiles, 1, 1) != "/") { + PEcAn.logger::logger.warn( + "settings$database$dbfiles pathname", settings$database$dbfiles, + "is invalid\n", + "placing it in the home directory ", + Sys.getenv("HOME")) + settings$database$dbfiles <- file.path( + Sys.getenv("HOME"), + settings$database$dbfiles) + } + + settings$database$dbfiles <- normalizePath( + settings$database$dbfiles, + mustWork = FALSE) } dir.create(settings$database$dbfiles, showWarnings = FALSE, recursive = TRUE) - + # check all inputs exist settings <- papply(settings, check.inputs) - + settings <- check.workflow.settings(settings, dbcon) - + # check/create the local run folder if (is.null(settings$rundir)) { settings$rundir <- file.path(settings$outdir, "run") } - if (!file.exists(settings$rundir) && !dir.create(settings$rundir, recursive=TRUE)) { + if (!file.exists(settings$rundir) + && !dir.create(settings$rundir, recursive = TRUE)) { PEcAn.logger::logger.severe("Could not create run folder", settings$rundir) } - + # check/create the local model out folder if (is.null(settings$modeloutdir)) { settings$modeloutdir <- file.path(settings$outdir, "out") } - if (!file.exists(settings$modeloutdir) && !dir.create(settings$modeloutdir, recursive=TRUE)) { - PEcAn.logger::logger.severe("Could not create model out folder", settings$modeloutdir) + if (!file.exists(settings$modeloutdir) + && !dir.create(settings$modeloutdir, recursive = TRUE)) { + PEcAn.logger::logger.severe( + "Could not create model out folder", settings$modeloutdir) } - + # make sure remote folders are specified if need be if (!PEcAn.remote::is.localhost(settings$host)) { if (is.null(settings$host$folder)) { - settings$host$folder <- paste0(remote.execute.cmd("pwd", host=settings$host), "/pecan_remote") - PEcAn.logger::logger.info("Using ", settings$host$folder, "to store output on remote machine") + settings$host$folder <- paste0( + PEcAn.remote::remote.execute.cmd("pwd", host = settings$host), + "/pecan_remote") + PEcAn.logger::logger.info( + "Using ", settings$host$folder, "to store output on remote machine") } if (is.null(settings$host$rundir)) { settings$host$rundir <- paste0(settings$host$folder, "/@WORKFLOW@/run") } - settings$host$rundir <- gsub("@WORKFLOW@", settings$workflow$id, settings$host$rundir) - PEcAn.logger::logger.info("Using ", settings$host$rundir, "to store runs on remote machine") + settings$host$rundir <- gsub( + "@WORKFLOW@", + settings$workflow$id, + settings$host$rundir) + PEcAn.logger::logger.info( + "Using ", settings$host$rundir, "to store runs on remote machine") if (is.null(settings$host$outdir)) { settings$host$outdir <- paste0(settings$host$folder, "/@WORKFLOW@/out") } - settings$host$outdir <- gsub("@WORKFLOW@", settings$workflow$id, settings$host$outdir) - PEcAn.logger::logger.info("Using ", settings$host$outdir, "to store output on remote machine") + settings$host$outdir <- gsub( + "@WORKFLOW@", + settings$workflow$id, + settings$host$outdir) + PEcAn.logger::logger.info( + "Using ", settings$host$outdir, "to store output on remote machine") } else if (settings$host$name == "localhost") { settings$host$rundir <- settings$rundir settings$host$outdir <- settings$modeloutdir } - + # check/create the pft folders if (!is.null(settings$pfts) && (length(settings$pfts) > 0)) { - for (i in 1:length(settings$pfts)) { + for (i in seq_along(settings$pfts)) { #check if name tag within pft if (!"name" %in% names(settings$pfts[i]$pft)) { - PEcAn.logger::logger.severe("No name specified for pft of index: ", i, ", please specify name") + PEcAn.logger::logger.severe( + "No name specified for pft of index: ", i, ", please specify name") } if (settings$pfts[i]$pft$name == "") { - PEcAn.logger::logger.severe("Name specified for pft of index: ", i, " can not be empty.") + PEcAn.logger::logger.severe( + "Name specified for pft of index: ", i, " can not be empty.") } - - #check to see if name of each pft in xml file is actually a name of a pft already in database - if (!is.null(dbcon)) {# change to if(class(dbcon) == "PostgreSQLConnection")?? + + # check to see if name of each pft in xml file is actually + # a name of a pft already in database + if (!is.null(dbcon)) { # change to if(inherits(dbcon, "PostgreSQLConnection")) ?? if (is.null(settings$model$type)) { - x <- PEcAn.DB::db.query(paste0("SELECT pfts.id FROM pfts", - " WHERE pfts.name = '", settings$pfts[i]$pft$name, "'"), con=dbcon) + x <- PEcAn.DB::db.query( + paste0( + "SELECT pfts.id FROM pfts", + " WHERE pfts.name = '", settings$pfts[i]$pft$name, "'"), + con = dbcon) } else { - x <- PEcAn.DB::db.query(paste0("SELECT pfts.id FROM pfts, modeltypes", - " WHERE pfts.name = '", settings$pfts[i]$pft$name, "'", - " AND modeltypes.name='", settings$model$type, "'", - " AND modeltypes.id=pfts.modeltype_id;"), con=dbcon) + x <- PEcAn.DB::db.query( + paste0( + "SELECT pfts.id FROM pfts, modeltypes", + " WHERE pfts.name = '", settings$pfts[i]$pft$name, "'", + " AND modeltypes.name='", settings$model$type, "'", + " AND modeltypes.id=pfts.modeltype_id;"), + con = dbcon) } if (nrow(x) == 0) { - PEcAn.logger::logger.severe("Did not find a pft with name ", settings$pfts[i]$pft$name, - "\nfor model type", settings$model$type) + PEcAn.logger::logger.severe( + "Did not find a pft with name ", settings$pfts[i]$pft$name, + "\nfor model type", settings$model$type) } if (nrow(x) > 1) { - PEcAn.logger::logger.warn("Found multiple entries for pft with name ", settings$pfts[i]$pft$name, - "\nfor model type", settings$model$type) + PEcAn.logger::logger.warn( + "Found multiple entries for pft with name ", + settings$pfts[i]$pft$name, + "\nfor model type", settings$model$type) } } - + if (is.null(settings$pfts[i]$pft$outdir)) { - settings$pfts[i]$pft$outdir <- file.path(settings$outdir, "pft", settings$pfts[i]$pft$name) - PEcAn.logger::logger.info("Storing pft", settings$pfts[i]$pft$name, "in", settings$pfts[i]$pft$outdir) + settings$pfts[i]$pft$outdir <- file.path( + settings$outdir, + "pft", + settings$pfts[i]$pft$name) + PEcAn.logger::logger.info( + "Storing pft", settings$pfts[i]$pft$name, + "in", settings$pfts[i]$pft$outdir) } else { - PEcAn.logger::logger.debug("Storing pft", settings$pfts[i]$pft$name, "in", settings$pfts[i]$pft$outdir) + PEcAn.logger::logger.debug( + "Storing pft", settings$pfts[i]$pft$name, + "in", settings$pfts[i]$pft$outdir) } out.dir <- settings$pfts[i]$pft$outdir - if (!file.exists(out.dir) && !dir.create(out.dir, recursive=TRUE)) { - if(identical(dir(out.dir), character(0))){ + if (!file.exists(out.dir) && !dir.create(out.dir, recursive = TRUE)) { + if (identical(dir(out.dir), character(0))) { PEcAn.logger::logger.warn(out.dir, "exists but is empty") } else { - PEcAn.logger::logger.severe("Could not create folder", out.dir) + PEcAn.logger::logger.severe("Could not create folder", out.dir) } } } } - - # Set 'checked' flag so check.settings will be skipped in the future (unless force=TRUE) + + # Set 'checked' flag so check.settings will be skipped in the future + # (unless force=TRUE) settings$settings.info$checked <- TRUE - + # all done return cleaned up settings return(invisible(settings)) } -##' @title Check Run Settings -##' @param settings settings file -##' @export check.run.settings -check.run.settings <- function(settings, dbcon=NULL) { - scipen = getOption("scipen") - options(scipen=12) - +#' @title Check Run Settings +#' @param settings settings file +#' @export check.run.settings +check.run.settings <- function(settings, dbcon = NULL) { + scipen <- getOption("scipen") + on.exit(options(scipen = scipen), add = TRUE) + options(scipen = 12) + # check for a run settings - if (is.null(settings[['run']])) { + if (is.null(settings[["run"]])) { PEcAn.logger::logger.warn("No Run Settings specified") } - - + + # check start/end date are specified and correct if (is.null(settings$run$start.date)) { PEcAn.logger::logger.warn("No start.date specified in run section.") } else if (is.null(settings$run$end.date)) { PEcAn.logger::logger.warn("No end.date specified in run section.") } else { - startdate <- lubridate::parse_date_time(settings$run$start.date, "ymd_HMS", truncated=3) - enddate <- lubridate::parse_date_time(settings$run$end.date, "ymd_HMS", truncated=3) + startdate <- lubridate::parse_date_time( + settings$run$start.date, + "ymd_HMS", + truncated = 3) + enddate <- lubridate::parse_date_time( + settings$run$end.date, + "ymd_HMS", + truncated = 3) if (startdate >= enddate) { PEcAn.logger::logger.severe("Start date should come before the end date.") } } - + # check sensitivity analysis if (!is.null(settings$sensitivity.analysis)) { if (is.null(settings$sensitivity.analysis$variable)) { if (is.null(settings$ensemble$variable)) { - PEcAn.logger::logger.severe("No variable specified to compute sensitivity.analysis for.") + PEcAn.logger::logger.severe( + "No variable specified to compute sensitivity.analysis for.") } - PEcAn.logger::logger.info("Setting sensitivity.analysis variable to the same as ensemble variable [", - settings$ensemble$variable, "]") + PEcAn.logger::logger.info( + "Setting sensitivity.analysis variable to the same as", + "ensemble variable [", settings$ensemble$variable, "]") settings$sensitivity.analysis$variable <- settings$ensemble$variable } - - if(is.null(settings$sensitivity.analysis$start.year)) { - if(!is.null(settings$run$start.date)) { - settings$sensitivity.analysis$start.year <- lubridate::year(settings$run$start.date) - PEcAn.logger::logger.info("No start date passed to sensitivity.analysis - using the run date (", - settings$sensitivity.analysis$start.year, ").") - } else if(!is.null(settings$ensemble$start.year)) { - settings$sensitivity.analysis$start.year <- settings$ensemble$start.year - PEcAn.logger::logger.info("No start date passed to sensitivity.analysis - using the ensemble date (", - settings$sensitivity.analysis$start.year, ").") + + if (is.null(settings$sensitivity.analysis$start.year)) { + if (!is.null(settings$run$start.date)) { + settings$sensitivity.analysis$start.year <- lubridate::year( + settings$run$start.date) + PEcAn.logger::logger.info( + "No start date passed to sensitivity.analysis - using the run date (", + settings$sensitivity.analysis$start.year, ").") + } else if (!is.null(settings$ensemble$start.year)) { + settings$sensitivity.analysis$start.year <- settings$ensemble$start.year + PEcAn.logger::logger.info( + "No start date passed to sensitivity.analysis -", + "using the ensemble date (", + settings$sensitivity.analysis$start.year, ").") } else { - PEcAn.logger::logger.info("No start date passed to sensitivity.analysis, and no default available.") + PEcAn.logger::logger.info( + "No start date passed to sensitivity.analysis,", + "and no default available.") } } - - if(is.null(settings$sensitivity.analysis$end.year)) { - if(!is.null(settings$run$end.date)) { - settings$sensitivity.analysis$end.year <- lubridate::year(settings$run$end.date) - PEcAn.logger::logger.info("No end date passed to sensitivity.analysis - using the run date (", - settings$sensitivity.analysis$end.year, ").") - } else if(!is.null(settings$ensemble$end.year)){ - settings$sensitivity.analysis$end.year <- settings$ensemble$end.year - PEcAn.logger::logger.info("No end date passed to sensitivity.analysis - using the ensemble date (", - settings$sensitivity.analysis$end.year, ").") + + if (is.null(settings$sensitivity.analysis$end.year)) { + if (!is.null(settings$run$end.date)) { + settings$sensitivity.analysis$end.year <- lubridate::year( + settings$run$end.date) + PEcAn.logger::logger.info( + "No end date passed to sensitivity.analysis - using the run date (", + settings$sensitivity.analysis$end.year, ").") + } else if (!is.null(settings$ensemble$end.year)) { + settings$sensitivity.analysis$end.year <- settings$ensemble$end.year + PEcAn.logger::logger.info( + "No end date passed to sensitivity.analysis.", + "Using the ensemble date (", + settings$sensitivity.analysis$end.year, ").") } else { - PEcAn.logger::logger.info("No end date passed to sensitivity.analysis, and no default available.") + PEcAn.logger::logger.info( + "No end date passed to sensitivity.analysis,", + "and no default available.") } } - - + + # check start and end dates - if (exists("startdate") && !is.null(settings$sensitivity.analysis$start.year) && - lubridate::year(startdate) > settings$sensitivity.analysis$start.year) { - PEcAn.logger::logger.severe("Start year of SA should come after the start.date of the run") + if (exists("startdate") + && !is.null(settings$sensitivity.analysis$start.year) + && lubridate::year(startdate) > settings$sensitivity.analysis$start.year) { + PEcAn.logger::logger.severe( + "Start year of SA should come after the start.date of the run") } - if (exists("enddate") && !is.null(settings$sensitivity.analysis$end.year) && - lubridate::year(enddate) < settings$sensitivity.analysis$end.year) { - PEcAn.logger::logger.severe("End year of SA should come before the end.date of the run") + if (exists("enddate") + && !is.null(settings$sensitivity.analysis$end.year) + && lubridate::year(enddate) < settings$sensitivity.analysis$end.year) { + PEcAn.logger::logger.severe( + "End year of SA should come before the end.date of the run") } - if (!is.null(settings$sensitivity.analysis$start.year) && + if (!is.null(settings$sensitivity.analysis$start.year) && !is.null(settings$sensitivity.analysis$end.year) && settings$sensitivity.analysis$start.year > settings$sensitivity.analysis$end.year) { - PEcAn.logger::logger.severe("Start year of SA should come before the end year of the SA") + PEcAn.logger::logger.severe( + "Start year of SA should come before the end year of the SA") } } - - + + # check siteid with values - if(!is.null(settings$run$site)){ + if (!is.null(settings$run$site)) { if (is.null(settings$run$site$id)) { settings$run$site$id <- -1 } else if (settings$run$site$id >= 0) { if (!is.null(dbcon)) { - site <- PEcAn.DB::db.query(paste("SELECT sitename, ST_X(ST_CENTROID(geometry)) AS lon, ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id =", settings$run$site$id), con=dbcon) + site <- PEcAn.DB::db.query( + paste( + "SELECT sitename, ST_X(ST_CENTROID(geometry)) AS lon, ", + "ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id =", + settings$run$site$id), + con = dbcon) } else { - site <- data.frame(id=settings$run$site$id) + site <- data.frame(id = settings$run$site$id) if (!is.null(settings$run$site$name)) { - site$sitename=settings$run$site$name + site$sitename <- settings$run$site$name } if (!is.null(settings$run$site$lat)) { - site$lat=settings$run$site$lat + site$lat <- settings$run$site$lat } if (!is.null(settings$run$site$lon)) { - site$lon=settings$run$site$lon + site$lon <- settings$run$site$lon } } - if((!is.null(settings$run$site$met)) && settings$run$site$met == "NULL") settings$run$site$met <- NULL + if ((!is.null(settings$run$site$met)) + && settings$run$site$met == "NULL") { + settings$run$site$met <- NULL + } if (is.null(settings$run$site$name)) { if ((is.null(site$sitename) || site$sitename == "")) { PEcAn.logger::logger.info("No site name specified.") settings$run$site$name <- "NA" } else { - settings$run$site$name <- site$sitename - PEcAn.logger::logger.info("Setting site name to ", settings$run$site$name) + settings$run$site$name <- site$sitename + PEcAn.logger::logger.info( + "Setting site name to ", settings$run$site$name) } } else if (site$sitename != settings$run$site$name) { - PEcAn.logger::logger.warn("Specified site name [", settings$run$site$name, "] does not match sitename in database [", site$sitename, "]") + PEcAn.logger::logger.warn( + "Specified site name [", settings$run$site$name, + "] does not match sitename in database [", site$sitename, "]") } - + if (is.null(settings$run$site$lat)) { if ((is.null(site$lat) || site$lat == "")) { PEcAn.logger::logger.severe("No lat specified for site.") } else { settings$run$site$lat <- as.numeric(site$lat) - PEcAn.logger::logger.info("Setting site lat to ", settings$run$site$lat) + PEcAn.logger::logger.info( + "Setting site lat to ", settings$run$site$lat) } } else if (as.numeric(site$lat) != as.numeric(settings$run$site$lat)) { - PEcAn.logger::logger.warn("Specified site lat [", settings$run$site$lat, "] does not match lat in database [", site$lat, "]") + PEcAn.logger::logger.warn( + "Specified site lat [", settings$run$site$lat, + "] does not match lat in database [", site$lat, "]") } - + if (is.null(settings$run$site$lon)) { if ((is.null(site$lon) || site$lon == "")) { PEcAn.logger::logger.severe("No lon specified for site.") } else { settings$run$site$lon <- as.numeric(site$lon) - PEcAn.logger::logger.info("Setting site lon to ", settings$run$site$lon) + PEcAn.logger::logger.info( + "Setting site lon to ", settings$run$site$lon) } } else if (as.numeric(site$lon) != as.numeric(settings$run$site$lon)) { - PEcAn.logger::logger.warn("Specified site lon [", settings$run$site$lon, "] does not match lon in database [", site$lon, "]") + PEcAn.logger::logger.warn( + "Specified site lon [", settings$run$site$lon, + "] does not match lon in database [", site$lon, "]") } } } else { settings$run$site$id <- -1 } # end site check code - - options(scipen=scipen) - + # all done return cleaned up settings invisible(settings) } -##' @title Check Model Settings -##' @param settings settings file -##' @export check.model.settings -check.model.settings <- function(settings, dbcon=NULL) { +#' @title Check Model Settings +#' @param settings settings file +#' @export check.model.settings +check.model.settings <- function(settings, dbcon = NULL) { # check modelid with values - if(!is.null(settings$model)){ - if(!is.null(dbcon)){ - if(!is.null(settings$model$id)){ - if(as.numeric(settings$model$id) >= 0){ - model <- PEcAn.DB::db.query(paste0("SELECT models.id AS id, models.revision AS revision, modeltypes.name AS type FROM models, modeltypes WHERE models.id=", settings$model$id, " AND models.modeltype_id=modeltypes.id;"), con=dbcon) - if(nrow(model) == 0) { - PEcAn.logger::logger.error("There is no record of model_id = ", settings$model$id, "in database") + if (!is.null(settings$model)) { + if (!is.null(dbcon)) { + if (!is.null(settings$model$id)) { + if (as.numeric(settings$model$id) >= 0) { + model <- PEcAn.DB::db.query( + paste0( + "SELECT models.id AS id, models.revision AS revision, ", + "modeltypes.name AS type", + " FROM models, modeltypes WHERE models.id=", + settings$model$id, + " AND models.modeltype_id=modeltypes.id;"), + con = dbcon) + if (nrow(model) == 0) { + PEcAn.logger::logger.error( + "There is no record of model_id = ", settings$model$id, + "in database") } } else { model <- list() } } else if (!is.null(settings$model$type)) { - model <- PEcAn.DB::db.query(paste0("SELECT models.id AS id, models.revision AS revision, modeltypes.name AS type FROM models, modeltypes ", - "WHERE modeltypes.name = '", toupper(settings$model$type), "' ", - "AND models.modeltype_id=modeltypes.id ", - ifelse(is.null(settings$model$revision), "", - paste0("AND revision like '%", settings$model$revision, "%' ")), - "ORDER BY models.updated_at"), con=dbcon) - if(nrow(model) > 1){ - PEcAn.logger::logger.warn("multiple records for", settings$model$name, "returned; using the latest") + model <- PEcAn.DB::db.query( + paste0( + "SELECT models.id AS id, models.revision AS revision, ", + "modeltypes.name AS type FROM models, modeltypes ", + "WHERE modeltypes.name = '", toupper(settings$model$type), "' ", + "AND models.modeltype_id=modeltypes.id ", + ifelse( + is.null(settings$model$revision), "", + paste0("AND revision like '%", settings$model$revision, "%' ")), + "ORDER BY models.updated_at"), + con = dbcon) + if (nrow(model) > 1) { + PEcAn.logger::logger.warn( + "multiple records for", settings$model$type, + "returned; using the latest") row <- which.max(model$updated_at) if (length(row) == 0) row <- nrow(model) model <- model[row, ] } else if (nrow(model) == 0) { - PEcAn.logger::logger.warn("Model type", settings$model$type, "not in database") + PEcAn.logger::logger.warn( + "Model type", settings$model$type, "not in database") } } else { PEcAn.logger::logger.warn("no model settings given") @@ -683,14 +851,15 @@ check.model.settings <- function(settings, dbcon=NULL) { } else { model <- list() } - + # copy data from database into missing fields if (!is.null(model$id)) { if (is.null(settings$model$id) || (settings$model$id == "")) { settings$model$id <- model$id PEcAn.logger::logger.info("Setting model id to ", settings$model$id) } else if (settings$model$id != model$id) { - PEcAn.logger::logger.warn("Model id specified in settings file does not match database.") + PEcAn.logger::logger.warn( + "Model id specified in settings file does not match database.") } } else { if (is.null(settings$model$id) || (settings$model$id == "")) { @@ -703,210 +872,285 @@ check.model.settings <- function(settings, dbcon=NULL) { settings$model$type <- model$type PEcAn.logger::logger.info("Setting model type to ", settings$model$type) } else if (settings$model$type != model$type) { - PEcAn.logger::logger.warn("Model type specified in settings file does not match database.") + PEcAn.logger::logger.warn( + "Model type specified in settings file does not match database.") } } if (!is.null(model$revision)) { if (is.null(settings$model$revision) || (settings$model$revision == "")) { settings$model$revision <- model$revision - PEcAn.logger::logger.info("Setting model revision to ", settings$model$revision) + PEcAn.logger::logger.info( + "Setting model revision to ", settings$model$revision) } else if (settings$model$revision != model$revision) { - PEcAn.logger::logger.warn("Model revision specified in settings file does not match database.") + PEcAn.logger::logger.warn( + "Model revision specified in settings file does not match database.") } } - + # make sure we have model type if ((is.null(settings$model$type) || settings$model$type == "")) { PEcAn.logger::logger.severe("Need a model type.") } - + # Set model$delete.raw to FALSE by default - if (is.null(settings$model$delete.raw) || !is.logical(as.logical(settings$model$delete.raw))) { - PEcAn.logger::logger.info("Option to delete raw model output not set or not logical. Will keep all model output.") - settings$model$delete.raw = FALSE + if (is.null(settings$model$delete.raw) + || !is.logical(as.logical(settings$model$delete.raw))) { + PEcAn.logger::logger.info( + "Option to delete raw model output not set or not logical.", + "Will keep all model output.") + settings$model$delete.raw <- FALSE } - + # check on binary for given host if (!is.null(settings$model$id) && (settings$model$id >= 0)) { - binary <- PEcAn.DB::dbfile.file("Model", settings$model$id, dbcon, settings$host$name) + binary <- PEcAn.DB::dbfile.file( + "Model", + settings$model$id, + dbcon, + settings$host$name) if (!is.na(binary)) { if (is.null(settings$model$binary)) { settings$model$binary <- binary - PEcAn.logger::logger.info("Setting model binary to ", settings$model$binary) + PEcAn.logger::logger.info( + "Setting model binary to ", settings$model$binary) } else if (binary != settings$model$binary) { - PEcAn.logger::logger.warn("Specified binary [", settings$model$binary, "] does not match path in database [", binary, "]") + PEcAn.logger::logger.warn( + "Specified binary [", settings$model$binary, + "] does not match path in database [", binary, "]") } } } else { - PEcAn.logger::logger.warn("No model binary sepcified in database for model ", settings$model$type) + PEcAn.logger::logger.warn( + "No model binary sepcified in database for model ", settings$model$type) } } - + return(settings) } -##' @title Check Workflow Settings -##' @param settings settings file -##' @export check.workflow.settings -check.workflow.settings <- function(settings, dbcon=NULL) { +#' @title Check Workflow Settings +#' @param settings settings file +#' @export check.workflow.settings +check.workflow.settings <- function(settings, dbcon = NULL) { # check for workflow defaults fixoutdir <- FALSE - if(!is.null(dbcon) && settings$database$bety$write && ("model" %in% names(settings))) { - if (!'workflow' %in% names(settings)) { + if (!is.null(dbcon) + && settings$database$bety$write + && ("model" %in% names(settings))) { + if (!"workflow" %in% names(settings)) { now <- format(Sys.time(), "%Y-%m-%d %H:%M:%S") - if(is.MultiSettings(settings)) { - PEcAn.DB::db.query(paste0("INSERT INTO workflows (folder, model_id, hostname, started_at, created_at) values ('", - settings$outdir, "','" , settings$model$id, "', '", settings$host$name, "', '", - now, "', '", now, "')"), con=dbcon) - } else { - PEcAn.DB::db.query(paste0("INSERT INTO workflows (folder, site_id, model_id, hostname, start_date, end_date, started_at, created_at) values ('", - settings$outdir, "','" , settings$run$site$id, "','", settings$model$id, "', '", settings$host$name, "', '", - settings$run$start.date, "', '", settings$run$end.date, "', '", now, "', '", now, "')"), con=dbcon) + if (is.MultiSettings(settings)) { + insert_result <- PEcAn.DB::db.query( + paste0( + "INSERT INTO workflows (", + "folder, model_id, hostname, started_at) ", + "values ('", + settings$outdir, "','", + settings$model$id, "', '", + settings$host$name, "', '", + now, "') RETURNING id"), + con = dbcon) + } else { + insert_result <- PEcAn.DB::db.query( + paste0( + "INSERT INTO workflows (", + "folder, site_id, model_id, hostname, start_date, end_date, ", + "started_at) ", + "values ('", + settings$outdir, "','", + settings$run$site$id, "','", + settings$model$id, "', '", + settings$host$name, "', '", + settings$run$start.date, "', '", + settings$run$end.date, "', '", + now, "') RETURNING id"), + con = dbcon) } - settings$workflow$id <- PEcAn.DB::db.query(paste0("SELECT id FROM workflows WHERE created_at='", now, "' ORDER BY id DESC LIMIT 1;"), con=dbcon)[['id']] + settings$workflow$id <- insert_result[["id"]] fixoutdir <- TRUE } } else { settings$workflow$id <- format(Sys.time(), "%Y-%m-%d-%H-%M-%S") } - + # check/create the pecan folder if (is.null(settings$outdir)) { settings$outdir <- "PEcAn_@WORKFLOW@" } # replace @WORKFLOW@ with the id of the workflow - settings$outdir <- gsub("@WORKFLOW@", format(settings$workflow$id,scientific=FALSE), settings$outdir) + settings$outdir <- gsub( + "@WORKFLOW@", + format(settings$workflow$id, scientific = FALSE), + settings$outdir) # create fully qualified pathname - if (substr(settings$outdir, 1, 1) != '/') { + if (substr(settings$outdir, 1, 1) != "/") { settings$outdir <- file.path(getwd(), settings$outdir) } PEcAn.logger::logger.info("output folder =", settings$outdir) - if (!file.exists(settings$outdir) && !dir.create(settings$outdir, recursive=TRUE)) { + if (!file.exists(settings$outdir) + && !dir.create(settings$outdir, recursive = TRUE)) { PEcAn.logger::logger.severe("Could not create folder", settings$outdir) } - + #update workflow if (fixoutdir) { - PEcAn.DB::db.query(paste0("UPDATE workflows SET folder='", PEcAn.utils::full.path(settings$outdir), "' WHERE id=", settings$workflow$id), con=dbcon) + PEcAn.DB::db.query( + paste0( + "UPDATE workflows SET folder='", + PEcAn.utils::full.path(settings$outdir), + "' WHERE id=", settings$workflow$id), + con = dbcon) } - + return(settings) } -##' @title Check Database Settings -##' @param settings settings file -##' @export check.database.settings +#' @title Check Database Settings +#' @param settings settings file +#' @export check.database.settings check.database.settings <- function(settings) { if (!is.null(settings$database)) { # check all databases for (name in names(settings$database)) { - if(name != "dbfiles") # 'dbfiles' is kept in , but isn't actually a db settings block + if (name != "dbfiles") { + # 'dbfiles' is kept in , but isn't actually a db settings block settings$database[[name]] <- check.database(settings$database[[name]]) + } } - + # check bety database if (!is.null(settings$database$bety)) { # should runs be written to database if (is.null(settings$database$bety$write)) { - PEcAn.logger::logger.info("Writing all runs/configurations to database.") + PEcAn.logger::logger.info( + "Writing all runs/configurations to database.") settings$database$bety$write <- TRUE } else { settings$database$bety$write <- as.logical(settings$database$bety$write) if (settings$database$bety$write) { - PEcAn.logger::logger.debug("Writing all runs/configurations to database.") + PEcAn.logger::logger.debug( + "Writing all runs/configurations to database.") } else { - PEcAn.logger::logger.warn("Will not write runs/configurations to database.") + PEcAn.logger::logger.warn( + "Will not write runs/configurations to database.") } } - + # check if we can connect to the database with write permissions - if (settings$database$bety$write && !PEcAn.DB::db.exists(params=settings$database$bety, TRUE, table='users')) { - PEcAn.logger::logger.severe("Invalid Database Settings : ", unlist(settings$database)) + if (settings$database$bety$write + && !PEcAn.DB::db.exists( + params = settings$database$bety, + TRUE, + table = "users")) { + PEcAn.logger::logger.severe( + "Invalid Database Settings : ", unlist(settings$database)) } - + # TODO check userid and userpassword - + # Connect to database dbcon <- PEcAn.DB::db.open(settings$database$bety) - on.exit(PEcAn.DB::db.close(dbcon)) - + on.exit(PEcAn.DB::db.close(dbcon), add = TRUE) + # check database version check.bety.version(dbcon) } else { - PEcAn.logger::logger.warn("No BETY database information specified; not using database.") + PEcAn.logger::logger.warn( + "No BETY database information specified; not using database.") } } else { - PEcAn.logger::logger.warn("No BETY database information specified; not using database.") + PEcAn.logger::logger.warn( + "No BETY database information specified; not using database.") } return(settings) } -##' @title Check ensemble Settings -##' @param settings settings file -##' @export check.ensemble.settings +#' @title Check ensemble Settings +#' @param settings settings file +#' @export check.ensemble.settings check.ensemble.settings <- function(settings) { # check ensemble if (!is.null(settings$ensemble)) { if (is.null(settings$ensemble$variable)) { if (is.null(settings$sensitivity.analysis$variable)) { - PEcAn.logger::logger.severe("No variable specified to compute ensemble for.") + PEcAn.logger::logger.severe( + "No variable specified to compute ensemble for.") } - PEcAn.logger::logger.info("Setting ensemble variable to the same as sensitivity analysis variable [", settings$sensitivity.analysis$variable, "]") + PEcAn.logger::logger.info( + "Setting ensemble variable to the same as sensitivity analysis", + "variable [", settings$sensitivity.analysis$variable, "]") settings$ensemble$variable <- settings$sensitivity.analysis$variable } - + if (is.null(settings$ensemble$size)) { PEcAn.logger::logger.info("Setting ensemble size to 1.") settings$ensemble$size <- 1 } - - if(is.null(settings$ensemble$start.year)) { - if(!is.null(settings$run$start.date)) { - settings$ensemble$start.year <- lubridate::year(settings$run$start.date) - PEcAn.logger::logger.info("No start date passed to ensemble - using the run date (", - settings$ensemble$start.year, ").") - } else if(!is.null(settings$sensitivity.analysis$start.year)) { - settings$ensemble$start.year <- settings$sensitivity.analysis$start.year - PEcAn.logger::logger.info("No start date passed to ensemble - using the sensitivity.analysis date (", - settings$ensemble$start.year, ").") + + if (is.null(settings$ensemble$start.year)) { + if (!is.null(settings$run$start.date)) { + settings$ensemble$start.year <- lubridate::year( + settings$run$start.date) + PEcAn.logger::logger.info( + "No start date passed to ensemble - using the run date (", + settings$ensemble$start.year, ").") + } else if (!is.null(settings$sensitivity.analysis$start.year)) { + settings$ensemble$start.year <- settings$sensitivity.analysis$start.year + PEcAn.logger::logger.info( + "No start date passed to ensemble.", + "Using the sensitivity.analysis date (", + settings$ensemble$start.year, ").") } else { - PEcAn.logger::logger.info("No start date passed to ensemble, and no default available.") + PEcAn.logger::logger.info( + "No start date passed to ensemble, and no default available.") } } - - if(is.null(settings$ensemble$end.year)) { - if(!is.null(settings$run$end.date)) { - settings$ensemble$end.year <- lubridate::year(settings$run$end.date) - PEcAn.logger::logger.info("No end date passed to ensemble - using the run date (", - settings$ensemble$end.year, ").") - } else if(!is.null(settings$sensitivity.analysis$end.year)){ - settings$ensemble$end.year <- settings$sensitivity.analysis$end.year - PEcAn.logger::logger.info("No end date passed to ensemble - using the sensitivity.analysis date (", - settings$ensemble$end.year, ").") + + if (is.null(settings$ensemble$end.year)) { + if (!is.null(settings$run$end.date)) { + settings$ensemble$end.year <- lubridate::year(settings$run$end.date) + PEcAn.logger::logger.info( + "No end date passed to ensemble - using the run date (", + settings$ensemble$end.year, ").") + } else if (!is.null(settings$sensitivity.analysis$end.year)) { + settings$ensemble$end.year <- settings$sensitivity.analysis$end.year + PEcAn.logger::logger.info( + "No end date passed to ensemble.", + "Using the sensitivity.analysis date (", + settings$ensemble$end.year, ").") } else { - PEcAn.logger::logger.info("No end date passed to ensemble, and no default available.") + PEcAn.logger::logger.info( + "No end date passed to ensemble, and no default available.") } } - + # check start and end dates if (exists("startdate") && !is.null(settings$ensemble$start.year) && lubridate::year(startdate) > settings$ensemble$start.year) { - PEcAn.logger::logger.severe("Start year of ensemble should come after the start.date of the run") + PEcAn.logger::logger.severe( + "Start year of ensemble should come after the start.date of the run") } if (exists("enddate") && !is.null(settings$ensemble$end.year) && lubridate::year(enddate) < settings$ensemble$end.year) { - PEcAn.logger::logger.severe("End year of ensemble should come before the end.date of the run") + PEcAn.logger::logger.severe( + "End year of ensemble should come before the end.date of the run") } - if (!is.null(settings$ensemble$start.year) && !is.null(settings$ensemble$end.year) && - settings$ensemble$start.year > settings$ensemble$end.year) { - PEcAn.logger::logger.severe("Start year of ensemble should come before the end year of the ensemble") + if (!is.null(settings$ensemble$start.year) + && !is.null(settings$ensemble$end.year) + && settings$ensemble$start.year > settings$ensemble$end.year) { + PEcAn.logger::logger.severe( + "Start year of ensemble should come before the end year of the ensemble") } } - #Old version of pecan xml files which they don't have a sampling space or it's just sampling space and nothing inside it. - if (is.null(settings$ensemble$samplingspace) | !is.list(settings$ensemble$samplingspace)){ - PEcAn.logger::logger.info("We are updating the ensemble tag inside the xml file.") - #I try to put ensemble method in older versions into the parameter space - If I fail (when no method is defined) I just set it as uniform + # Old version of pecan xml files which they don't have a sampling space + # or it's just sampling space and nothing inside it. + if (is.null(settings$ensemble$samplingspace) + || !is.list(settings$ensemble$samplingspace)) { + PEcAn.logger::logger.info( + "We are updating the ensemble tag inside the xml file.") + # I try to put ensemble method in older versions into the parameter space - + # If I fail (when no method is defined) I just set it as uniform settings$ensemble$samplingspace$parameters$method <- settings$ensemble$method if (is.null(settings$ensemble$samplingspace$parameters$method)) { settings$ensemble$samplingspace$parameters$method <- "uniform" diff --git a/base/settings/R/clean.settings.R b/base/settings/R/clean.settings.R index fba28a4b7bf..8cb101ab159 100644 --- a/base/settings/R/clean.settings.R +++ b/base/settings/R/clean.settings.R @@ -1,46 +1,49 @@ -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- -##' Cleans PEcAn settings file -##' -##' This will try and clean the settings file so it is ready for -##' a new run. This will remove all run specific information and -##' set the outdir to be 'pecan' for the next run. -##' @param inputfile the PEcAn settings file to be used. -##' @param outputfile the name of file to which the settings will be -##' written inside the outputdir. -##' @return list of all settings as saved to the XML file(s) -##' @export clean.settings -##' @author Rob Kooper -##' @examples -##' \dontrun{ -##' clean.settings('output/PEcAn_1/pecan.xml', 'pecan.xml') -##' } -clean.settings <- function(inputfile = "pecan.xml", outputfile = "pecan.xml", write=TRUE) { +#' Cleans PEcAn settings file +#' +#' This will try and clean the settings file so it is ready for +#' a new run. This will remove all run specific information and +#' set the outdir to be 'pecan' for the next run. +#' @param inputfile the PEcAn settings file to be used. +#' @param outputfile the name of file to which the settings will be +#' written inside the outputdir. +#' @return list of all settings as saved to the XML file(s) +#' @export clean.settings +#' @author Rob Kooper +#' @examples +#' \dontrun{ +#' clean.settings('output/PEcAn_1/pecan.xml', 'pecan.xml') +#' } +clean.settings <- function( + inputfile = "pecan.xml", + outputfile = "pecan.xml", + write = TRUE) { if (is.null(inputfile) || !file.exists(inputfile)) { PEcAn.logger::logger.severe("Could not find input file.") } settings <- XML::xmlToList(XML::xmlParse(inputfile)) - + # 1) change outdir settings$outdir <- "pecan" - + # 2) remove rundir/modeloutdir settings$rundir <- NULL settings$modeloutdir <- NULL - + # 3) remove all outdir under pft and remove poteriorid - for (i in 1:length(settings$pfts)) { + for (i in seq_along(settings$pfts)) { settings$pfts[i]$pft$outdir <- NULL settings$pfts[i]$pft$posteriorid <- NULL } - + # 4) remove rundir/outdir under host if localhost if (!is.null(settings$run$host)) { settings$host <- settings$run$host @@ -50,16 +53,16 @@ clean.settings <- function(inputfile = "pecan.xml", outputfile = "pecan.xml", wr settings$host$rundir <- NULL settings$host$outdir <- NULL } - + # 5) remove explicit location of storage settings$database$dbfiles <- NULL - + # 5) remove workflow completely (including id) settings$workflow <- NULL - + # save and done - if(write) XML::saveXML(listToXml(settings, "pecan"), file = outputfile) - + if (write) XML::saveXML(listToXml(settings, "pecan"), file = outputfile) + ## Return settings file as a list return(invisible(settings)) } # clean.settings diff --git a/base/settings/R/createMultisiteMultiSettings.r b/base/settings/R/createMultisiteMultiSettings.r index 1709fd1443a..33ba1479853 100644 --- a/base/settings/R/createMultisiteMultiSettings.r +++ b/base/settings/R/createMultisiteMultiSettings.r @@ -1,85 +1,100 @@ #' @title Create Sitegroup MultiSettings -#' -#' @description Helps to create a MultiSettings object to run some or all sites in a Sitegroup. -#' -#' @param templateSettings A \code{\link{Settings}} object that will be the template for the resulting -#' MultiSettings. +#' +#' @description Helps to create a MultiSettings object to run some or all +#' sites in a Sitegroup. +#' +#' @param templateSettings A \code{\link{Settings}} object that will be the +#' template for the resulting MultiSettings. #' @param sitegroupId The Bety ID of the sitegroup to draw from -#' @param nSite The number of sites to randomly select (without replacement) from the siteGroup. Omit -#' to use all sites in the group. -#' @param con,params Bety DB connection or parameters. passed directly to \code{\link[PEcAn.DB]{db.query}} -#' -#' @details -#' Starts with a template settings object, and fills in the \code{run} block with site info sampled from -#' the sitegroup. The template could be fully set up except for the site info, or more or less empty if you -#' plan to fill in the other settings later. A \code{\link{MultiSettings}} is created from \code{templateSettings}, -#' \code{nSite} sites (or all of them, if \code{nSite} is unset) are selected from Bety, and their info -#' is dropped into the \code{MultiSettings}. -#' -#' @return A \code{MultiSettings} object with the same settings as \code{templateSettings} but site -#' information for the selected sites -#' +#' @param nSite The number of sites to randomly select (without replacement) +#' from the siteGroup. Omit to use all sites in the group. +#' @param con,params Bety DB connection or parameters. +#' Passed directly to \code{\link[PEcAn.DB]{db.query}} +#' +#' @details +#' Starts with a template settings object, and fills in the \code{run} block +#' with site info sampled from the sitegroup. +#' The template could be fully set up except for the site info, +#' or more or less empty if you plan to fill in the other settings later. +#' A \code{\link{MultiSettings}} is created from \code{templateSettings}, +#' \code{nSite} sites (or all of them, if \code{nSite} is unset) are selected +#' from Bety, and their info is dropped into the \code{MultiSettings}. +#' +#' @return A \code{MultiSettings} object with the same settings as +#' \code{templateSettings} but site information for the selected sites +#' #' @author Ryan Kelly #' @export -#' +#' #' @example examples/examples.MultiSite.MultiSettings.r -createSitegroupMultiSettings = function(templateSettings, sitegroupId, nSite, con=NULL, params=templateSettings$database$bety) { - query <- paste("SELECT site_id FROM sitegroups_sites WHERE sitegroup_id =", sitegroupId) - allSites <- PEcAn.DB::db.query(query, con=con, params=params) - - if(missing(nSite)) +createSitegroupMultiSettings <- function( + templateSettings, + sitegroupId, + nSite, + con = NULL, + params = templateSettings$database$bety) { + query <- paste( + "SELECT site_id FROM sitegroups_sites WHERE sitegroup_id =", sitegroupId) + allSites <- PEcAn.DB::db.query(query, con = con, params = params) + + if (missing(nSite)) { siteIds <- allSites$site_id - else - siteIds <- sample(allSites$site_id, nSite, replace=FALSE) + } else { + siteIds <- sample(allSites$site_id, nSite, replace = FALSE) + } - settings <- createMultiSiteSettings(templateSettings, siteIds) + createMultiSiteSettings(templateSettings, siteIds) } #' @title Transform Settings into multi-site MultiSettings -#' -#' @description Create a MultiSettings object containing (identical) run blocks for multiple different -#' sites -#' -#' @param templateSettings A \code{\link{Settings}} object that will be the template for the resulting -#' MultiSettings. +#' +#' @description Create a MultiSettings object containing (identical) run blocks +#' for multiple different sites +#' +#' @param templateSettings A \code{\link{Settings}} object that will be +#' the template for the resulting MultiSettings. #' @param siteIds The site IDs to be used in the resulting MultiSettings - -#' @details -#' Starts with a template settings object, and duplicates the \code{run$site} block once for each -#' specified site ID. The resulting MultiSettings is thus identical to the input, except ready to run -#' for each site in the vector of site IDs. -#' -#' @return A \code{MultiSettings} object with the same settings as \code{templateSettings} but replicated -#' \code{run$site} blocks, one for each specified site ID. -#' +#' +#' @details +#' Starts with a template settings object, and duplicates the \code{run$site} +#' block once for each specified site ID. The resulting MultiSettings is thus +#' identical to the input, except ready to run for each site in the vector +#' of site IDs. +#' +#' @return A \code{MultiSettings} object with the same settings as +#' \code{templateSettings} but replicated \code{run$site} blocks, +#' one for each specified site ID. +#' #' @author Ryan Kelly #' @export -#' +#' #' @example examples/examples.MultiSite.MultiSettings.r createMultiSiteSettings <- function(templateSettings, siteIds) { templateSettings <- as.MultiSettings(templateSettings) - runSettings <- lapply(siteIds, getRunSettings, templateSettings=templateSettings) - - templateSettings[["run", global=FALSE]] <- runSettings + runSettings <- lapply( + siteIds, + getRunSettings, + templateSettings = templateSettings) + + templateSettings[["run", global = FALSE]] <- runSettings return(templateSettings) } -#' Build run MultiSettings for a list of site id's +#' Build run MultiSettings for a single site id #' -#' @param templateSettings -#' @param siteId +#' Processes one site from the `siteIds` argument of `createMultiSiteSettings`. +#' You probably don't need to call it directly. #' -#' @return +#' @inheritParams createMultiSiteSettings +#' @param siteId site to process. See `createMultiSiteSettings` #' @export -#' -#' @examples getRunSettings <- function(templateSettings, siteId) { - startDate = templateSettings$run$start.date - endDate = templateSettings$run$end.date - inputs = templateSettings$run$inputs + startDate <- templateSettings$run$start.date + endDate <- templateSettings$run$end.date + inputs <- templateSettings$run$inputs return(list( site = list( id = siteId, @@ -92,75 +107,82 @@ getRunSettings <- function(templateSettings, siteId) { } -#' @title Set the Ouptu Directories of PEcAn Settings -#' +#' @title Set the Output Directories of PEcAn Settings +#' #' @description Sets the main output directory and nulls out the others -#' +#' #' @param settings A \code{\link{Settings}} object #' @param outDir The desired output directory -#' -#' @details -#' Sets the main output directory (\code{settings$outdir}) to \code{outDir}, and sets numerous others -#' (\code{settings$modeloutdir}, \code{settings$host$rundir}, \code{settings$host$outdir}, -#' \code{settings$host$modeloutdir}) to NULL so they will revert to defaults when -#' \code{\link{check.settings}} is run. -#' +#' +#' @details +#' Sets the main output directory (\code{settings$outdir}) to \code{outDir}, +#' and sets numerous others (\code{settings$modeloutdir}, +#' \code{settings$host$rundir}, \code{settings$host$outdir}, +#' \code{settings$host$modeloutdir}) to NULL so they will revert to defaults +#' when \code{\link{check.settings}} is run. +#' #' @return The original \code{Settings} object with updated output directories -#' +#' #' @author Ryan Kelly #' @export setOutDir <- function(settings, outDir) { - settings$outdir <- outDir + settings$outdir <- outDir settings$rundir <- NULL settings$modeloutdir <- NULL settings$host$rundir <- NULL settings$host$outdir <- NULL settings$host$modeloutdir <- NULL - - for(j in 1:length(settings$pfts)) { + + for (j in seq_along(settings$pfts)) { settings$pfts[[j]]$outdir <- NULL } - + return(settings) } #' @title Set the Dates of PEcAn Settings -#' -#' @description Sets the run, ensemble, and sensitivity analysis dates of PEcAn Settings -#' +#' +#' @description Sets the run, ensemble, and sensitivity analysis dates +#' of PEcAn Settings +#' #' @param settings A \code{\link{Settings}} object #' @param startDate,endDate The desired start and end dates -#' -#' @details -#' Sets the start/end dates in \code{settings$run} to the specified dates, and sets the corresponding -#' years for \code{settings$ensemble} and \code{settings$sensitivity.analysis}. Either date can be -#' omitted to leave it unchanged. -#' +#' +#' @details +#' Sets the start/end dates in \code{settings$run} to the specified dates, +#' and sets the corresponding years for \code{settings$ensemble} and +#' \code{settings$sensitivity.analysis}. +#' Either date can be omitted to leave it unchanged. +#' #' @return The original \code{Settings} object with updated dates -#' +#' #' @author Ryan Kelly #' @export setDates <- function(settings, startDate, endDate) { - if(!missing(startDate)) { + if (!missing(startDate)) { settings$run$start.date <- startDate - - if(!is.null(settings$ensemble)) + + if (!is.null(settings$ensemble)) { settings$ensemble$start.year <- lubridate::year(startDate) + } - if(!is.null(settings$sensitivity.analysis)) + if (!is.null(settings$sensitivity.analysis)) { settings$sensitivity.analysis$start.year <- lubridate::year(startDate) + } } - - if(!missing(endDate)) { + + if (!missing(endDate)) { settings$run$end.date <- endDate - - if(!is.null(settings$ensemble)) + + if (!is.null(settings$ensemble)) { settings$ensemble$end.year <- lubridate::year(endDate) + } - if(!is.null(settings$sensitivity.analysis)) + if (!is.null(settings$sensitivity.analysis)) { settings$sensitivity.analysis$end.year <- lubridate::year(endDate) + } } - + return(settings) } diff --git a/base/settings/R/fix.deprecated.settings.R b/base/settings/R/fix.deprecated.settings.R index c18272a1c6c..bd1da340567 100644 --- a/base/settings/R/fix.deprecated.settings.R +++ b/base/settings/R/fix.deprecated.settings.R @@ -1,63 +1,77 @@ -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -##------------------------------------------------------------------------------- -##' Checks for and attempts to fix deprecated settings structure -##' -##' @title Fix Deprecated Settings -##' @param settings settings list -##' @return updated settings list -##' @author Ryan Kelly -##' @export fix.deprecated.settings -fix.deprecated.settings <- function(settings, force=FALSE) { - if(!force && !is.null(settings$settings.info$deprecated.settings.fixed) && - settings$settings.info$deprecated.settings.fixed==TRUE) { - PEcAn.logger::logger.info("Deprecated settings have been fixed already. Skipping.") +##----------------------------------------------------------------------------- +#' Checks for and attempts to fix deprecated settings structure +#' +#' @title Fix Deprecated Settings +#' @param settings settings list +#' @return updated settings list +#' @author Ryan Kelly +#' @export fix.deprecated.settings +fix.deprecated.settings <- function(settings, force = FALSE) { + if (!force + && !is.null(settings$settings.info$deprecated.settings.fixed) + && settings$settings.info$deprecated.settings.fixed == TRUE) { + PEcAn.logger::logger.info( + "Deprecated settings have been fixed already. Skipping.") return(invisible(settings)) } else { PEcAn.logger::logger.info("Fixing deprecated settings...") } - - if(is.MultiSettings(settings)) { - return(invisible(papply(settings, fix.deprecated.settings, force=force))) + + if (is.MultiSettings(settings)) { + return(invisible(papply(settings, fix.deprecated.settings, force = force))) } - + # settings$model$jobtemplate - if(!is.null(settings$run$jobtemplate)) { - if(!is.null(settings$model$jobtemplate)) { - PEcAn.logger::logger.severe("You have both deprecated settings$run$jobtemplate and settings$model$jobtemplate. Use latter only.") + if (!is.null(settings$run$jobtemplate)) { + if (!is.null(settings$model$jobtemplate)) { + PEcAn.logger::logger.severe( + "You have both deprecated settings$run$jobtemplate", + "and settings$model$jobtemplate. Use latter only.") } - PEcAn.logger::logger.info("settings$run$jobtemplate is deprecated. uwe settings$model$jobtemplate instead") + PEcAn.logger::logger.info( + "settings$run$jobtemplate is deprecated.", + "use settings$model$jobtemplate instead") settings$model$jobtemplate <- settings$run$jobtemplate settings$run$jobtemplate <- NULL } - + # settings$database$dbfiles - if(!is.null(settings$run$dbfiles)) { - if(!is.null(settings$database$dbfiles)) { - PEcAn.logger::logger.severe("You have both deprecated settings$run$dbfiles and settings$database$dbfiles. Use latter only.") + if (!is.null(settings$run$dbfiles)) { + if (!is.null(settings$database$dbfiles)) { + PEcAn.logger::logger.severe( + "You have both deprecated settings$run$dbfiles", + "and settings$database$dbfiles. Use latter only.") } - PEcAn.logger::logger.info("settings$run$dbfiles is deprecated. uwe settings$database$dbfiles instead") + PEcAn.logger::logger.info( + "settings$run$dbfiles is deprecated.", + "use settings$database$dbfiles instead") settings$database$dbfiles <- settings$run$dbfiles settings$run$dbfiles <- NULL } - + # settings$host - if(!is.null(settings$run$host)) { - if(!is.null(settings$host)) { - PEcAn.logger::logger.severe("You have both deprecated settings$run$host and settings$host. Use latter only.") + if (!is.null(settings$run$host)) { + if (!is.null(settings$host)) { + PEcAn.logger::logger.severe( + "You have both deprecated settings$run$host and settings$host.", + "Use latter only.") } - PEcAn.logger::logger.info("settings$run$host is deprecated. uwe settings$host instead") + PEcAn.logger::logger.info( + "settings$run$host is deprecated. use settings$host instead") settings$host <- settings$run$host settings$run$host <- NULL } - - # Set 'checked' flag so fix.deprecated.settings will be skipped in the future (unless force=TRUE) + + # Set 'checked' flag so fix.deprecated.settings will be skipped in the future + # (unless force=TRUE) settings$settings.info$deprecated.settings.fixed <- TRUE - + return(settings) } diff --git a/base/settings/R/get_args.R b/base/settings/R/get_args.R new file mode 100644 index 00000000000..277ad5e0e53 --- /dev/null +++ b/base/settings/R/get_args.R @@ -0,0 +1,38 @@ +#' Get Args +#' +#' Used in web/workflow.R to parse command line arguments. +#' See also https://github.com/PecanProject/pecan/pull/2626. +#' +#' @return list generated by \link[optparse]{parse_args}; see there for details. +#' @export +#' +#' @examples +#' \dontrun{./web/workflow.R -h} +get_args <- function() { + option_list <- list( + optparse::make_option( + c("-s", "--settings"), + default = Sys.getenv("PECAN_SETTINGS", "pecan.xml"), + type = "character", + help = "Settings XML file", + metavar = "FILE", + ), + optparse::make_option( + c("-c", "--continue"), + default = FALSE, + action = "store_true", + type = "logical", + help = "Continue processing", + ) + ) + + parser <- optparse::OptionParser(option_list = option_list) + args <- optparse::parse_args(parser) + + if (!file.exists(args$settings)) { + optparse::print_help(parser) + stop(sprintf('--settings "%s" not a valid file\n', args$settings)) + } + + return(args) +} diff --git a/base/settings/R/listToXml.R b/base/settings/R/listToXml.R index e478d979766..c9b3ed5e37c 100644 --- a/base/settings/R/listToXml.R +++ b/base/settings/R/listToXml.R @@ -1,19 +1,19 @@ -##' @export +#' @export listToXml <- function(x, ...) { UseMethod("listToXml") } # listToXml -#--------------------------------------------------------------------------------------------------# -##' Convert List to XML -##' -##' Can convert list or other object to an xml object using xmlNode -##' @title List to XML -##' @param item object to be converted. Despite the function name, need not actually be a list -##' @param tag xml tag -##' @return xmlNode -##' @export -##' @author David LeBauer, Carl Davidson, Rob Kooper +#' Convert List to XML +#' +#' Can convert list or other object to an xml object using xmlNode +#' @title List to XML +#' @param item object to be converted. +#' Despite the function name, need not actually be a list +#' @param tag xml tag +#' @return xmlNode +#' @export +#' @author David LeBauer, Carl Davidson, Rob Kooper listToXml.default <- function(item, tag) { # just a textnode, or empty node with attributes diff --git a/base/settings/R/loadPath_sitePFT.R b/base/settings/R/loadPath_sitePFT.R index 6b9c3054878..30a2cbcc239 100644 --- a/base/settings/R/loadPath_sitePFT.R +++ b/base/settings/R/loadPath_sitePFT.R @@ -1,24 +1,30 @@ #' Title loadPath.sitePFT #' #' @param settings pecan setting list. -#' @param Path Character of file name with extension. The path will be generated using the outdir tag in pecan settings. +#' @param Path Character of file name with extension. +#' The path will be generated using the outdir tag in pecan settings. #' #' @return a dataframe of two columns of site and pft #' @export loadPath.sitePFT -#' @description The csv or the text file needs to have a header and be separated using comma. Under the first column in the text file, one needs to specify the site id and in the second column there has to be the name of the PFT. +#' @description The csv or the text file needs to have a header and be +#' separated using comma. Under the first column in the text file, +#' one needs to specify the site id and in the second column there has to be +#' the name of the PFT. #' - -loadPath.sitePFT<-function(settings, Path){ +loadPath.sitePFT <- function(settings, Path) { #finding the file extension. ext <- tools::file_ext(Path) - - if (ext=="csv" | ext=="txt"){ + + if (ext == "csv" || ext == "txt") { # reading in the links - links <- read.table(file.path(Path), header = T, sep = ",") + links <- utils::read.table(file.path(Path), header = TRUE, sep = ",") #check to make sure the input file is what we expect it. - if (nrow(links)==0 | ncol(links)==0 | ncol(links)!=2) PEcAn.logger::logger.severe("There is a problem with reading the file. Either row number, column number is zero or your file does not have a two columns. ") - - return(links %>% `colnames<-`(c('site','pft'))) + if (nrow(links) == 0 || ncol(links) == 0 || ncol(links) != 2) { + PEcAn.logger::logger.severe( + "There is a problem with reading the file. Either row number,", + "column number is zero or your file does not have two columns.") + } + + return(`colnames<-`(links, c("site", "pft"))) } - -} \ No newline at end of file +} diff --git a/base/settings/R/papply.R b/base/settings/R/papply.R index 410a0a2844c..155e736ee53 100644 --- a/base/settings/R/papply.R +++ b/base/settings/R/papply.R @@ -1,84 +1,100 @@ #' @title Apply functions to PEcAn MultiSettings -#' -#' @description Works like lapply(), but for PEcAn Settings and MultiSettings objects -#' -#' @param settings A \code{\link{MultiSettings}}, \code{\link{Settings}}, or \code{\link[base]{list}} -#' to operate on +#' +#' @description Works like lapply(), +#' but for PEcAn Settings and MultiSettings objects +#' +#' @param settings A \code{\link{MultiSettings}}, \code{\link{Settings}}, +#' or \code{\link[base]{list}} to operate on #' @param fn The function to apply to \code{settings} -#' @param stop.on.error Whether to halt execution if a single element in \code{settings} results -#' in error. See Details. -#' @param \code{...} additional arguments to \code{fn} -#' -#' @details -#' \code{papply} is mainly used to call a function on each \code{\link{Settings}} object in a -#' \code{\link{MultiSettings}} object, and returning the results in a list. It has some additional -#' features, however: -#' +#' @param stop.on.error Whether to halt execution if a single element in +#' \code{settings} results in error. See Details. +#' @param ... additional arguments to \code{fn} +#' +#' @details +#' \code{papply} is mainly used to call a function on each +#' \code{\link{Settings}} object in a \code{\link{MultiSettings}} object, +#' and returning the results in a list. +#' It has some additional features, however: +#' #' \itemize{ -#' \item If the result of \code{fn} is a \code{Settings} object, then \code{papply} will coerce the -#' returned list into a new \code{MultiSettings}. -#' \item If \code{settings} is a \code{Settings} object, then \code{papply} knows to call \code{fn} on -#' it directly. -#' \item If \code{settings} is a generic \code{list}, then \code{papply} coerces it to a -#' \code{Settings} object and then calls \code{fn} on it directly. This is meant for backwards -#' compatibility with old-fashioned PEcAn settings lists, but could have unintended consequences -#' \item By default, \code{papply} will proceed even if \code{fn} throws an error for one or more -#' of the elements in \code{settings}. Note that if this option is used, the returned results -#' list will have entries for \emph{only} those elements that did not result in an error. +#' \item If the result of \code{fn} is a \code{Settings} object, +#' then \code{papply} will coerce the returned list into a new +#' \code{MultiSettings}. +#' \item If \code{settings} is a \code{Settings} object, +#' then \code{papply} knows to call \code{fn} on it directly. +#' \item If \code{settings} is a generic \code{list}, +#' then \code{papply} coerces it to a \code{Settings} object +#' and then calls \code{fn} on it directly. +#' This is meant for backwards compatibility with old-fashioned PEcAn +#' settings lists, but could have unintended consequences +#' \item By default, \code{papply} will proceed even if \code{fn} throws an +#' error for one or more of the elements in \code{settings}. +#' Note that if this option is used, the returned results list will +#' have entries for \emph{only} those elements that did not +#' result in an error. #' } -#' -#' @return A single \code{fn} return value, or a list of such values (coerced to \code{MultiSettings} -#' if appropriate; \emph{see Details}) -#' +#' +#' @return A single \code{fn} return value, or a list of such values +#' (coerced to \code{MultiSettings} if appropriate; \emph{see Details}) +#' #' @author Ryan Kelly #' @export -#' +#' #' @example examples/examples.papply.R papply <- function(settings, fn, ..., stop.on.error = FALSE) { if (is.MultiSettings(settings)) { result <- list() errors <- character(0) for (i in seq_along(settings)) { - PEcAn.logger::logger.debug(paste0("papply executing ", deparse(substitute(fn)), - " on element ", i, " of ", length(settings), ".")) - + PEcAn.logger::logger.debug( + "papply executing ", deparse(substitute(fn)), + "on element ", i, " of ", length(settings), ".") + result.i <- try(fn(settings[[i]], ...), silent = TRUE) - + if (!inherits(result.i, "try-error")) { ind <- length(result) + 1 if (!is.null(result.i)) { result[[ind]] <- result.i } else { - result[ind] <- list(NULL) # Have to use special syntax to actually get a null value in + # Have to use special syntax to actually get a null value in + result[ind] <- list(NULL) } if (!is.null(settingNames(settings))) { names(result)[ind] <- settingNames(settings)[i] } } else { if (stop.on.error) { - PEcAn.logger::logger.error(paste0("papply threw an error for element ", i, " of ", length(settings), - ", and is aborting since stop.on.error=TRUE. Message was: '", - as.character(result.i), "'")) + PEcAn.logger::logger.error( + "papply threw an error for element ", i, " of ", length(settings), + ", and is aborting since stop.on.error=TRUE. Message was: '", + as.character(result.i), "'") stop() } else { - warning.message.i <- paste0("papply threw an error for element ", i, " of ", length(settings), - ", but is continuing since stop.on.error=FALSE", " (there will be no results for this element, however). Message was: '", - as.character(result.i), "'") + warning.message.i <- paste0( + "papply threw an error for element ", i, " of ", length(settings), + ", but is continuing since stop.on.error=FALSE", + " (there will be no results for this element, however).", + " Message was: '", as.character(result.i), "'") PEcAn.logger::logger.warn(warning.message.i) - errors <- c(errors, paste0("Element ", i, ": '", as.character(result.i), "'")) + errors <- c( + errors, + paste0("Element ", i, ": '", as.character(result.i), "'")) } } } - + if (all(sapply(result, is.Settings))) { result <- MultiSettings(result) } - + if (length(errors) > 0) { - PEcAn.logger::logger.warn(paste0("papply encountered errors for ", length(errors), " elements, ", - "but continued since stop.on.error=FALSE. ", paste(errors, collapse = "; "))) + PEcAn.logger::logger.warn( + "papply encountered errors for ", length(errors), " elements, ", + "but continued since stop.on.error=FALSE.", + paste(errors, collapse = "; ")) } - + return(result) } else if (is.Settings(settings)) { return(fn(settings, ...)) @@ -86,6 +102,7 @@ papply <- function(settings, fn, ..., stop.on.error = FALSE) { # Assume it's settings list that hasn't been coerced to Settings class... return(fn(as.Settings(settings), ...)) } else { - PEcAn.logger::logger.severe("The function", fn, "requires input of type MultiSettings or Settings") + PEcAn.logger::logger.severe( + "The function", fn, "requires input of type MultiSettings or Settings") } } # papply diff --git a/base/settings/R/pft_site_linker.R b/base/settings/R/pft_site_linker.R index 425bffff3ca..c3ca5cec55c 100644 --- a/base/settings/R/pft_site_linker.R +++ b/base/settings/R/pft_site_linker.R @@ -1,14 +1,20 @@ #' @title site.pft.linkage -#' +#' #' @param settings pecan settings list. -#' @param site.pft.links dataframe. Your look up table should have two columns of site and pft with site ids under site column and pft names under pft column. +#' @param site.pft.links dataframe. Your look up table should have two columns +#' of site and pft with site ids under site column +#' and pft names under pft column. #' -#' -#' @description This function creates the required tags inside pecan.xml to link sites with pfts given a look up table. If the required tags are already defined in the pecan xml then they will be updated. -#' If there are multiple pfts that they need to be used for a site, each pft needs to have a separate row in the lookup table, resulting multiple rows for a site. +#' @description This function creates the required tags inside pecan.xml +#' to link sites with pfts given a look up table. +#' If the required tags are already defined in the pecan xml +#' then they will be updated. +#' If there are multiple pfts that they need to be used for a site, +#' each pft needs to have a separate row in the lookup table, +#' resulting multiple rows for a site. #' @return pecan setting list #' @export site.pft.linkage -#' +#' #' @examples #'\dontrun{ #' #setting up the Look up tables @@ -20,41 +26,56 @@ #' "772", "temperate.broadleaf.deciduous3", #' "763", "temperate.broadleaf.deciduous4" #' ) -#' +#' #' # sending a multi- setting xml file to the function #' site.pft.linkage(settings,site.pft.links) #'} -site.pft.linkage <- function(settings, site.pft.links){ - - # checking the LUT - if (is.null(site.pft.links) | ncol(site.pft.links) !=2) PEcAn.logger::logger.severe('Your look up table should have two columns of site and pft with site ids under site column and pft names under pft column.') +site.pft.linkage <- function(settings, site.pft.links) { + + # checking the LUT + if (is.null(site.pft.links) || ncol(site.pft.links) != 2) { + PEcAn.logger::logger.severe( + "Your look up table should have two columns of site and pft", + "with site ids under site column and pft names under pft column.") + } # if it's not a multisetting put it still in a list - if(!is.MultiSettings(settings)) settings<- list(settings) - + if (!is.MultiSettings(settings)) { + settings <- list(settings) + } + #for each site in this setting - new.mset <- settings%>% - purrr::map(function(site.setting){ - + new.mset <- purrr::map( + settings, + function(site.setting) { site.pft <- NULL - site.id <- (site.setting[['run']])$site$id + site.id <- (site.setting[["run"]])$site$id #if no site id was found - if (is.null(site.id)) PEcAn.logger::logger.warn(paste0('Since your site xml tag does NOT have a site id, we can not assign a PFT to it. The site of this site is', - (site.setting[['run']])$site$name)) + if (is.null(site.id)) { + PEcAn.logger::logger.warn( + "Since your site xml tag does NOT have a site id,", + "we can not assign a PFT to it. The site of this site is", + (site.setting[["run"]])$site$name) + } # see if we can find this site id in the LUT - if (site.id %in% site.pft.links$site) site.pft <-site.pft.links$pft[which(site.pft.links$site %in% site.id)] + if (site.id %in% site.pft.links$site) { + site.pft <- site.pft.links$pft[which(site.pft.links$site %in% site.id)] + } # if there was a pft associated with that - if (!is.null(site.pft)) site.setting[['run']]$site$site.pft <- as.list(site.pft) %>% setNames(rep('pft.name', length(site.pft))) + if (!is.null(site.pft)) { + site.setting[["run"]]$site$site.pft <- stats::setNames( + as.list(site.pft), + rep("pft.name", length(site.pft))) + } return(site.setting) }) - - #putting it in the right format depending if it's multisetting or not + + #putting it in the right format depending if it's multisetting or not if (is.MultiSettings(settings)) { new.mset <- MultiSettings(new.mset) } else{ new.mset <- new.mset[[1]] } - + return(new.mset) } - diff --git a/base/settings/R/prepare.settings.R b/base/settings/R/prepare.settings.R index 51b31e59144..74b9562e147 100644 --- a/base/settings/R/prepare.settings.R +++ b/base/settings/R/prepare.settings.R @@ -1,25 +1,29 @@ -##' Update, set defaults for, and otherwise prepare a PEcAn Settings object -##' -##' Performs various checks, fixes deprecated contructs, and assigns missing values where possible. -##' -##' @title Prepare Settings -##' @param settings settings list -##' @param force Whether to force the function to run even if it determines it has been run on -##' these settings already. -##' @author Ryan Kelly -##' @author Betsy Cowdery -##' @export prepare.settings +#' Update, set defaults for, and otherwise prepare a PEcAn Settings object +#' +#' Performs various checks, fixes deprecated contructs, +#' and assigns missing values where possible. +#' +#' @title Prepare Settings +#' @param settings settings list +#' @param force Whether to force the function to run even if it determines +#' it has been run on these settings already. +#' @author Ryan Kelly +#' @author Betsy Cowdery +#' @export prepare.settings +#' +prepare.settings <- function(settings, force = FALSE) { -prepare.settings <- function(settings, force=FALSE) { - - if(is.MultiSettings(settings)) { - return(invisible(papply(settings, prepare.settings, force=force))) + if (is.MultiSettings(settings)) { + return(invisible(papply(settings, prepare.settings, force = force))) } - settings <- site.pft.link.settings (settings) # this will find the link between the site and pft and it will add extra tags for write.ensemble.config function. - settings <- fix.deprecated.settings(settings, force=force) - settings <- addSecrets(settings, force=force) - settings <- update.settings(settings, force=force) - settings <- check.settings(settings, force=force) - + # this will find the link between the site and pft and it will add extra tags + # for write.ensemble.config function + settings <- site.pft.link.settings(settings) + + settings <- fix.deprecated.settings(settings, force = force) + settings <- addSecrets(settings, force = force) + settings <- update.settings(settings, force = force) + settings <- check.settings(settings, force = force) + return(settings) } diff --git a/base/settings/R/read.settings.R b/base/settings/R/read.settings.R index 8a84e7c6287..f744bbd4472 100644 --- a/base/settings/R/read.settings.R +++ b/base/settings/R/read.settings.R @@ -1,72 +1,77 @@ -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- -##' Loads PEcAn settings file -##' -##' This will try and find the PEcAn settings file in the following order: -##' \enumerate{ -##' \item {--settings }{passed as command line argument using --settings} -##' \item {inputfile}{passed as argument to function} -##' \item {PECAN_SETTINGS}{environment variable PECAN_SETTINGS pointing to a specific file} -##' \item {./pecan.xml}{pecan.xml in the current folder} -##' } -##' Once the function finds a valid file, it will not look further. -##' Thus, if \code{inputfile} is supplied, \code{PECAN_SETTINGS} will be ignored. -##' Even if a \code{file} argument is passed, it will be ignored if a file is passed through -##' a higher priority method. -##' @param inputfile the PEcAn settings file to be used. -##' @param outputfile the name of file to which the settings will be -##' written inside the outputdir. If set to null nothing is saved. -##' @return list of all settings as loaded from the XML file(s) -##' @export read.settings -##' @import XML -##' @author Shawn Serbin -##' @author Rob Kooper -##' @author David LeBauer -##' @author Ryan Kelly -##' @author Betsy Cowdery -##' @examples -##' \dontrun{ -##' ## bash shell: -##' ## example workflow.R and pecan.xml files in pecan/tests -##' R --vanilla -- --settings path/to/mypecan.xml < workflow.R -##' -##' ## R: -##' -##' settings <- read.settings() -##' settings <- read.settings(file="willowcreek.xml") -##' test.settings.file <- system.file("tests/test.xml", package = "PEcAn.all") -##' settings <- read.settings(test.settings.file) -##' } -read.settings <- function(inputfile = "pecan.xml"){ - if(inputfile == "") { - PEcAn.logger::logger.warn("settings files specified as empty string; \n\t\tthis may be caused by an incorrect argument to system.file.") +#' Loads PEcAn settings file +#' +#' This will try and find the PEcAn settings file in the following order: +#' \enumerate{ +#' \item {--settings }{passed as command line argument using --settings} +#' \item {inputfile}{passed as argument to function} +#' \item {PECAN_SETTINGS}{environment variable PECAN_SETTINGS pointing to a specific file} +#' \item {./pecan.xml}{pecan.xml in the current folder} +#' } +#' Once the function finds a valid file, it will not look further. +#' Thus, if \code{inputfile} is supplied, \code{PECAN_SETTINGS} will be +#' ignored. +#' Even if a \code{file} argument is passed, it will be ignored if a file +#' is passed through a higher priority method. +#' +#' @param inputfile the PEcAn settings file to be used. +#' @return list of all settings as loaded from the XML file(s) +#' @export read.settings +#' @import XML +#' @author Shawn Serbin +#' @author Rob Kooper +#' @author David LeBauer +#' @author Ryan Kelly +#' @author Betsy Cowdery +#' @examples +#' \dontrun{ +#' ## bash shell: +#' ## example workflow.R and pecan.xml files in pecan/tests +#' R --vanilla -- --settings path/to/mypecan.xml < workflow.R +#' +#' ## R: +#' +#' settings <- read.settings() +#' settings <- read.settings(file="willowcreek.xml") +#' test.settings.file <- system.file("tests/test.xml", package = "PEcAn.all") +#' settings <- read.settings(test.settings.file) +#' } +read.settings <- function(inputfile = "pecan.xml") { + if (inputfile == "") { + PEcAn.logger::logger.warn( + "settings files specified as empty string;", + "\n\t\tthis may be caused by an incorrect argument to system.file.") } - + loc <- which(commandArgs() == "--settings") ## If settings file passed at cmd line - if (length(loc) != 0) { + if (length(loc) != 0) { # 1 filename is passed as argument to R - for(idx in loc) { - if (!is.null(commandArgs()[idx+1]) && file.exists(commandArgs()[idx+1])) { - PEcAn.logger::logger.info("Loading --settings=", commandArgs()[idx+1]) - xml <- XML::xmlParse(commandArgs()[idx+1]) + for (idx in loc) { + if (!is.null(commandArgs()[idx + 1]) + && file.exists(commandArgs()[idx + 1])) { + PEcAn.logger::logger.info("Loading --settings=", commandArgs()[idx + 1]) + xml <- XML::xmlParse(commandArgs()[idx + 1]) break } } ## if settings file on $PATH - } else if (file.exists(Sys.getenv("PECAN_SETTINGS"))) { + } else if (file.exists(Sys.getenv("PECAN_SETTINGS"))) { # 2 load from PECAN_SETTINGS - PEcAn.logger::logger.info("Loading PECAN_SETTINGS=", Sys.getenv("PECAN_SETTINGS")) + PEcAn.logger::logger.info( + "Loading PECAN_SETTINGS=", + Sys.getenv("PECAN_SETTINGS")) xml <- XML::xmlParse(Sys.getenv("PECAN_SETTINGS")) ## if settings file passed to read.settings function - } else if(!is.null(inputfile) && file.exists(inputfile)) { + } else if (!is.null(inputfile) && file.exists(inputfile)) { # 3 filename passed into function PEcAn.logger::logger.info("Loading inpufile=", inputfile) xml <- XML::xmlParse(inputfile) @@ -79,16 +84,16 @@ read.settings <- function(inputfile = "pecan.xml"){ # file not found PEcAn.logger::logger.severe("Could not find a pecan.xml file") } - + ## convert the xml to a list settings <- XML::xmlToList(xml) settings <- as.Settings(settings) settings <- expandMultiSettings(settings) - + ## setup Rlib from settings - if(!is.null(settings$Rlib)) { + if (!is.null(settings$Rlib)) { .libPaths(settings$Rlib) } - + return(invisible(settings)) } diff --git a/base/settings/R/site_pft_link_settings.R b/base/settings/R/site_pft_link_settings.R index 1dba590f65d..505a1f66ab2 100644 --- a/base/settings/R/site_pft_link_settings.R +++ b/base/settings/R/site_pft_link_settings.R @@ -5,47 +5,53 @@ #' @return pecan xml setting file #' @export site.pft.link.settings #' -#' @description This function reads in a pecan setting and check for the pft.site xml tag under run>inputs . If a path or a ID for the input is defined then, it will be used for linking sites with the pfts. - +#' @description This function reads in a pecan setting and check for the +#' pft.site xml tag under run>inputs. If a path or a ID for the input is +#' defined then, it will be used for linking sites with the pfts. +#' @importFrom purrr %>% site.pft.link.settings <- function(settings) { #lets see if there is the pft.site tag under run>inputs pft.site.info <- settings$run$inputs$pft.site # if it's not specified just let it go ! if (is.null(pft.site.info)) return(settings) - - #if there is no input file/id defined or if both are defined at the same time. At the moment I'm gonna make sure that there is just one input. - if (length(pft.site.info) !=1) { - PEcAn.logger::logger.warn("In your xml tag for linking site with pfts, you either have no input specified or you have more than one input defined. No change was made !") + + # if there is no input file/id defined or if both defined at the same time. + # At the moment I'm gonna make sure that there is just one input. + if (length(pft.site.info) != 1) { + PEcAn.logger::logger.warn( + "In your xml tag for linking site with pfts, you either have no input", + "specified or you have more than one input defined. No change was made!") return(settings) } - + if (!is.null(pft.site.info$path)) { #lets read in the Look Up Table - LUT <- loadPath.sitePFT(settings,pft.site.info$path) - - #-- if the pft in the LUT is not defined under the pft tag in the body of the pecan xml - Then I add that. + LUT <- loadPath.sitePFT(settings, pft.site.info$path) + + #-- if the pft in the LUT is not defined under the pft tag in the body of + # the pecan xml - Then I add that. def.pfts <- purrr::map_chr(settings[["pfts"]], "name") - + # Create a simple pft tag for the pfts in LUT that are not in the pft tag pft.l <- LUT[["pft"]][!(LUT[["pft"]] %in% def.pfts)] %>% trimws() %>% unique() - + new.pfts <- pft.l %>% purrr::discard(~.x %in% def.pfts) %>% purrr::map(~list(name = as.character(.x), constants = 1)) %>% - setNames(rep("pft", length(.))) - + stats::setNames(rep("pft", length(.))) + #add them to the list settings$pfts <- c(settings$pfts, new.pfts) - + # doing the real linkage and writing the setting down settings <- site.pft.linkage(settings, LUT) } - + return(settings) } diff --git a/base/settings/R/update.settings.R b/base/settings/R/update.settings.R index 9cd9ad8fbf6..0d6c4ab4ee9 100644 --- a/base/settings/R/update.settings.R +++ b/base/settings/R/update.settings.R @@ -1,59 +1,63 @@ - ##------------------------------------------------------------------------------- +##----------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -##------------------------------------------------------------------------------- -##' Updates a pecan.xml file to match new layout. This will take care of the -##' conversion to the latest pecan.xml file. -##' -##' @title Update Settings -##' @name update.settings -##' @param settings settings file -##' @return will return the updated settings values -##' @export update.settings -##' @author Rob Kooper +##----------------------------------------------------------------------------- +#' Updates a pecan.xml file to match new layout. This will take care of the +#' conversion to the latest pecan.xml file. +#' +#' @title Update Settings +#' @name update.settings +#' @param settings settings file +#' @return will return the updated settings values +#' @export update.settings +#' @author Rob Kooper -update.settings <- function(settings, force=FALSE) { - if(!force && !is.null(settings$settings.info$settings.updated) && - settings$settings.info$settings.updated==TRUE) { - PEcAn.logger::logger.info("Deprecated settings have been fixed already. Skipping.") +update.settings <- function(settings, force = FALSE) { + if (!force && !is.null(settings$settings.info$settings.updated) + && settings$settings.info$settings.updated == TRUE) { + PEcAn.logger::logger.info( + "Deprecated settings have been fixed already. Skipping.") return(invisible(settings)) } else { PEcAn.logger::logger.info("Fixing deprecated settings...") } - - if(is.MultiSettings(settings)) { - return(invisible(papply(settings, update.settings, force=force))) + + if (is.MultiSettings(settings)) { + return(invisible(papply(settings, update.settings, force = force))) } - + # update database section, now have different database definitions # under database section, e.g. fia and bety if (!is.null(settings$database)) { # simple check to make sure the database tag is updated if (!is.null(settings$database$dbname)) { if (!is.null(settings$database$bety)) { - PEcAn.logger::logger.severe("Please remove dbname etc from database configuration.") + PEcAn.logger::logger.severe( + "Please remove dbname etc from database configuration.") } - - PEcAn.logger::logger.info("Database tag has changed, please use to store", - "information about accessing the BETY database. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#database-access.") - + + PEcAn.logger::logger.info( + "Database tag has changed, please use to store", + "information about accessing the BETY database. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#database-access.") + bety <- list() - for(name in names(settings$database)) { + for (name in names(settings$database)) { bety[[name]] <- settings$database[[name]] } - settings$database <- list(bety=bety) + settings$database <- list(bety = bety) } - + # warn user about change and update settings if (!is.null(settings$bety$write)) { - PEcAn.logger::logger.warn(" is now part of the database settings. For more", - "information about the database settings see", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#database-access.") + PEcAn.logger::logger.warn( + " is now part of the database settings. For more", + "information about the database settings see", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#database-access.") if (is.null(settings$database$bety$write)) { settings$database$bety$write <- settings$bety$write settings$bety$write <- NULL @@ -61,137 +65,157 @@ update.settings <- function(settings, force=FALSE) { } } } - + # model$model_type is now simply model$type and model$name is no longer used if (!is.null(settings$model$model_type)) { if (!is.null(settings$model$type)) { if (settings$model$model_type != settings$model$type) { - PEcAn.logger::logger.severe("Please remove model_type from model configuration.") + PEcAn.logger::logger.severe( + "Please remove model_type from model configuration.") } else { - PEcAn.logger::logger.info("Please remove model_type from model configuration.") + PEcAn.logger::logger.info( + "Please remove model_type from model configuration.") } } - - PEcAn.logger::logger.info("Model tag has changed, please use to specify", - "type of model. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#model_setup.") + + PEcAn.logger::logger.info( + "Model tag has changed, please use to specify", + "type of model. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#model_setup.") settings$model$type <- settings$model$model_type settings$model$model_type <- NULL } if (!is.null(settings$model$name)) { if (!is.null(settings$model$type)) { if (settings$model$name != settings$model$type) { - PEcAn.logger::logger.severe("Please remove name from model configuration.") + PEcAn.logger::logger.severe( + "Please remove name from model configuration.") } else { - PEcAn.logger::logger.info("Please remove name from model configuration.") + PEcAn.logger::logger.info( + "Please remove name from model configuration.") } } - - PEcAn.logger::logger.info("Model tag has changed, please use to specify", - "type of model. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#model_setup.") + + PEcAn.logger::logger.info( + "Model tag has changed, please use to specify", + "type of model. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#model_setup.") settings$model$type <- settings$model$name settings$model$name <- NULL } - + # run$site$met is now run$inputs$met$path if (!is.null(settings$run$site$met)) { if (!is.null(settings$run$inputs$met)) { if (settings$run$site$met != settings$run$inputs$met) { - PEcAn.logger::logger.severe("Please remove met from model configuration.") + PEcAn.logger::logger.severe( + "Please remove met from model configuration.") } else { - PEcAn.logger::logger.info("Please remove met from model configuration.") + PEcAn.logger::logger.info( + "Please remove met from model configuration.") } } if (is.null(settings$run$inputs)) { settings$run$inputs <- list() } - PEcAn.logger::logger.info("Model tag has changed, please use to specify", - "met file for a run. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") + PEcAn.logger::logger.info( + "Model tag has changed, please use to specify", + "met file for a run. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") settings$run$inputs$met$path <- settings$run$site$met settings$run$site$met <- NULL } - + # inputs now have path and id under tag - for(tag in names(settings$run$inputs)) { + for (tag in names(settings$run$inputs)) { if (grepl(".id$", tag)) { tagid <- tag - tag <- substr(tagid, 1, nchar(tagid)-3) + tag <- substr(tagid, 1, nchar(tagid) - 3) if (tag %in% names(settings$run$inputs)) { next } else { - settings$run$inputs[[tag]]['id'] <- settings$run$inputs[[tagid]] - settings$run$inputs[[tagid]] <- null + settings$run$inputs[[tag]]["id"] <- settings$run$inputs[[tagid]] + settings$run$inputs[[tagid]] <- NULL } } else { if (!is.list(settings$run$inputs[[tag]])) { path <- settings$run$inputs[[tag]] - settings$run$inputs[[tag]] <- list("path"=path) + settings$run$inputs[[tag]] <- list("path" = path) } - + tagid <- paste0(tag, ".id") if (tagid %in% names(settings$run$inputs)) { - if ('id' %in% names(settings$run$inputs[[tag]])) { - if (settings$run$inputs[[tagid]] != settings$run$inputs[[tag]][['id']]) { - PEcAn.logger::logger.severe("Please remove", tagid, "from inputs configuration.") + if ("id" %in% names(settings$run$inputs[[tag]])) { + if (settings$run$inputs[[tagid]] + != settings$run$inputs[[tag]][["id"]]) { + PEcAn.logger::logger.severe( + "Please remove", tagid, "from inputs configuration.") } else { - PEcAn.logger::logger.info("Please remove", tagid, "from inputs configuration.") + PEcAn.logger::logger.info( + "Please remove", tagid, "from inputs configuration.") } settings$run$inputs[[tagid]] <- NULL } else { - settings$run$inputs[[tag]][['id']] <- settings$run$inputs[[tagid]] + settings$run$inputs[[tag]][["id"]] <- settings$run$inputs[[tagid]] settings$run$inputs[[tagid]] <- NULL } } } } - + # some specific ED changes if (!is.null(settings$model$veg)) { if (!is.null(settings$run$inputs$veg)) { if (settings$model$veg != settings$run$inputs$veg) { - PEcAn.logger::logger.severe("Please remove veg from model configuration.") + PEcAn.logger::logger.severe( + "Please remove veg from model configuration.") } else { - PEcAn.logger::logger.info("Please remove veg from model configuration.") + PEcAn.logger::logger.info( + "Please remove veg from model configuration.") } } if (is.null(settings$run$inputs)) { settings$run$inputs <- list() } - PEcAn.logger::logger.info("Model tag has changed, please use to specify", - "veg file for a run. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") + PEcAn.logger::logger.info( + "Model tag has changed, please use to specify", + "veg file for a run. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") settings$run$inputs$veg <- settings$model$veg settings$model$veg <- NULL } if (!is.null(settings$model$soil)) { if (!is.null(settings$run$inputs$soil)) { if (settings$model$soil != settings$run$inputs$soil) { - PEcAn.logger::logger.severe("Please remove soil from model configuration.") + PEcAn.logger::logger.severe( + "Please remove soil from model configuration.") } else { - PEcAn.logger::logger.info("Please remove soil from model configuration.") + PEcAn.logger::logger.info( + "Please remove soil from model configuration.") } } if (is.null(settings$run$inputs)) { settings$run$inputs <- list() } - PEcAn.logger::logger.info("Model tag has changed, please use to specify", - "soil file for a run. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") + PEcAn.logger::logger.info( + "Model tag has changed, please use to specify", + "soil file for a run. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") settings$run$inputs$soil <- settings$model$soil settings$model$soil <- NULL } if (!is.null(settings$model$psscss)) { if (!is.null(settings$run$inputs$pss)) { - PEcAn.logger::logger.info("Please remove psscss from model configuration.") + PEcAn.logger::logger.info( + "Please remove psscss from model configuration.") } if (is.null(settings$run$inputs)) { settings$run$inputs <- list() } - PEcAn.logger::logger.info("Model tag has changed, please use to specify", - "pss/css/site file for a run. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") + PEcAn.logger::logger.info( + "Model tag has changed, please use to specify", + "pss/css/site file for a run. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") settings$run$inputs$pss <- file.path(settings$model$psscss, "foo.pss") settings$run$inputs$css <- file.path(settings$model$psscss, "foo.css") settings$run$inputs$site <- file.path(settings$model$psscss, "foo.site") @@ -199,21 +223,24 @@ update.settings <- function(settings, force=FALSE) { } if (!is.null(settings$model$inputs)) { if (!is.null(settings$run$inputs$inputs)) { - PEcAn.logger::logger.info("Please remove inputs from model configuration.") + PEcAn.logger::logger.info( + "Please remove inputs from model configuration.") } if (is.null(settings$run$inputs)) { settings$run$inputs <- list() } - PEcAn.logger::logger.info("Model tag has changed, please use to specify", - "lu/thsums file for a run. See also", - "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") + PEcAn.logger::logger.info( + "Model tag has changed, please use to specify", + "lu/thsums file for a run. See also", + "https://github.com/PecanProject/pecan/wiki/PEcAn-Configuration#run_setup.") settings$run$inputs$lu <- file.path(settings$model$inputs, "glu") settings$run$inputs$thsums <- settings$model$inputs settings$model$soil <- NULL } - - # Set 'checked' flag so update.settings will be skipped in the future (unless force=TRUE) + + # Set 'checked' flag so update.settings will be skipped in the future + # (unless force=TRUE) settings$settings.info$settings.updated <- TRUE - + return(invisible(settings)) } diff --git a/base/settings/R/write.settings.R b/base/settings/R/write.settings.R index 0bf22b6000f..3e9de94063c 100644 --- a/base/settings/R/write.settings.R +++ b/base/settings/R/write.settings.R @@ -1,18 +1,23 @@ -##' Takes in a settings object, performs a series of checks, fixes & updates settings and produces pecan.CHECKED.xml -##' -##' @title Write settings -##' @param settings settings list -##' @param outputfile the file name to write to -##' @param outputdir the directory to write to -##' @author Ryan Kelly -##' @author Betsy Cowdery -##' @export write.settings - - -write.settings <- function(settings, outputfile, outputdir=settings$outdir){ +#' Takes in a settings object, performs a series of checks, +#' fixes & updates settings and produces pecan.CHECKED.xml +#' +#' @title Write settings +#' @param settings settings list +#' @param outputfile the file name to write to +#' @param outputdir the directory to write to +#' @author Ryan Kelly +#' @author Betsy Cowdery +#' @export write.settings +write.settings <- function( + settings, + outputfile, + outputdir = settings$outdir) { pecanfile <- file.path(outputdir, outputfile) if (file.exists(pecanfile)) { - PEcAn.logger::logger.warn(paste("File already exists [", pecanfile, "] file will be overwritten")) + PEcAn.logger::logger.warn( + paste( + "File already exists [", pecanfile, + "] file will be overwritten")) } - saveXML(listToXml(settings, "pecan"), file=pecanfile) + XML::saveXML(listToXml(settings, "pecan"), file = pecanfile) } diff --git a/base/settings/examples/examples.MultiSite.MultiSettings.r b/base/settings/examples/examples.MultiSite.MultiSettings.r index c690465296a..d6802172d16 100644 --- a/base/settings/examples/examples.MultiSite.MultiSettings.r +++ b/base/settings/examples/examples.MultiSite.MultiSettings.r @@ -1,70 +1,105 @@ -dontrun <- function() { ## Added by Alexey Shiklomanov so this doesn't run and break the build +dontrun <- function() { # Added by Alexey Shiklomanov + # so this doesn't run and break the build -# This isn't necessarily a fully working settings object. Enough to get the idea though. +# This isn't necessarily a fully working settings object. +# Enough to get the idea though. # Note it has a $run block with settings that will be shared across all sites -template = Settings( - list(info = structure(list(notes = NULL, userid = "1000000005", - username = "Ryan Kelly", date = "2016/07/13 13:23:46 -0400"), .Names = c("notes", -"userid", "username", "date")), database = structure(list(bety = structure(list( - user = "bety", password = "bety", host = "psql-pecan.bu.edu", - dbname = "bety", driver = "PostgreSQL", write = "TRUE"), .Names = c("user", -"password", "host", "dbname", "driver", "write")), fia = structure(list( - user = "bety", password = "bety", host = "psql-pecan.bu.edu", - dbname = "fia5", driver = "PostgreSQL", write = "true"), .Names = c("user", -"password", "host", "dbname", "driver", "write"))), .Names = c("bety", -"fia")), pfts = structure(list(pft = structure(list(comment = NULL, - name = "temperate.Evergreen_Hardwood", constants = structure(list( - num = "1"), .Names = "num")), .Names = c("comment", "name", -"constants")), pft = structure(list(name = "temperate.Hydric", - constants = structure(list(num = "2"), .Names = "num")), .Names = c("name", -"constants"))), .Names = c("pft", "pft")), meta.analysis = structure(list( - iter = "3000", random.effects = list(on = FALSE, use_ghs = TRUE), update = "AUTO", - threshold = "1.2"), .Names = c("iter", "random.effects", -"update", "threshold")), ensemble = structure(list(size = "1", - variable = "NPP"), .Names = c("size", "variable")), model = structure(list( - id = "2000000005", edin = "/home/rykelly/pecan/RK_files/ED2IN/ED2IN.rgit.mandifore_04", - config.header = structure(list(radiation = structure(list( - lai_min = "0.01"), .Names = "lai_min"), ed_misc = structure(list( - output_month = "12"), .Names = "output_month")), .Names = c("radiation", - "ed_misc")), phenol.scheme = "0", prerun = "module load hdf5/1.8.11", - binary = "/usr2/postdoc/rykelly/ED2/ED/build/ed_2.1-opt"), .Names = c("id", -"edin", "config.header", "phenol.scheme", "prerun", "binary")), - host = structure(list(name = "geo.bu.edu", user = "rykelly", - folder = "/projectnb/dietzelab/pecan.data/output/rykelly", - qsub = "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash", - qsub.jobid = "Your job ([0-9]+) .*", qstat = "qstat -j @JOBID@ || echo DONE", - prerun = "module load udunits R/R-3.0.0_gnu-4.4.6", dbfiles = "/projectnb/dietzelab/pecan.data/input", - modellauncher = structure(list(binary = "/usr2/postdoc/rykelly/pecan/utils/modellauncher/modellauncher", - qsub.extra = "-pe omp 20"), .Names = c("binary", - "qsub.extra"))), .Names = c("name", "user", "folder", - "qsub", "qsub.jobid", "qstat", "prerun", "dbfiles", "modellauncher" - )), run = structure(list(inputs = structure(list(met = structure(list( - source = "NARR", output = "ED2"), .Names = c("source", - "output")), lu = structure(list(id = "294", path = "/projectnb/dietzelab/EDI/ed_inputs/glu/"), .Names = c("id", - "path")), soil = structure(list(id = "297", path = "/projectnb/dietzelab/EDI/faoOLD/FAO_"), .Names = c("id", - "path")), thsum = structure(list(id = "295", path = "/projectnb/dietzelab/EDI/ed_inputs/"), .Names = c("id", - "path")), veg = structure(list(id = "296", path = "/projectnb/dietzelab/EDI/oge2OLD/OGE2_"), .Names = c("id", - "path")), pss = structure(list(source = "FIA"), .Names = "source")), .Names = c("met", - "lu", "soil", "thsum", "veg", "pss")), start.date = "2004/01/01", - end.date = "2004/01/31"), .Names = c("inputs", "start.date", - "end.date"))) -) +template <- Settings(list( + info = structure(list( + notes = NULL, userid = "1000000005", username = "Ryan Kelly", + date = "2016/07/13 13:23:46 -0400"), + .Names = c("notes", "userid", "username", "date")), + database = structure(list( + bety = structure( + list(user = "bety", password = "bety", host = "psql-pecan.bu.edu", + dbname = "bety", driver = "PostgreSQL", write = "TRUE"), + .Names = c("user", "password", "host", "dbname", "driver", "write")), + fia = structure( + list(user = "bety", password = "bety", host = "psql-pecan.bu.edu", + dbname = "fia5", driver = "PostgreSQL", write = "true"), + .Names = c("user", "password", "host", "dbname", "driver", "write"))), + .Names = c("bety", "fia")), + pfts = structure(list( + pft = structure( + list(comment = NULL, name = "temperate.Evergreen_Hardwood", + constants = structure(list(num = "1"), .Names = "num")), + .Names = c("comment", "name", "constants")), + pft = structure( + list(name = "temperate.Hydric", + constants = structure(list(num = "2"), .Names = "num")), + .Names = c("name", "constants"))), + .Names = c("pft", "pft")), + meta.analysis = structure(list( + iter = "3000", random.effects = list(on = FALSE, use_ghs = TRUE), + update = "AUTO", threshold = "1.2"), + .Names = c("iter", "random.effects", "update", "threshold")), + ensemble = structure(list(size = "1", variable = "NPP"), + .Names = c("size", "variable")), + model = structure(list(id = "2000000005", + edin = "/home/rykelly/pecan/RK_files/ED2IN/ED2IN.rgit.mandifore_04", + config.header = structure(list( + radiation = structure(list(lai_min = "0.01"), .Names = "lai_min"), + ed_misc = structure(list(output_month = "12"), + .Names = "output_month")), + .Names = c("radiation", "ed_misc")), + phenol.scheme = "0", prerun = "module load hdf5/1.8.11", + binary = "/usr2/postdoc/rykelly/ED2/ED/build/ed_2.1-opt"), + .Names = c("id", "edin", "config.header", "phenol.scheme", "prerun", + "binary")), + host = structure(list(name = "geo.bu.edu", user = "rykelly", + folder = "/projectnb/dietzelab/pecan.data/output/rykelly", + qsub = "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash", + qsub.jobid = "Your job ([0-9]+) .*", + qstat = "qstat -j @JOBID@ || echo DONE", + prerun = "module load udunits R/R-3.0.0_gnu-4.4.6", + dbfiles = "/projectnb/dietzelab/pecan.data/input", + modellauncher = structure(list( + binary = "/usr2/postdoc/rykelly/pecan/utils/modellauncher/modellauncher", + qsub.extra = "-pe omp 20"), + .Names = c("binary", "qsub.extra"))), + .Names = c("name", "user", "folder", "qsub", "qsub.jobid", "qstat", + "prerun", "dbfiles", "modellauncher")), + run = structure(list( + inputs = structure(list( + met = structure(list(source = "NARR", output = "ED2"), + .Names = c("source", "output")), + lu = structure(list(id = "294", + path = "/projectnb/dietzelab/EDI/ed_inputs/glu/"), + .Names = c("id", "path")), + soil = structure(list(id = "297", + path = "/projectnb/dietzelab/EDI/faoOLD/FAO_"), + .Names = c("id", "path")), + thsum = structure(list(id = "295", + path = "/projectnb/dietzelab/EDI/ed_inputs/"), + .Names = c("id", "path")), + veg = structure(list(id = "296", + path = "/projectnb/dietzelab/EDI/oge2OLD/OGE2_"), + .Names = c("id", "path")), + pss = structure(list(source = "FIA"), .Names = "source")), + .Names = c("met", "lu", "soil", "thsum", "veg", "pss")), + start.date = "2004/01/01", + end.date = "2004/01/31"), + .Names = c("inputs", "start.date", "end.date")) +)) sitegroupId <- 1000000002 -startDate = "2000/01/01" -endDate = "2015/12/31" +startDate <- "2000/01/01" +endDate <- "2015/12/31" nSite <- 10 -outDir = '~/multisite_setup_test' +outDir <- "~/multisite_setup_test" template <- setDates(template, startDate = startDate, endDate = endDate) template <- setOutDir(template, outDir) -multiRunSettings <- createSitegroupMultiSettings(template, sitegroupId = sitegroupId, nSite=nSite) +multiRunSettings <- createSitegroupMultiSettings( + template, + sitegroupId = sitegroupId, + nSite = nSite) -dir.create(outDir, showWarnings=F) -write.settings(multiRunSettings, outputfile="pecan.xml") +dir.create(outDir, showWarnings = FALSE) +write.settings(multiRunSettings, outputfile = "pecan.xml") } # dontrun diff --git a/base/settings/man/MultiSettings.Rd b/base/settings/man/MultiSettings.Rd index bf42f14257b..59eebd08349 100644 --- a/base/settings/man/MultiSettings.Rd +++ b/base/settings/man/MultiSettings.Rd @@ -2,13 +2,34 @@ % Please edit documentation in R/MultiSettings.R \name{MultiSettings} \alias{MultiSettings} +\alias{as.MultiSettings} +\alias{is.MultiSettings} \title{Create a PEcAn MultiSettings object} \usage{ MultiSettings(...) + +as.MultiSettings(x) + +is.MultiSettings(x) +} +\arguments{ +\item{...}{Settings objects to concatenate} + +\item{x}{object to test or coerce} +} +\value{ +list with class "Multisettings" } \description{ Create a PEcAn MultiSettings object } +\section{Functions}{ +\itemize{ +\item \code{as.MultiSettings}: coerce an existing object to MultiSettings + +\item \code{is.MultiSettings}: test if an object is a MultiSettings +}} + \author{ Ryan Kelly } diff --git a/base/settings/man/SafeList.Rd b/base/settings/man/SafeList.Rd index 9e3b9fb24dc..7ece4ac8221 100644 --- a/base/settings/man/SafeList.Rd +++ b/base/settings/man/SafeList.Rd @@ -4,7 +4,7 @@ \alias{SafeList} \alias{as.SafeList} \alias{is.SafeList} -\title{Constrct SafeList Object} +\title{Construct SafeList Object} \usage{ SafeList(...) @@ -13,11 +13,10 @@ as.SafeList(x) is.SafeList(x) } \arguments{ -\item{...}{A list to upgrade to SafeList, or elements to be added to a new SafeList} +\item{...}{A list to upgrade to SafeList, +or elements to be added to a new SafeList} -\item{x}{list to coerce} - -\item{x}{list object to be tested} +\item{x}{list object to be tested or coerced} } \value{ The resulting SafeList @@ -30,14 +29,16 @@ logical Create a SafeList object } \details{ -SafeList is a wrapper class for the normal R list. It should behave identically, except for -the $ operator being overridden to require exact matches. +SafeList is a wrapper class for the normal R list. + It should behave identically, except for the $ operator being overridden + to require exact matches. The constructor works identical to list(...) unless: -1) The only argument is a list, in which case the result is the same list, with its class -attribute updated to include 'SafeList', or -2) The only argument is a SafeList, in which case that argument is returned unchanged +1) The only argument is a list, in which case the result is the same list, + with its class attribute updated to include 'SafeList', or +2) The only argument is a SafeList, in which case that argument is returned + unchanged } \section{Functions}{ \itemize{ diff --git a/base/settings/man/Settings.Rd b/base/settings/man/Settings.Rd index d4b2eccb9d2..86eb888db22 100644 --- a/base/settings/man/Settings.Rd +++ b/base/settings/man/Settings.Rd @@ -2,16 +2,35 @@ % Please edit documentation in R/Settings.R \name{Settings} \alias{Settings} +\alias{as.Settings} +\alias{is.Settings} \title{Create a PEcAn Settings object} \usage{ Settings(...) + +as.Settings(x) + +is.Settings(x) } \arguments{ -\item{...}{TODO} +\item{...}{objects to concatenate} + +\item{x}{object to test or coerce} +} +\value{ +a list containing all objects in `...`, + with class c("Settings", "SafeList", "list"). } \description{ Create a PEcAn Settings object } +\section{Functions}{ +\itemize{ +\item \code{as.Settings}: coerce an object to Settings + +\item \code{is.Settings}: test if object is already a Settings +}} + \author{ Ryan Kelly } diff --git a/base/settings/man/cash-.SafeList.Rd b/base/settings/man/cash-.SafeList.Rd index 5d5559e8dad..cfa198ae167 100644 --- a/base/settings/man/cash-.SafeList.Rd +++ b/base/settings/man/cash-.SafeList.Rd @@ -18,7 +18,7 @@ The specified component Extract SafeList component by name } \details{ -Overrides `$`.list, and works just like it except forces exact match +Overrides `$`.list, and works just like it except forces exact match (i.e., makes x$name behave exactly like x[[name, exact=T]]) } \author{ diff --git a/base/settings/man/check.bety.version.Rd b/base/settings/man/check.bety.version.Rd index e6e9d30415c..968504c3962 100644 --- a/base/settings/man/check.bety.version.Rd +++ b/base/settings/man/check.bety.version.Rd @@ -7,8 +7,8 @@ check.bety.version(dbcon) } \arguments{ -\item{settings}{settings file} +\item{dbcon}{database connection object} } \description{ -Check BETY Version +check to make sure BETY is up to date } diff --git a/base/settings/man/check.database.Rd b/base/settings/man/check.database.Rd index 3ae07d2e9bf..d80851e67d9 100644 --- a/base/settings/man/check.database.Rd +++ b/base/settings/man/check.database.Rd @@ -7,7 +7,8 @@ check.database(database) } \arguments{ -\item{settings}{settings file} +\item{database}{settings list to check. +You'll probably use `settings$database`} } \description{ Check Database diff --git a/base/settings/man/check.settings.Rd b/base/settings/man/check.settings.Rd index 5bda7ae7a69..85b69949144 100644 --- a/base/settings/man/check.settings.Rd +++ b/base/settings/man/check.settings.Rd @@ -13,8 +13,9 @@ check.settings(settings, force = FALSE) will return the updated settings values with defaults set. } \description{ -Sanity checks. Checks the settings file to make sure expected fields exist. It will try to use -default values for any missing values, or stop the exection if no defaults are possible. +Sanity checks. Checks the settings file to make sure expected fields exist. + It will try to use default values for any missing values, + or stop the exection if no defaults are possible. } \details{ Expected fields in settings file are: diff --git a/base/settings/man/clean.settings.Rd b/base/settings/man/clean.settings.Rd index b8e5cf83f1a..1cb552ce7f5 100644 --- a/base/settings/man/clean.settings.Rd +++ b/base/settings/man/clean.settings.Rd @@ -4,8 +4,7 @@ \alias{clean.settings} \title{Cleans PEcAn settings file} \usage{ -clean.settings(inputfile = "pecan.xml", outputfile = "pecan.xml", - write = TRUE) +clean.settings(inputfile = "pecan.xml", outputfile = "pecan.xml", write = TRUE) } \arguments{ \item{inputfile}{the PEcAn settings file to be used.} diff --git a/base/settings/man/createMultiSiteSettings.Rd b/base/settings/man/createMultiSiteSettings.Rd index ab664ce3223..ca8a8b7272f 100644 --- a/base/settings/man/createMultiSiteSettings.Rd +++ b/base/settings/man/createMultiSiteSettings.Rd @@ -7,93 +7,130 @@ createMultiSiteSettings(templateSettings, siteIds) } \arguments{ -\item{templateSettings}{A \code{\link{Settings}} object that will be the template for the resulting -MultiSettings.} +\item{templateSettings}{A \code{\link{Settings}} object that will be +the template for the resulting MultiSettings.} \item{siteIds}{The site IDs to be used in the resulting MultiSettings} } \value{ -A \code{MultiSettings} object with the same settings as \code{templateSettings} but replicated -\code{run$site} blocks, one for each specified site ID. +A \code{MultiSettings} object with the same settings as + \code{templateSettings} but replicated \code{run$site} blocks, + one for each specified site ID. } \description{ -Create a MultiSettings object containing (identical) run blocks for multiple different -sites +Create a MultiSettings object containing (identical) run blocks + for multiple different sites } \details{ -Starts with a template settings object, and duplicates the \code{run$site} block once for each -specified site ID. The resulting MultiSettings is thus identical to the input, except ready to run -for each site in the vector of site IDs. +Starts with a template settings object, and duplicates the \code{run$site} + block once for each specified site ID. The resulting MultiSettings is thus + identical to the input, except ready to run for each site in the vector + of site IDs. } \examples{ -dontrun <- function() { ## Added by Alexey Shiklomanov so this doesn't run and break the build +dontrun <- function() { # Added by Alexey Shiklomanov + # so this doesn't run and break the build -# This isn't necessarily a fully working settings object. Enough to get the idea though. +# This isn't necessarily a fully working settings object. +# Enough to get the idea though. # Note it has a $run block with settings that will be shared across all sites -template = Settings( - list(info = structure(list(notes = NULL, userid = "1000000005", - username = "Ryan Kelly", date = "2016/07/13 13:23:46 -0400"), .Names = c("notes", -"userid", "username", "date")), database = structure(list(bety = structure(list( - user = "bety", password = "bety", host = "psql-pecan.bu.edu", - dbname = "bety", driver = "PostgreSQL", write = "TRUE"), .Names = c("user", -"password", "host", "dbname", "driver", "write")), fia = structure(list( - user = "bety", password = "bety", host = "psql-pecan.bu.edu", - dbname = "fia5", driver = "PostgreSQL", write = "true"), .Names = c("user", -"password", "host", "dbname", "driver", "write"))), .Names = c("bety", -"fia")), pfts = structure(list(pft = structure(list(comment = NULL, - name = "temperate.Evergreen_Hardwood", constants = structure(list( - num = "1"), .Names = "num")), .Names = c("comment", "name", -"constants")), pft = structure(list(name = "temperate.Hydric", - constants = structure(list(num = "2"), .Names = "num")), .Names = c("name", -"constants"))), .Names = c("pft", "pft")), meta.analysis = structure(list( - iter = "3000", random.effects = list(on = FALSE, use_ghs = TRUE), update = "AUTO", - threshold = "1.2"), .Names = c("iter", "random.effects", -"update", "threshold")), ensemble = structure(list(size = "1", - variable = "NPP"), .Names = c("size", "variable")), model = structure(list( - id = "2000000005", edin = "/home/rykelly/pecan/RK_files/ED2IN/ED2IN.rgit.mandifore_04", - config.header = structure(list(radiation = structure(list( - lai_min = "0.01"), .Names = "lai_min"), ed_misc = structure(list( - output_month = "12"), .Names = "output_month")), .Names = c("radiation", - "ed_misc")), phenol.scheme = "0", prerun = "module load hdf5/1.8.11", - binary = "/usr2/postdoc/rykelly/ED2/ED/build/ed_2.1-opt"), .Names = c("id", -"edin", "config.header", "phenol.scheme", "prerun", "binary")), - host = structure(list(name = "geo.bu.edu", user = "rykelly", - folder = "/projectnb/dietzelab/pecan.data/output/rykelly", - qsub = "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash", - qsub.jobid = "Your job ([0-9]+) .*", qstat = "qstat -j @JOBID@ || echo DONE", - prerun = "module load udunits R/R-3.0.0_gnu-4.4.6", dbfiles = "/projectnb/dietzelab/pecan.data/input", - modellauncher = structure(list(binary = "/usr2/postdoc/rykelly/pecan/utils/modellauncher/modellauncher", - qsub.extra = "-pe omp 20"), .Names = c("binary", - "qsub.extra"))), .Names = c("name", "user", "folder", - "qsub", "qsub.jobid", "qstat", "prerun", "dbfiles", "modellauncher" - )), run = structure(list(inputs = structure(list(met = structure(list( - source = "NARR", output = "ED2"), .Names = c("source", - "output")), lu = structure(list(id = "294", path = "/projectnb/dietzelab/EDI/ed_inputs/glu/"), .Names = c("id", - "path")), soil = structure(list(id = "297", path = "/projectnb/dietzelab/EDI/faoOLD/FAO_"), .Names = c("id", - "path")), thsum = structure(list(id = "295", path = "/projectnb/dietzelab/EDI/ed_inputs/"), .Names = c("id", - "path")), veg = structure(list(id = "296", path = "/projectnb/dietzelab/EDI/oge2OLD/OGE2_"), .Names = c("id", - "path")), pss = structure(list(source = "FIA"), .Names = "source")), .Names = c("met", - "lu", "soil", "thsum", "veg", "pss")), start.date = "2004/01/01", - end.date = "2004/01/31"), .Names = c("inputs", "start.date", - "end.date"))) -) +template <- Settings(list( + info = structure(list( + notes = NULL, userid = "1000000005", username = "Ryan Kelly", + date = "2016/07/13 13:23:46 -0400"), + .Names = c("notes", "userid", "username", "date")), + database = structure(list( + bety = structure( + list(user = "bety", password = "bety", host = "psql-pecan.bu.edu", + dbname = "bety", driver = "PostgreSQL", write = "TRUE"), + .Names = c("user", "password", "host", "dbname", "driver", "write")), + fia = structure( + list(user = "bety", password = "bety", host = "psql-pecan.bu.edu", + dbname = "fia5", driver = "PostgreSQL", write = "true"), + .Names = c("user", "password", "host", "dbname", "driver", "write"))), + .Names = c("bety", "fia")), + pfts = structure(list( + pft = structure( + list(comment = NULL, name = "temperate.Evergreen_Hardwood", + constants = structure(list(num = "1"), .Names = "num")), + .Names = c("comment", "name", "constants")), + pft = structure( + list(name = "temperate.Hydric", + constants = structure(list(num = "2"), .Names = "num")), + .Names = c("name", "constants"))), + .Names = c("pft", "pft")), + meta.analysis = structure(list( + iter = "3000", random.effects = list(on = FALSE, use_ghs = TRUE), + update = "AUTO", threshold = "1.2"), + .Names = c("iter", "random.effects", "update", "threshold")), + ensemble = structure(list(size = "1", variable = "NPP"), + .Names = c("size", "variable")), + model = structure(list(id = "2000000005", + edin = "/home/rykelly/pecan/RK_files/ED2IN/ED2IN.rgit.mandifore_04", + config.header = structure(list( + radiation = structure(list(lai_min = "0.01"), .Names = "lai_min"), + ed_misc = structure(list(output_month = "12"), + .Names = "output_month")), + .Names = c("radiation", "ed_misc")), + phenol.scheme = "0", prerun = "module load hdf5/1.8.11", + binary = "/usr2/postdoc/rykelly/ED2/ED/build/ed_2.1-opt"), + .Names = c("id", "edin", "config.header", "phenol.scheme", "prerun", + "binary")), + host = structure(list(name = "geo.bu.edu", user = "rykelly", + folder = "/projectnb/dietzelab/pecan.data/output/rykelly", + qsub = "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash", + qsub.jobid = "Your job ([0-9]+) .*", + qstat = "qstat -j @JOBID@ || echo DONE", + prerun = "module load udunits R/R-3.0.0_gnu-4.4.6", + dbfiles = "/projectnb/dietzelab/pecan.data/input", + modellauncher = structure(list( + binary = "/usr2/postdoc/rykelly/pecan/utils/modellauncher/modellauncher", + qsub.extra = "-pe omp 20"), + .Names = c("binary", "qsub.extra"))), + .Names = c("name", "user", "folder", "qsub", "qsub.jobid", "qstat", + "prerun", "dbfiles", "modellauncher")), + run = structure(list( + inputs = structure(list( + met = structure(list(source = "NARR", output = "ED2"), + .Names = c("source", "output")), + lu = structure(list(id = "294", + path = "/projectnb/dietzelab/EDI/ed_inputs/glu/"), + .Names = c("id", "path")), + soil = structure(list(id = "297", + path = "/projectnb/dietzelab/EDI/faoOLD/FAO_"), + .Names = c("id", "path")), + thsum = structure(list(id = "295", + path = "/projectnb/dietzelab/EDI/ed_inputs/"), + .Names = c("id", "path")), + veg = structure(list(id = "296", + path = "/projectnb/dietzelab/EDI/oge2OLD/OGE2_"), + .Names = c("id", "path")), + pss = structure(list(source = "FIA"), .Names = "source")), + .Names = c("met", "lu", "soil", "thsum", "veg", "pss")), + start.date = "2004/01/01", + end.date = "2004/01/31"), + .Names = c("inputs", "start.date", "end.date")) +)) sitegroupId <- 1000000002 -startDate = "2000/01/01" -endDate = "2015/12/31" +startDate <- "2000/01/01" +endDate <- "2015/12/31" nSite <- 10 -outDir = '~/multisite_setup_test' +outDir <- "~/multisite_setup_test" template <- setDates(template, startDate = startDate, endDate = endDate) template <- setOutDir(template, outDir) -multiRunSettings <- createSitegroupMultiSettings(template, sitegroupId = sitegroupId, nSite=nSite) +multiRunSettings <- createSitegroupMultiSettings( + template, + sitegroupId = sitegroupId, + nSite = nSite) -dir.create(outDir, showWarnings=F) -write.settings(multiRunSettings, outputfile="pecan.xml") +dir.create(outDir, showWarnings = FALSE) +write.settings(multiRunSettings, outputfile = "pecan.xml") } # dontrun } diff --git a/base/settings/man/createSitegroupMultiSettings.Rd b/base/settings/man/createSitegroupMultiSettings.Rd index 6bd1b5f90a2..459a246855b 100644 --- a/base/settings/man/createSitegroupMultiSettings.Rd +++ b/base/settings/man/createSitegroupMultiSettings.Rd @@ -4,103 +4,147 @@ \alias{createSitegroupMultiSettings} \title{Create Sitegroup MultiSettings} \usage{ -createSitegroupMultiSettings(templateSettings, sitegroupId, nSite, - con = NULL, params = templateSettings$database$bety) +createSitegroupMultiSettings( + templateSettings, + sitegroupId, + nSite, + con = NULL, + params = templateSettings$database$bety +) } \arguments{ -\item{templateSettings}{A \code{\link{Settings}} object that will be the template for the resulting -MultiSettings.} +\item{templateSettings}{A \code{\link{Settings}} object that will be the +template for the resulting MultiSettings.} \item{sitegroupId}{The Bety ID of the sitegroup to draw from} -\item{nSite}{The number of sites to randomly select (without replacement) from the siteGroup. Omit -to use all sites in the group.} +\item{nSite}{The number of sites to randomly select (without replacement) +from the siteGroup. Omit to use all sites in the group.} -\item{con, params}{Bety DB connection or parameters. passed directly to \code{\link[PEcAn.DB]{db.query}}} +\item{con, params}{Bety DB connection or parameters. +Passed directly to \code{\link[PEcAn.DB]{db.query}}} } \value{ -A \code{MultiSettings} object with the same settings as \code{templateSettings} but site -information for the selected sites +A \code{MultiSettings} object with the same settings as + \code{templateSettings} but site information for the selected sites } \description{ -Helps to create a MultiSettings object to run some or all sites in a Sitegroup. +Helps to create a MultiSettings object to run some or all + sites in a Sitegroup. } \details{ -Starts with a template settings object, and fills in the \code{run} block with site info sampled from -the sitegroup. The template could be fully set up except for the site info, or more or less empty if you -plan to fill in the other settings later. A \code{\link{MultiSettings}} is created from \code{templateSettings}, -\code{nSite} sites (or all of them, if \code{nSite} is unset) are selected from Bety, and their info -is dropped into the \code{MultiSettings}. +Starts with a template settings object, and fills in the \code{run} block + with site info sampled from the sitegroup. + The template could be fully set up except for the site info, + or more or less empty if you plan to fill in the other settings later. + A \code{\link{MultiSettings}} is created from \code{templateSettings}, + \code{nSite} sites (or all of them, if \code{nSite} is unset) are selected + from Bety, and their info is dropped into the \code{MultiSettings}. } \examples{ -dontrun <- function() { ## Added by Alexey Shiklomanov so this doesn't run and break the build +dontrun <- function() { # Added by Alexey Shiklomanov + # so this doesn't run and break the build -# This isn't necessarily a fully working settings object. Enough to get the idea though. +# This isn't necessarily a fully working settings object. +# Enough to get the idea though. # Note it has a $run block with settings that will be shared across all sites -template = Settings( - list(info = structure(list(notes = NULL, userid = "1000000005", - username = "Ryan Kelly", date = "2016/07/13 13:23:46 -0400"), .Names = c("notes", -"userid", "username", "date")), database = structure(list(bety = structure(list( - user = "bety", password = "bety", host = "psql-pecan.bu.edu", - dbname = "bety", driver = "PostgreSQL", write = "TRUE"), .Names = c("user", -"password", "host", "dbname", "driver", "write")), fia = structure(list( - user = "bety", password = "bety", host = "psql-pecan.bu.edu", - dbname = "fia5", driver = "PostgreSQL", write = "true"), .Names = c("user", -"password", "host", "dbname", "driver", "write"))), .Names = c("bety", -"fia")), pfts = structure(list(pft = structure(list(comment = NULL, - name = "temperate.Evergreen_Hardwood", constants = structure(list( - num = "1"), .Names = "num")), .Names = c("comment", "name", -"constants")), pft = structure(list(name = "temperate.Hydric", - constants = structure(list(num = "2"), .Names = "num")), .Names = c("name", -"constants"))), .Names = c("pft", "pft")), meta.analysis = structure(list( - iter = "3000", random.effects = list(on = FALSE, use_ghs = TRUE), update = "AUTO", - threshold = "1.2"), .Names = c("iter", "random.effects", -"update", "threshold")), ensemble = structure(list(size = "1", - variable = "NPP"), .Names = c("size", "variable")), model = structure(list( - id = "2000000005", edin = "/home/rykelly/pecan/RK_files/ED2IN/ED2IN.rgit.mandifore_04", - config.header = structure(list(radiation = structure(list( - lai_min = "0.01"), .Names = "lai_min"), ed_misc = structure(list( - output_month = "12"), .Names = "output_month")), .Names = c("radiation", - "ed_misc")), phenol.scheme = "0", prerun = "module load hdf5/1.8.11", - binary = "/usr2/postdoc/rykelly/ED2/ED/build/ed_2.1-opt"), .Names = c("id", -"edin", "config.header", "phenol.scheme", "prerun", "binary")), - host = structure(list(name = "geo.bu.edu", user = "rykelly", - folder = "/projectnb/dietzelab/pecan.data/output/rykelly", - qsub = "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash", - qsub.jobid = "Your job ([0-9]+) .*", qstat = "qstat -j @JOBID@ || echo DONE", - prerun = "module load udunits R/R-3.0.0_gnu-4.4.6", dbfiles = "/projectnb/dietzelab/pecan.data/input", - modellauncher = structure(list(binary = "/usr2/postdoc/rykelly/pecan/utils/modellauncher/modellauncher", - qsub.extra = "-pe omp 20"), .Names = c("binary", - "qsub.extra"))), .Names = c("name", "user", "folder", - "qsub", "qsub.jobid", "qstat", "prerun", "dbfiles", "modellauncher" - )), run = structure(list(inputs = structure(list(met = structure(list( - source = "NARR", output = "ED2"), .Names = c("source", - "output")), lu = structure(list(id = "294", path = "/projectnb/dietzelab/EDI/ed_inputs/glu/"), .Names = c("id", - "path")), soil = structure(list(id = "297", path = "/projectnb/dietzelab/EDI/faoOLD/FAO_"), .Names = c("id", - "path")), thsum = structure(list(id = "295", path = "/projectnb/dietzelab/EDI/ed_inputs/"), .Names = c("id", - "path")), veg = structure(list(id = "296", path = "/projectnb/dietzelab/EDI/oge2OLD/OGE2_"), .Names = c("id", - "path")), pss = structure(list(source = "FIA"), .Names = "source")), .Names = c("met", - "lu", "soil", "thsum", "veg", "pss")), start.date = "2004/01/01", - end.date = "2004/01/31"), .Names = c("inputs", "start.date", - "end.date"))) -) +template <- Settings(list( + info = structure(list( + notes = NULL, userid = "1000000005", username = "Ryan Kelly", + date = "2016/07/13 13:23:46 -0400"), + .Names = c("notes", "userid", "username", "date")), + database = structure(list( + bety = structure( + list(user = "bety", password = "bety", host = "psql-pecan.bu.edu", + dbname = "bety", driver = "PostgreSQL", write = "TRUE"), + .Names = c("user", "password", "host", "dbname", "driver", "write")), + fia = structure( + list(user = "bety", password = "bety", host = "psql-pecan.bu.edu", + dbname = "fia5", driver = "PostgreSQL", write = "true"), + .Names = c("user", "password", "host", "dbname", "driver", "write"))), + .Names = c("bety", "fia")), + pfts = structure(list( + pft = structure( + list(comment = NULL, name = "temperate.Evergreen_Hardwood", + constants = structure(list(num = "1"), .Names = "num")), + .Names = c("comment", "name", "constants")), + pft = structure( + list(name = "temperate.Hydric", + constants = structure(list(num = "2"), .Names = "num")), + .Names = c("name", "constants"))), + .Names = c("pft", "pft")), + meta.analysis = structure(list( + iter = "3000", random.effects = list(on = FALSE, use_ghs = TRUE), + update = "AUTO", threshold = "1.2"), + .Names = c("iter", "random.effects", "update", "threshold")), + ensemble = structure(list(size = "1", variable = "NPP"), + .Names = c("size", "variable")), + model = structure(list(id = "2000000005", + edin = "/home/rykelly/pecan/RK_files/ED2IN/ED2IN.rgit.mandifore_04", + config.header = structure(list( + radiation = structure(list(lai_min = "0.01"), .Names = "lai_min"), + ed_misc = structure(list(output_month = "12"), + .Names = "output_month")), + .Names = c("radiation", "ed_misc")), + phenol.scheme = "0", prerun = "module load hdf5/1.8.11", + binary = "/usr2/postdoc/rykelly/ED2/ED/build/ed_2.1-opt"), + .Names = c("id", "edin", "config.header", "phenol.scheme", "prerun", + "binary")), + host = structure(list(name = "geo.bu.edu", user = "rykelly", + folder = "/projectnb/dietzelab/pecan.data/output/rykelly", + qsub = "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash", + qsub.jobid = "Your job ([0-9]+) .*", + qstat = "qstat -j @JOBID@ || echo DONE", + prerun = "module load udunits R/R-3.0.0_gnu-4.4.6", + dbfiles = "/projectnb/dietzelab/pecan.data/input", + modellauncher = structure(list( + binary = "/usr2/postdoc/rykelly/pecan/utils/modellauncher/modellauncher", + qsub.extra = "-pe omp 20"), + .Names = c("binary", "qsub.extra"))), + .Names = c("name", "user", "folder", "qsub", "qsub.jobid", "qstat", + "prerun", "dbfiles", "modellauncher")), + run = structure(list( + inputs = structure(list( + met = structure(list(source = "NARR", output = "ED2"), + .Names = c("source", "output")), + lu = structure(list(id = "294", + path = "/projectnb/dietzelab/EDI/ed_inputs/glu/"), + .Names = c("id", "path")), + soil = structure(list(id = "297", + path = "/projectnb/dietzelab/EDI/faoOLD/FAO_"), + .Names = c("id", "path")), + thsum = structure(list(id = "295", + path = "/projectnb/dietzelab/EDI/ed_inputs/"), + .Names = c("id", "path")), + veg = structure(list(id = "296", + path = "/projectnb/dietzelab/EDI/oge2OLD/OGE2_"), + .Names = c("id", "path")), + pss = structure(list(source = "FIA"), .Names = "source")), + .Names = c("met", "lu", "soil", "thsum", "veg", "pss")), + start.date = "2004/01/01", + end.date = "2004/01/31"), + .Names = c("inputs", "start.date", "end.date")) +)) sitegroupId <- 1000000002 -startDate = "2000/01/01" -endDate = "2015/12/31" +startDate <- "2000/01/01" +endDate <- "2015/12/31" nSite <- 10 -outDir = '~/multisite_setup_test' +outDir <- "~/multisite_setup_test" template <- setDates(template, startDate = startDate, endDate = endDate) template <- setOutDir(template, outDir) -multiRunSettings <- createSitegroupMultiSettings(template, sitegroupId = sitegroupId, nSite=nSite) +multiRunSettings <- createSitegroupMultiSettings( + template, + sitegroupId = sitegroupId, + nSite = nSite) -dir.create(outDir, showWarnings=F) -write.settings(multiRunSettings, outputfile="pecan.xml") +dir.create(outDir, showWarnings = FALSE) +write.settings(multiRunSettings, outputfile = "pecan.xml") } # dontrun } diff --git a/base/settings/man/getRunSettings.Rd b/base/settings/man/getRunSettings.Rd index ab8f34bfd33..697f37c4860 100644 --- a/base/settings/man/getRunSettings.Rd +++ b/base/settings/man/getRunSettings.Rd @@ -2,15 +2,17 @@ % Please edit documentation in R/createMultisiteMultiSettings.r \name{getRunSettings} \alias{getRunSettings} -\title{Build run MultiSettings for a list of site id's} +\title{Build run MultiSettings for a single site id} \usage{ getRunSettings(templateSettings, siteId) } \arguments{ -\item{templateSettings}{} +\item{templateSettings}{A \code{\link{Settings}} object that will be +the template for the resulting MultiSettings.} -\item{siteId}{} +\item{siteId}{site to process. See `createMultiSiteSettings`} } \description{ -Build run MultiSettings for a list of site id's +Processes one site from the `siteIds` argument of `createMultiSiteSettings`. +You probably don't need to call it directly. } diff --git a/base/settings/man/get_args.Rd b/base/settings/man/get_args.Rd new file mode 100644 index 00000000000..9dd874cbe6e --- /dev/null +++ b/base/settings/man/get_args.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_args.R +\name{get_args} +\alias{get_args} +\title{Get Args} +\usage{ +get_args() +} +\value{ +list generated by \link[optparse]{parse_args}; see there for details. +} +\description{ +Used in web/workflow.R to parse command line arguments. +See also https://github.com/PecanProject/pecan/pull/2626. +} +\examples{ +\dontrun{./web/workflow.R -h} +} diff --git a/base/settings/man/listToXml.default.Rd b/base/settings/man/listToXml.default.Rd index 1e169d89a5b..27228be16f7 100644 --- a/base/settings/man/listToXml.default.Rd +++ b/base/settings/man/listToXml.default.Rd @@ -7,7 +7,8 @@ \method{listToXml}{default}(item, tag) } \arguments{ -\item{item}{object to be converted. Despite the function name, need not actually be a list} +\item{item}{object to be converted. +Despite the function name, need not actually be a list} \item{tag}{xml tag} } diff --git a/base/settings/man/loadPath.sitePFT.Rd b/base/settings/man/loadPath.sitePFT.Rd index d849f489b37..6720a73bd8b 100644 --- a/base/settings/man/loadPath.sitePFT.Rd +++ b/base/settings/man/loadPath.sitePFT.Rd @@ -9,11 +9,15 @@ loadPath.sitePFT(settings, Path) \arguments{ \item{settings}{pecan setting list.} -\item{Path}{Character of file name with extension. The path will be generated using the outdir tag in pecan settings.} +\item{Path}{Character of file name with extension. +The path will be generated using the outdir tag in pecan settings.} } \value{ a dataframe of two columns of site and pft } \description{ -The csv or the text file needs to have a header and be separated using comma. Under the first column in the text file, one needs to specify the site id and in the second column there has to be the name of the PFT. +The csv or the text file needs to have a header and be + separated using comma. Under the first column in the text file, + one needs to specify the site id and in the second column there has to be + the name of the PFT. } diff --git a/base/settings/man/papply.Rd b/base/settings/man/papply.Rd index 3e97843182a..fb90a951c50 100644 --- a/base/settings/man/papply.Rd +++ b/base/settings/man/papply.Rd @@ -7,39 +7,46 @@ papply(settings, fn, ..., stop.on.error = FALSE) } \arguments{ -\item{settings}{A \code{\link{MultiSettings}}, \code{\link{Settings}}, or \code{\link[base]{list}} -to operate on} +\item{settings}{A \code{\link{MultiSettings}}, \code{\link{Settings}}, +or \code{\link[base]{list}} to operate on} \item{fn}{The function to apply to \code{settings}} -\item{stop.on.error}{Whether to halt execution if a single element in \code{settings} results -in error. See Details.} +\item{...}{additional arguments to \code{fn}} -\item{\code{...}}{additional arguments to \code{fn}} +\item{stop.on.error}{Whether to halt execution if a single element in +\code{settings} results in error. See Details.} } \value{ -A single \code{fn} return value, or a list of such values (coerced to \code{MultiSettings} -if appropriate; \emph{see Details}) +A single \code{fn} return value, or a list of such values + (coerced to \code{MultiSettings} if appropriate; \emph{see Details}) } \description{ -Works like lapply(), but for PEcAn Settings and MultiSettings objects +Works like lapply(), + but for PEcAn Settings and MultiSettings objects } \details{ -\code{papply} is mainly used to call a function on each \code{\link{Settings}} object in a -\code{\link{MultiSettings}} object, and returning the results in a list. It has some additional -features, however: +\code{papply} is mainly used to call a function on each +\code{\link{Settings}} object in a \code{\link{MultiSettings}} object, +and returning the results in a list. +It has some additional features, however: \itemize{ - \item If the result of \code{fn} is a \code{Settings} object, then \code{papply} will coerce the -returned list into a new \code{MultiSettings}. - \item If \code{settings} is a \code{Settings} object, then \code{papply} knows to call \code{fn} on -it directly. - \item If \code{settings} is a generic \code{list}, then \code{papply} coerces it to a - \code{Settings} object and then calls \code{fn} on it directly. This is meant for backwards - compatibility with old-fashioned PEcAn settings lists, but could have unintended consequences - \item By default, \code{papply} will proceed even if \code{fn} throws an error for one or more - of the elements in \code{settings}. Note that if this option is used, the returned results - list will have entries for \emph{only} those elements that did not result in an error. + \item If the result of \code{fn} is a \code{Settings} object, + then \code{papply} will coerce the returned list into a new + \code{MultiSettings}. + \item If \code{settings} is a \code{Settings} object, + then \code{papply} knows to call \code{fn} on it directly. + \item If \code{settings} is a generic \code{list}, + then \code{papply} coerces it to a \code{Settings} object + and then calls \code{fn} on it directly. + This is meant for backwards compatibility with old-fashioned PEcAn + settings lists, but could have unintended consequences + \item By default, \code{papply} will proceed even if \code{fn} throws an + error for one or more of the elements in \code{settings}. + Note that if this option is used, the returned results list will + have entries for \emph{only} those elements that did not + result in an error. } } \examples{ diff --git a/base/settings/man/prepare.settings.Rd b/base/settings/man/prepare.settings.Rd index aaa5a08c7e1..c7f7992e6fb 100644 --- a/base/settings/man/prepare.settings.Rd +++ b/base/settings/man/prepare.settings.Rd @@ -9,14 +9,15 @@ prepare.settings(settings, force = FALSE) \arguments{ \item{settings}{settings list} -\item{force}{Whether to force the function to run even if it determines it has been run on -these settings already.} +\item{force}{Whether to force the function to run even if it determines +it has been run on these settings already.} } \description{ Update, set defaults for, and otherwise prepare a PEcAn Settings object } \details{ -Performs various checks, fixes deprecated contructs, and assigns missing values where possible. +Performs various checks, fixes deprecated contructs, +and assigns missing values where possible. } \author{ Ryan Kelly diff --git a/base/settings/man/read.settings.Rd b/base/settings/man/read.settings.Rd index eed2b03f669..b58816d728b 100644 --- a/base/settings/man/read.settings.Rd +++ b/base/settings/man/read.settings.Rd @@ -8,9 +8,6 @@ read.settings(inputfile = "pecan.xml") } \arguments{ \item{inputfile}{the PEcAn settings file to be used.} - -\item{outputfile}{the name of file to which the settings will be -written inside the outputdir. If set to null nothing is saved.} } \value{ list of all settings as loaded from the XML file(s) @@ -23,16 +20,17 @@ This will try and find the PEcAn settings file in the following order: \item {PECAN_SETTINGS}{environment variable PECAN_SETTINGS pointing to a specific file} \item {./pecan.xml}{pecan.xml in the current folder} } -Once the function finds a valid file, it will not look further. -Thus, if \code{inputfile} is supplied, \code{PECAN_SETTINGS} will be ignored. -Even if a \code{file} argument is passed, it will be ignored if a file is passed through -a higher priority method. +Once the function finds a valid file, it will not look further. +Thus, if \code{inputfile} is supplied, \code{PECAN_SETTINGS} will be + ignored. +Even if a \code{file} argument is passed, it will be ignored if a file + is passed through a higher priority method. } \examples{ \dontrun{ ## bash shell: ## example workflow.R and pecan.xml files in pecan/tests -R --vanilla -- --settings path/to/mypecan.xml < workflow.R +R --vanilla -- --settings path/to/mypecan.xml < workflow.R ## R: diff --git a/base/settings/man/setDates.Rd b/base/settings/man/setDates.Rd index b4e45d44b37..be8d039e538 100644 --- a/base/settings/man/setDates.Rd +++ b/base/settings/man/setDates.Rd @@ -15,12 +15,14 @@ setDates(settings, startDate, endDate) The original \code{Settings} object with updated dates } \description{ -Sets the run, ensemble, and sensitivity analysis dates of PEcAn Settings +Sets the run, ensemble, and sensitivity analysis dates + of PEcAn Settings } \details{ -Sets the start/end dates in \code{settings$run} to the specified dates, and sets the corresponding -years for \code{settings$ensemble} and \code{settings$sensitivity.analysis}. Either date can be -omitted to leave it unchanged. +Sets the start/end dates in \code{settings$run} to the specified dates, + and sets the corresponding years for \code{settings$ensemble} and + \code{settings$sensitivity.analysis}. +Either date can be omitted to leave it unchanged. } \author{ Ryan Kelly diff --git a/base/settings/man/setOutDir.Rd b/base/settings/man/setOutDir.Rd index 7eac7818f26..9ae7d6e660e 100644 --- a/base/settings/man/setOutDir.Rd +++ b/base/settings/man/setOutDir.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/createMultisiteMultiSettings.r \name{setOutDir} \alias{setOutDir} -\title{Set the Ouptu Directories of PEcAn Settings} +\title{Set the Output Directories of PEcAn Settings} \usage{ setOutDir(settings, outDir) } @@ -18,10 +18,11 @@ The original \code{Settings} object with updated output directories Sets the main output directory and nulls out the others } \details{ -Sets the main output directory (\code{settings$outdir}) to \code{outDir}, and sets numerous others -(\code{settings$modeloutdir}, \code{settings$host$rundir}, \code{settings$host$outdir}, -\code{settings$host$modeloutdir}) to NULL so they will revert to defaults when -\code{\link{check.settings}} is run. +Sets the main output directory (\code{settings$outdir}) to \code{outDir}, + and sets numerous others (\code{settings$modeloutdir}, + \code{settings$host$rundir}, \code{settings$host$outdir}, + \code{settings$host$modeloutdir}) to NULL so they will revert to defaults + when \code{\link{check.settings}} is run. } \author{ Ryan Kelly diff --git a/base/settings/man/site.pft.link.settings.Rd b/base/settings/man/site.pft.link.settings.Rd index 084f0b42a55..8a01070d9ba 100644 --- a/base/settings/man/site.pft.link.settings.Rd +++ b/base/settings/man/site.pft.link.settings.Rd @@ -13,5 +13,7 @@ site.pft.link.settings(settings) pecan xml setting file } \description{ -This function reads in a pecan setting and check for the pft.site xml tag under run>inputs . If a path or a ID for the input is defined then, it will be used for linking sites with the pfts. +This function reads in a pecan setting and check for the + pft.site xml tag under run>inputs. If a path or a ID for the input is + defined then, it will be used for linking sites with the pfts. } diff --git a/base/settings/man/site.pft.linkage.Rd b/base/settings/man/site.pft.linkage.Rd index 991fe086376..f2ffcb40791 100644 --- a/base/settings/man/site.pft.linkage.Rd +++ b/base/settings/man/site.pft.linkage.Rd @@ -9,14 +9,21 @@ site.pft.linkage(settings, site.pft.links) \arguments{ \item{settings}{pecan settings list.} -\item{site.pft.links}{dataframe. Your look up table should have two columns of site and pft with site ids under site column and pft names under pft column.} +\item{site.pft.links}{dataframe. Your look up table should have two columns +of site and pft with site ids under site column +and pft names under pft column.} } \value{ pecan setting list } \description{ -This function creates the required tags inside pecan.xml to link sites with pfts given a look up table. If the required tags are already defined in the pecan xml then they will be updated. -If there are multiple pfts that they need to be used for a site, each pft needs to have a separate row in the lookup table, resulting multiple rows for a site. +This function creates the required tags inside pecan.xml + to link sites with pfts given a look up table. + If the required tags are already defined in the pecan xml + then they will be updated. + If there are multiple pfts that they need to be used for a site, + each pft needs to have a separate row in the lookup table, + resulting multiple rows for a site. } \examples{ \dontrun{ @@ -29,7 +36,7 @@ site.pft.links <-tribble( "772", "temperate.broadleaf.deciduous3", "763", "temperate.broadleaf.deciduous4" ) - + # sending a multi- setting xml file to the function site.pft.linkage(settings,site.pft.links) } diff --git a/base/settings/man/write.settings.Rd b/base/settings/man/write.settings.Rd index 797b3560c78..a9796a26bfd 100644 --- a/base/settings/man/write.settings.Rd +++ b/base/settings/man/write.settings.Rd @@ -14,7 +14,8 @@ write.settings(settings, outputfile, outputdir = settings$outdir) \item{outputdir}{the directory to write to} } \description{ -Takes in a settings object, performs a series of checks, fixes & updates settings and produces pecan.CHECKED.xml +Takes in a settings object, performs a series of checks, + fixes & updates settings and produces pecan.CHECKED.xml } \author{ Ryan Kelly diff --git a/base/settings/tests/Rcheck_reference.log b/base/settings/tests/Rcheck_reference.log new file mode 100644 index 00000000000..b1cfb5b5564 --- /dev/null +++ b/base/settings/tests/Rcheck_reference.log @@ -0,0 +1,123 @@ +* using log directory ‘/tmp/RtmpNKOZJQ/PEcAn.settings.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.settings/DESCRIPTION’ ... OK +* this is package ‘PEcAn.settings’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.settings’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... OK +* checking top-level files ... NOTE +Non-standard file/directory found at top level: + ‘examples’ +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... NOTE +Package in Depends field not imported from: ‘methods’ + These packages need to be imported from (in the NAMESPACE file) + for when this namespace is loaded but not attached. +* checking S3 generic/method consistency ... WARNING +listToXml: + function(x, ...) +listToXml.MultiSettings: + function(item, tag, collapse) + +listToXml: + function(x, ...) +listToXml.default: + function(item, tag) + +update: + function(object, ...) +update.settings: + function(settings, force) + +See section ‘Generic functions and methods’ in the ‘Writing R +Extensions’ manual. + +Found the following apparent S3 methods exported but not registered: + update.settings +See section ‘Registering S3 methods’ in the ‘Writing R Extensions’ +manual. +* checking replacement functions ... WARNING + ‘$<-.MultiSettings’ ‘[<-.MultiSettings’ ‘[[<-.MultiSettings’ +The argument of a replacement function which corresponds to the right +hand side must be named ‘value’. +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +check.ensemble.settings: no visible binding for global variable + ‘startdate’ +check.ensemble.settings: no visible binding for global variable + ‘enddate’ +site.pft.link.settings: no visible binding for global variable ‘.’ +Undefined global functions or variables: + . enddate startdate +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... WARNING +Undocumented code objects: + ‘expandMultiSettings’ ‘listToXml’ ‘printAll’ ‘settingNames’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'addSecrets' + ‘force’ + +Undocumented arguments in documentation object 'check.model.settings' + ‘dbcon’ + +Undocumented arguments in documentation object 'check.run.settings' + ‘dbcon’ + +Undocumented arguments in documentation object 'check.settings' + ‘force’ + +Undocumented arguments in documentation object 'check.workflow.settings' + ‘dbcon’ + +Undocumented arguments in documentation object 'clean.settings' + ‘write’ + +Undocumented arguments in documentation object 'fix.deprecated.settings' + ‘force’ + +Undocumented arguments in documentation object 'update.settings' + ‘force’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 4 WARNINGs, 3 NOTEs diff --git a/base/settings/tests/testthat.R b/base/settings/tests/testthat.R index b817a3c567b..9842744f2a8 100644 --- a/base/settings/tests/testthat.R +++ b/base/settings/tests/testthat.R @@ -1,7 +1,7 @@ #------------------------------------------------------------------------------- # Copyright (c) 2012 University of Illinois, NCSA. # All rights reserved. This program and the accompanying materials -# are made available under the terms of the +# are made available under the terms of the # University of Illinois/NCSA Open Source License # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html diff --git a/base/settings/tests/testthat/helper-get.test.settings.R b/base/settings/tests/testthat/helper-get.test.settings.R index 96e548dde17..6da1380a14e 100644 --- a/base/settings/tests/testthat/helper-get.test.settings.R +++ b/base/settings/tests/testthat/helper-get.test.settings.R @@ -1,18 +1,26 @@ -.get.test.settings = function(outdir=NULL) { +.get.test.settings <- function(outdir = NULL) { settings <- NULL try({ - if(PEcAn.remote::fqdn() == "pecan2.bu.edu") { + if (PEcAn.remote::fqdn() == "pecan2.bu.edu") { settings <- read.settings("testinput.pecan2.bu.edu.xml") } else { settings <- read.settings("testinput.xml") } - }, - silent=T) - - if(is.null(settings)) { + }, + silent = TRUE) + + # NB environment variables override values in XML here! + # This is opposite of usual PEcAn rule that XML values always win, + # but useful here because it allows testing on systems where we + # don't know the database configuration in advance + settings$database$bety <- do.call( + PEcAn.DB::get_postgres_envvars, + settings$database$bety) + + if (is.null(settings)) { skip("Can't get a valid test Settings right now. Skipping test. ") } - if(!is.null(outdir)){ + if (!is.null(outdir)) { settings$outdir <- outdir } return(settings) diff --git a/base/settings/tests/testthat/test.MultiSettings.class.R b/base/settings/tests/testthat/test.MultiSettings.class.R index dff5278d5ad..0e07a6a5d4f 100644 --- a/base/settings/tests/testthat/test.MultiSettings.class.R +++ b/base/settings/tests/testthat/test.MultiSettings.class.R @@ -1,21 +1,16 @@ #---------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -## #------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ context("test MultiSettings class") -if(FALSE) { - library(devtools) - rm(list=ls()) - load_all() -} # SETUP -l <- list(aa=1, bb=2, cc=list(dd=3, ee=4)) +l <- list(aa = 1, bb = 2, cc = list(dd = 3, ee = 4)) settings <- settings2 <- Settings(l) settings2$aa <- 9 multiSettingsTemplate <- MultiSettings(settings, settings2) @@ -25,17 +20,17 @@ test_that("MultiSettings constructor works as expected", { expect_error(MultiSettings(l, l)) expect_error(MultiSettings(sl, l)) expect_error(MultiSettings(settings, l)) - + multiSettings <- MultiSettings(settings, settings, settings) multiSettings2 <- MultiSettings(list(settings, settings, settings)) multiSettings3 <- MultiSettings(multiSettings) expect_identical(multiSettings2, multiSettings) expect_identical(multiSettings3, multiSettings) - - for(i in seq_along(multiSettings)) { + + for (i in seq_along(multiSettings)) { expect_identical(multiSettings[[i]], settings) } - + expect_true(inherits(multiSettings, "list")) expect_true(inherits(multiSettings, "MultiSettings")) expect_true(is.MultiSettings(multiSettings)) @@ -45,32 +40,37 @@ test_that("MultiSettings constructor works as expected", { # -------------- EXTRACT test_that("MultiSettings extracts work as expected", { - s1 <- Settings(a=1, b=2, c=3) - s2 <- Settings(a=1, b=22, d=4) + s1 <- Settings(a = 1, b = 2, c = 3) + s2 <- Settings(a = 1, b = 22, d = 4) s3 <- s2 multiSettings <- MultiSettings(s1, s2, s3) - + # --- Normal extraction expect_identical(multiSettings[[1]], s1) expect_identical(multiSettings[1], MultiSettings(s1)) expect_identical(multiSettings[1:3], multiSettings) - + # --- Extract by name # Collapses normally expect_equal(multiSettings$a, 1) expect_equal(multiSettings[["a"]], 1) - expect_equivalent(multiSettings[["a", collapse=F]], replicate(3, 1, F)) - + expect_equivalent( + multiSettings[["a", collapse = FALSE]], + replicate(3, 1, FALSE)) + # Can't collapse because not equal expect_equivalent(multiSettings$b, list(s1$b, s2$b, s3$b)) expect_equivalent(multiSettings[["b"]], list(s1$b, s2$b, s3$b)) - expect_equivalent(multiSettings[["b", collapse=F]], list(s1$b, s2$b, s3$b)) - + expect_equivalent( + multiSettings[["b", collapse = FALSE]], + list(s1$b, s2$b, s3$b)) + # Can't collapse because not shared by all expect_equivalent(multiSettings$c, list(s1$c, s2$c, s3$c)) expect_equivalent(multiSettings[["c"]], list(s1$c, s2$c, s3$c)) - expect_equivalent(multiSettings[["c", collapse=F]], list(s1$c, s2$c, s3$c)) - + expect_equivalent(multiSettings[["c", collapse = FALSE]], + list(s1$c, s2$c, s3$c)) + # Explicitly prohibited to prevent confusion expect_error(multiSettings["a"]) expect_error(multiSettings[c("a", "b", "c")]) @@ -99,16 +99,16 @@ test_that("Settings can be added by numerical indexing to [[, removed by adding length0 <- length(multiSettingsTemplate) expect_silent(multiSettings[[length(multiSettings) + 1]] <- settings) expect_equal(length(multiSettings), length0 + 1) - for(i in 1:length0) { + for (i in seq_len(length0)) { expect_identical(multiSettings[[i]], multiSettingsTemplate[[i]]) } expect_identical(multiSettings[[length(multiSettings)]], settings) expect_silent(multiSettings[[1]] <- NULL) expect_equal(length(multiSettings), length0) - if(length0 > 1) { - for(i in 1:(length0-1)) { - expect_identical(multiSettings[[i]], multiSettingsTemplate[[i+1]]) + if (length0 > 1) { + for (i in seq_len(length0 - 1)) { + expect_identical(multiSettings[[i]], multiSettingsTemplate[[i + 1]]) } } expect_identical(multiSettings[[length0]], settings) @@ -119,8 +119,8 @@ test_that("Settings can be added by numerical indexing to [[, removed by adding test_that("Assignments by name apply to each Settings individually", { multiSettings <- expected <- multiSettingsTemplate expect_silent(multiSettings$x <- 1) - - for(i in seq_along(multiSettings)) { + + for (i in seq_along(multiSettings)) { expected[[i]]$x <- 1 expect_identical(multiSettings[[i]], expected[[i]]) } @@ -128,10 +128,10 @@ test_that("Assignments by name apply to each Settings individually", { test_that("Assignments by name works as expcted for list value", { multiSettings <- expected <- multiSettingsTemplate - value = list(x=1, y=3:5, z="z") + value <- list(x = 1, y = 3:5, z = "z") expect_silent(multiSettings$x <- value) - - for(i in seq_along(multiSettings)) { + + for (i in seq_along(multiSettings)) { expected[[i]]$x <- value expect_identical(multiSettings[[i]], expected[[i]]) expect_identical(multiSettings[[i]]$x, value) @@ -145,7 +145,7 @@ test_that("Assigning NULL by name removes setting from each Setting", { expect_silent(multiSettings$aa <- NULL) expect_equal(length(multiSettings[[1]]), length0 - 1) - for(i in seq_along(multiSettings)) { + for (i in seq_along(multiSettings)) { expected[[i]]$aa <- NULL expect_identical(multiSettings[[i]], expected[[i]]) } @@ -153,28 +153,29 @@ test_that("Assigning NULL by name removes setting from each Setting", { test_that("Assigning non-globally applies values sequentially to Settings", { multiSettings <- expected <- multiSettingsTemplate - expect_silent(multiSettings[["x", global=F]] <- 1:length(multiSettings)) - for(i in seq_along(multiSettings)) { + expect_silent( + multiSettings[["x", global = FALSE]] <- seq_along(multiSettings)) + for (i in seq_along(multiSettings)) { expected[[i]]$x <- i expect_identical(multiSettings[[i]], expected[[i]]) } - + expect_true(length(multiSettings) > 1) - for(i in 2:length(multiSettings)) { + for (i in 2:length(multiSettings)) { expected[[i]]$y <- i } - - y <- expected[["y", F]] - expect_silent(multiSettings[["y", global=F]] <- y) + + y <- expected[["y", FALSE]] + expect_silent(multiSettings[["y", global = FALSE]] <- y) expect_identical(multiSettings, expected) expect_true(is.null(multiSettings[[1]]$y)) }) test_that("Assigning non-globally applies values sequentially to Settings", { multiSettings <- expected <- multiSettingsTemplate - x <- 1:length(multiSettings) - expect_silent(multiSettings[["x", global=F]] <- x) - for(i in seq_along(multiSettings)) { + x <- seq_along(multiSettings) + expect_silent(multiSettings[["x", global = FALSE]] <- x) + for (i in seq_along(multiSettings)) { expected[[i]]$x <- i expect_identical(multiSettings[[i]], expected[[i]]) expect_true(is.numeric(multiSettings[[i]]$x)) @@ -185,12 +186,12 @@ test_that("Assigning non-globally applies values sequentially to Settings", { test_that("Assigning a list of values non-globally works as expected", { multiSettings <- expected <- multiSettingsTemplate x <- list() - for(i in seq_along(multiSettings)) { - x[[i]] = as.list(i * 1:3) + for (i in seq_along(multiSettings)) { + x[[i]] <- as.list(i * 1:3) } - - expect_silent(multiSettings[["x", global=F]] <- x) - for(i in seq_along(multiSettings)) { + + expect_silent(multiSettings[["x", global = FALSE]] <- x) + for (i in seq_along(multiSettings)) { expected[[i]]$x <- x[[i]] expect_identical(multiSettings[[i]], expected[[i]]) expect_true(is.list(multiSettings[[i]]$x)) @@ -201,12 +202,12 @@ test_that("Assigning a list of values non-globally works as expected", { test_that("Assigning non-globally works as expected for a values list containing NULL", { multiSettings <- expected <- multiSettingsTemplate - y <- 1:length(multiSettings) + y <- seq_along(multiSettings) y[1] <- list(NULL) - - expect_silent(multiSettings[["y", global=F]] <- y) + + expect_silent(multiSettings[["y", global = FALSE]] <- y) expect_true(is.null(multiSettings[[1]]$y)) - for(i in 2:length(multiSettings)) { + for (i in 2:length(multiSettings)) { expected[[i]]$y <- y[[i]] expect_identical(multiSettings[[i]], expected[[i]]) } @@ -214,13 +215,13 @@ test_that("Assigning non-globally works as expected for a values list containing test_that("Assigning non-globally works as expected for a values list containing NULL when previous value was non-NULL", { multiSettings <- expected <- multiSettingsTemplate - y <- 1:length(multiSettings) + y <- seq_along(multiSettings) y[1] <- list(NULL) - + multiSettings$y <- 1 - expect_silent(multiSettings[["y", global=F]] <- y) + expect_silent(multiSettings[["y", global = FALSE]] <- y) expect_true(is.null(multiSettings[[1]]$y)) - for(i in 2:length(multiSettings)) { + for (i in 2:length(multiSettings)) { expected[[i]]$y <- y[[i]] expect_identical(multiSettings[[i]], expected[[i]]) } @@ -229,16 +230,18 @@ test_that("Assigning non-globally works as expected for a values list containing test_that("Assigning non-globally by name throws error for length mismatch", { multiSettings <- multiSettingsTemplate - expect_error(multiSettings[["x", global=F]] <- rep(1, length(multiSettings) - 1)) - expect_error(multiSettings[["x", global=F]] <- rep(1, length(multiSettings) + 1)) + expect_error( + multiSettings[["x", global = FALSE]] <- rep(1, length(multiSettings) - 1)) + expect_error( + multiSettings[["x", global = FALSE]] <- rep(1, length(multiSettings) + 1)) }) test_that("Assigning non-globally to a single-element MultiSettings expands it to match length of value", { multiSettings <- MultiSettings(settings) x <- 1:3 - expect_silent(multiSettings[["x", global=F]] <- x) + expect_silent(multiSettings[["x", global = FALSE]] <- x) expect_equal(length(multiSettings), 3) - for(i in seq_along(multiSettings)) { + for (i in seq_along(multiSettings)) { newSettings <- settings newSettings$x <- i expect_identical(multiSettings[[i]], newSettings) @@ -249,13 +252,13 @@ test_that("Assigning non-globally to a single-element MultiSettings expands it t test_that("Assigning non-globally to a single-element MultiSettings expands it to match length of value, when value is a list", { multiSettings <- MultiSettings(settings) x <- list() - for(i in 1:3) { - x[[i]] = as.list(i * 1:3) + for (i in 1:3) { + x[[i]] <- as.list(i * 1:3) } - - expect_silent(multiSettings[["x", global=F]] <- x) + + expect_silent(multiSettings[["x", global = FALSE]] <- x) expect_equal(length(multiSettings), 3) - for(i in seq_along(multiSettings)) { + for (i in seq_along(multiSettings)) { newSettings <- settings newSettings$x <- x[[i]] expect_identical(multiSettings[[i]], newSettings) @@ -268,17 +271,17 @@ test_that("Assigning non-globally to a single-element MultiSettings expands it t # ------------ To/From XML # helper fn are.equal.possiblyNumericToCharacter <- function(o1, o2) { - if(length(o1) != length(o2)) { + if (length(o1) != length(o2)) { return(FALSE) - } else if(is.list(o1)) { - for(i in seq_along(o1)) { - if(!are.equal.possiblyNumericToCharacter(o1[[i]], o2[[i]])) { + } else if (is.list(o1)) { + for (i in seq_along(o1)) { + if (!are.equal.possiblyNumericToCharacter(o1[[i]], o2[[i]])) { return(FALSE) } } return(TRUE) } else { - if(is.numeric(o1) || is.numeric(o2)) { + if (is.numeric(o1) || is.numeric(o2)) { o2 <- as.numeric(o2) o1 <- as.numeric(o1) } @@ -288,11 +291,11 @@ are.equal.possiblyNumericToCharacter <- function(o1, o2) { test_that("multiSettings write to and read from xml as expcted (i.e., with collapsing/expanding global settings)", { msOrig <- multiSettingsTemplate - + msXML <- PEcAn.settings::listToXml(msOrig, "pecan.multi") listNew <- XML::xmlToList(msXML) msNew <- expandMultiSettings(listNew) - + expect_true(are.equal.possiblyNumericToCharacter(msNew, msOrig)) }) @@ -301,5 +304,3 @@ test_that("expandMultiSettings does nothing to a non-MultiSettings list", { expect_identical(settings, expandMultiSettings(settings)) expect_identical(l, expandMultiSettings(l)) }) - - diff --git a/base/settings/tests/testthat/test.Safelist.class.R b/base/settings/tests/testthat/test.Safelist.class.R index f1f6370446e..6bb7a319054 100644 --- a/base/settings/tests/testthat/test.Safelist.class.R +++ b/base/settings/tests/testthat/test.Safelist.class.R @@ -1,25 +1,25 @@ #---------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -## #------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ context("test SafeList class") test_that("SafeList constructors work as expected", { - l <- list(aa=1, bb=2, cc=list(dd=3, ee=4)) - s1 <- SafeList(aa=1, bb=2, cc=list(dd=3, ee=4)) + l <- list(aa = 1, bb = 2, cc = list(dd = 3, ee = 4)) + s1 <- SafeList(aa = 1, bb = 2, cc = list(dd = 3, ee = 4)) s2 <- SafeList(l) s3 <- as.SafeList(l) - - for(i in seq_along(l)) { + + for (i in seq_along(l)) { expect_identical(s1[[i]], l[[i]]) } expect_identical(s1, s2) expect_identical(s1, s3) - + expect_true(inherits(s1, "list")) expect_true(inherits(s1, "SafeList")) expect_true(is.SafeList(s1)) @@ -28,25 +28,24 @@ test_that("SafeList constructors work as expected", { }) test_that("SafeList indexing works as expected", { - l <- list(aa=1, bb=2) + l <- list(aa = 1, bb = 2) s <- SafeList(l) - + # [[ works same for list and SafeList object - expect_equal(s[["bb"]], 2) - expect_equal(l[["bb"]], 2) - expect_equal(s[["bb", exact=T]], 2) - expect_equal(l[["bb", exact=T]], 2) - expect_equal(l[["b", exact=F]], 2) - expect_equal(s[["b", exact=F]], 2) - expect_null(l[["b", exact=T]]) - expect_null(s[["b", exact=T]]) - + expect_equal(s[["bb"]], 2) + expect_equal(l[["bb"]], 2) + expect_equal(s[["bb", exact = TRUE]], 2) + expect_equal(l[["bb", exact = TRUE]], 2) + expect_equal(l[["b", exact = FALSE]], 2) + expect_equal(s[["b", exact = FALSE]], 2) + expect_null(l[["b", exact = TRUE]]) + expect_null(s[["b", exact = TRUE]]) + # $ operator works the same for both when exact match expect_equal(l$bb, 2) expect_equal(s$bb, 2) - + # $ operator returns NULL (same as [[ name, exact=T]]) if no exact match expect_equal(l$b, 2) expect_null(s$b) }) - diff --git a/base/settings/tests/testthat/test.Settings.class.R b/base/settings/tests/testthat/test.Settings.class.R index bcf24c2a099..e210d22184d 100644 --- a/base/settings/tests/testthat/test.Settings.class.R +++ b/base/settings/tests/testthat/test.Settings.class.R @@ -1,28 +1,28 @@ #---------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -## #------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ context("test Settings class") test_that("Settings constructors work as expected", { - l <- list(aa=1, bb=2, cc=list(dd=3, ee=4)) + l <- list(aa = 1, bb = 2, cc = list(dd = 3, ee = 4)) sl <- SafeList(l) - settings1 <- Settings(aa=1, bb=2, cc=list(dd=3, ee=4)) + settings1 <- Settings(aa = 1, bb = 2, cc = list(dd = 3, ee = 4)) settings2 <- Settings(l) settings3 <- Settings(sl) settings4 <- Settings(settings1) - - for(i in seq_along(l)) { + + for (i in seq_along(l)) { expect_identical(settings1[[i]], l[[i]]) } expect_identical(settings1, settings2) expect_identical(settings1, settings3) expect_identical(settings1, settings4) - + expect_true(inherits(settings1, "list")) expect_true(inherits(settings1, "SafeList")) expect_true(inherits(settings1, "Settings")) @@ -31,5 +31,3 @@ test_that("Settings constructors work as expected", { expect_false(is.Settings(l)) expect_equal(length(class(settings1)), 3) }) - - diff --git a/base/settings/tests/testthat/test.deprecated.settings.R b/base/settings/tests/testthat/test.deprecated.settings.R index b9b033dfa30..8960ac14f37 100644 --- a/base/settings/tests/testthat/test.deprecated.settings.R +++ b/base/settings/tests/testthat/test.deprecated.settings.R @@ -2,27 +2,27 @@ ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -## #------------------------------------------------------------------------------- +#---------------------------------------------------------------------------- PEcAn.logger::logger.setQuitOnSevere(FALSE) PEcAn.logger::logger.setLevel("OFF") context("fix.deprecated.settings") test_that("deprecated jobtemplate settings handled correctly", { settings <- .get.test.settings() - settings$run$jobtemplate = "somefile" - settings$model$jobtemplate = "otherfile" + settings$run$jobtemplate <- "somefile" + settings$model$jobtemplate <- "otherfile" expect_error(fix.deprecated.settings(settings)) - - settings$model$jobtemplate = NULL - settings = fix.deprecated.settings(settings) + + settings$model$jobtemplate <- NULL + settings <- fix.deprecated.settings(settings) expect_equal(settings$model$jobtemplate, "somefile") expect_null(settings$run$jobtemplate) - - settings = fix.deprecated.settings(settings) + + settings <- fix.deprecated.settings(settings) expect_equal(settings$model$jobtemplate, "somefile") expect_null(settings$run$jobtemplate) }) @@ -30,33 +30,33 @@ test_that("deprecated jobtemplate settings handled correctly", { test_that("deprecated dbfiles settings handled correctly", { settings <- .get.test.settings() - settings$run$dbfiles = "somefile" - settings$database$dbfiles = "otherfile" + settings$run$dbfiles <- "somefile" + settings$database$dbfiles <- "otherfile" expect_error(fix.deprecated.settings(settings)) - - settings$database$dbfiles = NULL - settings = fix.deprecated.settings(settings) + + settings$database$dbfiles <- NULL + settings <- fix.deprecated.settings(settings) expect_equal(settings$database$dbfiles, "somefile") expect_null(settings$run$dbfiles) - - settings = fix.deprecated.settings(settings) - expect_equal( settings$database$dbfiles, "somefile") + + settings <- fix.deprecated.settings(settings) + expect_equal(settings$database$dbfiles, "somefile") expect_null(settings$run$dbfiles) }) test_that("deprecated host settings handled correctly", { settings <- .get.test.settings() host <- list(name = "localhost") - settings$run$host = host - settings$host = host + settings$run$host <- host + settings$host <- host expect_error(fix.deprecated.settings(settings)) - - settings$host = NULL - settings = fix.deprecated.settings(settings) + + settings$host <- NULL + settings <- fix.deprecated.settings(settings) expect_equal(settings$host, host) expect_null(settings$run$dbfiles) - - settings = fix.deprecated.settings(settings) + + settings <- fix.deprecated.settings(settings) expect_equal(settings$host, host) expect_null(settings$run$dbfiles) }) diff --git a/base/settings/tests/testthat/test.papply.R b/base/settings/tests/testthat/test.papply.R index 3b60d292609..dfe9a4fd721 100644 --- a/base/settings/tests/testthat/test.papply.R +++ b/base/settings/tests/testthat/test.papply.R @@ -1,27 +1,22 @@ #---------------------------------------------------------------------------- ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -## #------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ context("test papply") -if(FALSE) { - library(devtools) - rm(list=ls()) - load_all() -} # SETUP -l <- list(aa=1, bb=2, cc=list(dd=3, ee=4)) +l <- list(aa = 1, bb = 2, cc = list(dd = 3, ee = 4)) settings <- settings2 <- Settings(l) settings2$aa <- 2 multiSettingsTemplate <- MultiSettings(settings, settings2) fun <- function(settings) { - if(is.na(settings$aa)) { + if (is.na(settings$aa)) { stop("aa is NA!") } else { return(settings$aa) @@ -54,13 +49,13 @@ test_that("papply returns new MultiSettings if result of fn is a Settings object } expected <- multiSettings expected[[1]]$aa <- expected[[2]]$aa <- 0 - + actual <- papply(multiSettings, fun2) expect_true(identical(actual, expected)) - # Make sure that would fail if result was a plain old list + # Make sure that would fail if result was a plain old list expectedAsListNotMultisettings <- expected - class(expectedAsListNotMultisettings) = "list" + class(expectedAsListNotMultisettings) <- "list" expect_false(identical(actual, expectedAsListNotMultisettings)) expect_equivalent(actual, expectedAsListNotMultisettings) }) @@ -72,21 +67,21 @@ test_that("papply stop.on.error works as expected", { expected <- multiSettings$aa expected[[2]] <- NULL - - actual <- papply(multiSettings, fun, stop.on.error=FALSE) + + actual <- papply(multiSettings, fun, stop.on.error = FALSE) expect_identical(actual, expected) - + actual <- NULL - expect_error(actual <- papply(multiSettings, fun, stop.on.error=TRUE)) + expect_error(actual <- papply(multiSettings, fun, stop.on.error = TRUE)) expect_null(actual) }) test_that("stop.on.error works as expected when returning new MultiSettings", { multiSettings <- multiSettingsTemplate multiSettings[[2]]$aa <- NA - + fun2 <- function(settings) { - if(is.na(settings$aa)) { + if (is.na(settings$aa)) { stop("aa is NA!") } else { settings$aa <- 0 @@ -96,25 +91,11 @@ test_that("stop.on.error works as expected when returning new MultiSettings", { expected <- multiSettings[1] expected[[1]]$aa <- 0 expect_true(is.MultiSettings(expected)) - - actual <- papply(multiSettings, fun2, stop.on.error=FALSE) + + actual <- papply(multiSettings, fun2, stop.on.error = FALSE) expect_true(identical(actual, expected)) actual <- NULL - expect_error(actual <- papply(multiSettings, fun2, stop.on.error=TRUE)) + expect_error(actual <- papply(multiSettings, fun2, stop.on.error = TRUE)) expect_null(actual) }) - - - - - - - - - - - - - - diff --git a/base/settings/tests/testthat/test.read.settings.R b/base/settings/tests/testthat/test.read.settings.R index 5c653c1c67d..2df448781df 100644 --- a/base/settings/tests/testthat/test.read.settings.R +++ b/base/settings/tests/testthat/test.read.settings.R @@ -2,11 +2,11 @@ ## Copyright (c) 2012 University of Illinois, NCSA. ## All rights reserved. This program and the accompanying materials -## are made available under the terms of the +## are made available under the terms of the ## University of Illinois/NCSA Open Source License ## which accompanies this distribution, and is available at ## http://opensource.ncsa.illinois.edu/license.html -## #------------------------------------------------------------------------------- +#------------------------------------------------------------------------------ context("tests for read.settings and related functions") PEcAn.logger::logger.setQuitOnSevere(FALSE) @@ -28,69 +28,70 @@ test_that("read.settings returned correctly", { s <- .get.test.settings() skip("Tests failing due to multisite?") expect_true(file.exists(s$outdir)) - expect_true(file.info(s$outdir)$isdir) + expect_true(file.info(s$outdir)$isdir) }) -test_that("read settings returns error if no settings file found (issue #1124)",{ - expect_error(read.settings("nofile.xml"), "Could not find a pecan.xml file") +test_that("read settings returns error if no settings file found (#1124)", { + expect_error(read.settings("nofile.xml"), "Could not find a pecan.xml file") }) test_that("check.settings throws error if pft has different type than model", { s <- .get.test.settings(testdir) - s[["model"]]$model_type <- 'SIPNET' + s[["model"]]$model_type <- "SIPNET" expect_error(check.settings(update.settings(s))) }) -test_that("check.settings gives sensible defaults",{ - ## This provides the minimum inputs +test_that("check.settings gives sensible defaults", { + ## This provides the minimum inputs s1 <- list( - pfts = list(pft = list(name = "salix", outdir = file.path(testdir, "pft"))), + pfts = list( + pft = list(name = "salix", outdir = file.path(testdir, "pft"))), database = NULL, model = list(type = "BIOCRO"), run = list( - start.date = lubridate::now(), + start.date = lubridate::now(), end.date = lubridate::days(1) + lubridate::now() ), - outdir = file.path(testdir, "PEcAn_@WORKFLOW@") # would create in cwd if not specified + # would create in cwd if not specified + outdir = file.path(testdir, "PEcAn_@WORKFLOW@") ) s2 <- check.settings(update.settings(s1)) - expect_true(is.null(s2$database) || - (length(s2$database)==1 && names(s2$database)=="dbfiles")) - + expect_true(is.null(s2$database) + || (length(s2$database) == 1 && names(s2$database) == "dbfiles")) + s <- .get.test.settings(testdir) s1$database <- s$database - s1$database$bety$write = FALSE # RyK added because throws an error otherwise! + s1$database$bety$write <- FALSE # RyK added because throws an error otherwise! s2 <- check.settings(update.settings(s1)) expect_equal(s2$database$bety$driver, "PostgreSQL") ## dir. paths, with default localhost expect_equal(s2$host$name, "localhost") - + ## outdirs outdir <- file.path(testdir, paste0("PEcAn_", s2$workflow$id)) expect_equal(s2$outdir, outdir) expect_equal(s2$host$outdir, file.path(outdir, "out")) expect_equal(s2$modeloutdir, s2$host$outdir) - + ## rundir - expect_equal(s2$rundir, file.path(outdir, "run")) + expect_equal(s2$rundir, file.path(outdir, "run")) expect_equal(s2$rundir, s2$host$rundir) - + ## meta.analysis s1$meta.analysis$update <- TRUE # Required to trigger fixes to meta analysis settings s2 <- check.settings(s1) expect_true(s2$meta.analysis$iter > 1000) expect_false(s2$meta.analysis$random.effects$on) - }) -test_that("pfts are defined and are in database",{ +test_that("pfts are defined and are in database", { s <- .get.test.settings(testdir) s$outdir <- testdir s$pfts <- list(pft = list()) expect_error(check.settings(update.settings(s))) - + s$pfts <- list(pft = list(name = "")) expect_error(check.settings(update.settings(s))) @@ -100,37 +101,38 @@ test_that("pfts are defined and are in database",{ test_that("check.settings uses run dates if dates not given in ensemble or sensitivity analysis", { s <- .get.test.settings(testdir) - - for(node in c("ensemble", "sensitivity.analysis")) { + + for (node in c("ensemble", "sensitivity.analysis")) { s1 <- list(pfts = s$pfts, database = list(bety = s$database$bety), run = s$run, model = s$model, outdir = s$outdir) s1[[node]] <- list(variable = "FOO") s2 <- check.settings(update.settings(s1)) expect_equivalent(s2[[node]]$start.year, lubridate::year(s2$run$start.date)) expect_equivalent(s2[[node]]$end.year, lubridate::year(s2$run$end.date)) - - s1 <- list(pfts = s$pfts, database = list(bety = s$database$bety), run = NA, model=s$model) + + s1 <- list(pfts = s$pfts, database = list(bety = s$database$bety), + run = NA, model = s$model) s1[[node]] <- list(variable = "FOO", start.year = 1000, end.year = 1000) expect_error(check.settings(update.settings(s1))) } }) -test_that("sensitivity.analysis and ensemble use other's settings if null",{ +test_that("sensitivity.analysis and ensemble use other's settings if null", { s <- .get.test.settings(testdir) s$run$start.date <- s$run$end.date <- NULL # Otherwise these would be used - s$database$bety$write = FALSE # otherwise will error for trying to add with no run dates + s$database$bety$write <- FALSE # otherwise will error for trying to add with no run dates nodes <- c("sensitivity.analysis", "ensemble") - for(node1 in nodes) { + for (node1 in nodes) { node2 <- nodes[nodes != node1] s1 <- list(pfts = s$pfts, database = list(bety = s$database$bety), run = s$run, model = s$model, outdir = s$outdir) s1[[node1]] <- list(variable = "FOO", start.year = 2003, end.year = 2004) s1[[node2]] <- list() s2 <- check.settings(update.settings(s1)) - for(setting in c("variable", "start.year", "end.year")){ - expect_equal(s2[[node1]][[setting]], s2[[node2]][[setting]]) + for (setting in c("variable", "start.year", "end.year")) { + expect_equal(s2[[node1]][[setting]], s2[[node2]][[setting]]) } expect_equal(s2$ensemble$size, 1) } @@ -140,17 +142,17 @@ test_that("workflow id is numeric if settings$database$bety$write = FALSE", { s <- .get.test.settings(testdir) s1 <- check.settings(update.settings(s)) expect_is(s1$workflow$id, c("character", "numeric")) - + s$workflow <- NULL s1 <- check.settings(update.settings(s)) expect_is(s1$workflow$id, c("integer", "numeric")) }) -test_that("check.settings will fail if db does not exist",{ +test_that("check.settings will fail if db does not exist", { s <- .get.test.settings(testdir) - expect_true(db.exists(s$database$bety)) + expect_true(PEcAn.DB::db.exists(s$database$bety)) s$database$bety$dbname <- "blabla" - expect_false(db.exists(s$database$bety)) + expect_false(PEcAn.DB::db.exists(s$database$bety)) expect_error(check.settings(update.settings(s))) }) @@ -162,28 +164,27 @@ test_that("check.settings handles userid and username properly", { s1$database$bety[["userid"]] <- "bety" s1$database$bety[["user"]] <- NULL s2 <- check.settings(update.settings(s1)) - expect_true("user" %in% names(s2$database$bety)) + expect_true("user" %in% names(s2$database$bety)) expect_true(!"userid" %in% names(s2$database$bety)) - + s1 <- .get.test.settings(testdir) s1$database$bety[["username"]] <- "bety" s1$database$bety[["user"]] <- NULL s2 <- check.settings(update.settings(s1)) - expect_true("user" %in% names(s2$database$bety)) + expect_true("user" %in% names(s2$database$bety)) expect_true(!"username" %in% names(s2$database$bety)) - + s1 <- .get.test.settings(testdir) s1$database$bety[["userid"]] <- "bety" s2 <- check.settings(update.settings(s1)) - expect_true("user" %in% names(s2$database$bety)) + expect_true("user" %in% names(s2$database$bety)) expect_true(!"userid" %in% names(s2$database$bety)) - + s1 <- .get.test.settings(testdir) s1$database$bety[["username"]] <- "bety" s2 <- check.settings(update.settings(s1)) - expect_true("user" %in% names(s2$database$bety)) + expect_true("user" %in% names(s2$database$bety)) expect_true(!"username" %in% names(s2$database$bety)) - }) test_that("check settings sets model$type based on model$name and model$model_type", { @@ -215,89 +216,91 @@ test_that("check settings runs with only model$name and no database", { expect_identical(s$model$name, s1$model$type) }) -test_that("invalid pathname is placed in home directory",{ +test_that("invalid pathname is placed in home directory", { s <- .get.test.settings(testdir) s$database$dbfiles <- "foo/bar" s1 <- check.settings(update.settings(s)) - expect_equal(s1$database$dbfiles, file.path(Sys.getenv("HOME"), s$database$dbfiles)) + expect_equal( + s1$database$dbfiles, + file.path(Sys.getenv("HOME"), s$database$dbfiles)) }) -test_that("update.settings only runs once unless forced",{ +test_that("update.settings only runs once unless forced", { s <- .get.test.settings(testdir) expect_null(s$model$type) - + s <- update.settings(s) expect_equal(s$model$type, "BIOCRO") expect_true(s$settings.info$settings.updated) - + # Won't run a second time... s$model$name <- s$model$type s$model$type <- NULL s <- update.settings(s) expect_null(s$model$type) - + # ...unless forced - s <- update.settings(s, force=TRUE) + s <- update.settings(s, force = TRUE) expect_equal(s$model$type, "BIOCRO") }) -test_that("check.settings only runs once unless forced",{ +test_that("check.settings only runs once unless forced", { s <- .get.test.settings(testdir) s$database$bety$driver <- NULL s <- check.settings(update.settings(s)) - + expect_equal(s$database$bety$driver, "PostgreSQL") expect_true(s$settings.info$checked) - - + + # Won't run a second time... s$database$bety$driver <- NULL s <- check.settings(s) expect_null(s$database$bety$driver) - + # ...unless forced - s <- check.settings(s, force=TRUE) + s <- check.settings(s, force = TRUE) expect_equal(s$database$bety$driver, "PostgreSQL") }) -test_that("fix.deprecated.settings only runs once unless forced",{ +test_that("fix.deprecated.settings only runs once unless forced", { s <- .get.test.settings(testdir) expected <- s$database$dbfiles s$run$dbfiles <- s$database$dbfiles s$database$dbfiles <- NULL - + s <- fix.deprecated.settings(s) expect_identical(s$database$dbfiles, expected) expect_null(s$run$dbfiles) - + # Won't run a second time... s$run$dbfiles <- s$database$dbfiles s$database$dbfiles <- NULL s <- fix.deprecated.settings(s) expect_identical(s$run$dbfiles, expected) expect_null(s$database$dbfiles) - + # ...unless forced - s <- fix.deprecated.settings(s, force=TRUE) + s <- fix.deprecated.settings(s, force = TRUE) expect_identical(s$database$dbfiles, expected) expect_null(s$run$dbfiles) }) -test_that("check.settings works for a MultiSettings",{ +test_that("check.settings works for a MultiSettings", { s1 <- .get.test.settings(testdir) - s1 <- check.settings(update.settings(s1)) # Make sure all other settings are fine + s1 <- check.settings(update.settings(s1)) # Make sure all other settings OK s1$database$bety$driver <- NULL s2 <- s1 # Change a setting to ensure that there will be a difference between the two Settings s2$database$dbfiles <- file.path(s2$database$dbfiles, "dummy") - + ms <- MultiSettings(s1, s2) - ms <- check.settings(ms, force=TRUE) - + ms <- check.settings(ms, force = TRUE) + expect_equal(length(ms$database), 2) expect_false(identical(ms[[1]]$database, ms[[2]]$database)) expect_equal(ms[[1]]$database$bety$driver, "PostgreSQL") diff --git a/base/utils/.Rbuildignore b/base/utils/.Rbuildignore index 91114bf2f2b..0fa6193e633 100644 --- a/base/utils/.Rbuildignore +++ b/base/utils/.Rbuildignore @@ -1,2 +1,3 @@ ^.*\.Rproj$ ^\.Rproj\.user$ +^scripts diff --git a/base/utils/DESCRIPTION b/base/utils/DESCRIPTION index 14795f1c5f7..b7468806c83 100644 --- a/base/utils/DESCRIPTION +++ b/base/utils/DESCRIPTION @@ -1,19 +1,21 @@ Package: PEcAn.utils Type: Package -Title: PEcAn functions used for ecological forecasts and - reanalysis -Version: 1.7.1 -Date: 2019-09-05 -Authors@R: c(person("Mike","Dietze"), - person("David","LeBauer"), - person("Xiaohui", "Feng"), - person("Dan"," Wang"), - person("Carl", "Davidson"), - person("Rob","Kooper"), - person("Shawn", "Serbin")) -Author: David LeBauer, Mike Dietze, Xiaohui Feng, Dan Wang, - Carl Davidson, Rob Kooper, Shawn Serbin -Maintainer: David LeBauer +Title: PEcAn Functions Used for Ecological Forecasts and + Reanalysis +Version: 1.7.2 +Date: 2021-10-04 +Authors@R: c( + person("Mike", "Dietze", role = "aut"), + person("Rob","Kooper", role = c("aut", "cre"), + email = "kooper@illinois.edu"), + person("David","LeBauer", role = c("aut")), + person("Xiaohui", "Feng", role = c("aut")), + person("Dan"," Wang", role = c("aut")), + person("Carl", "Davidson", role = c("aut")), + person("Shawn", "Serbin", role = c("aut")), + person("Shashank", "Singh", role = c("aut")), + person("Chris", "Black", role = c("aut")), + person("University of Illinois, NCSA", role = c("cph"))) Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific workflow management tool that is designed to simplify the management of model @@ -31,6 +33,7 @@ Imports: PEcAn.remote, purrr, RCurl, + rlang, stringi, udunits2 (>= 0.11), XML @@ -39,10 +42,6 @@ Suggests: data.table, ggplot2, MASS, - PEcAn.data.atmosphere, - PEcAn.data.land, - PEcAn.emulator, - PEcAn.settings, PEcAn.DB, randtoolbox, raster, @@ -50,9 +49,9 @@ Suggests: sp, testthat (>= 2.0.0), xtable -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyData: true Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 Roxygen: list(markdown = TRUE) diff --git a/base/utils/NAMESPACE b/base/utils/NAMESPACE index 0b8158083f9..83ee767abda 100644 --- a/base/utils/NAMESPACE +++ b/base/utils/NAMESPACE @@ -8,23 +8,17 @@ export(cf2doy) export(clear.scratch) export(convert.expr) export(convert.input) -export(create.base.plot) export(datetime2cf) export(datetime2doy) export(days_in_year) export(distn.stats) export(distn.table.stats) -export(do_conversions) export(download.file) export(download.url) -export(ensemble.filename) export(full.path) export(get.ensemble.inputs) -export(get.ensemble.samples) -export(get.model.output) export(get.parameter.stat) export(get.quantiles) -export(get.results) export(get.run.id) export(get.sa.sample.list) export(get.sa.samples) @@ -32,16 +26,6 @@ export(left.pad.zeros) export(listToArgString) export(load.modelpkg) export(load_local) -export(logger.debug) -export(logger.error) -export(logger.getLevel) -export(logger.info) -export(logger.setLevel) -export(logger.setOutputFile) -export(logger.setQuitOnSevere) -export(logger.setWidth) -export(logger.severe) -export(logger.warn) export(match_file) export(mcmc.list2init) export(misc.are.convertible) @@ -49,20 +33,13 @@ export(misc.convert) export(mstmipvar) export(n_leap_day) export(paste.stats) -export(plot_data) export(r2bugs.distributions) -export(read.ensemble.output) export(read.output) -export(read.sa.output) export(read_web_config) export(retry.func) export(rsync) -export(run.write.configs) -export(runModule.get.results) -export(runModule.run.write.configs) export(seconds_in_year) export(sendmail) -export(sensitivity.filename) export(ssh) export(status.check) export(status.end) @@ -79,17 +56,6 @@ export(transformstats) export(tryl) export(units_are_equivalent) export(vecpaste) -export(write.ensemble.configs) -export(write.sa.configs) export(zero.truncate) -importFrom(PEcAn.logger,logger.debug) -importFrom(PEcAn.logger,logger.error) -importFrom(PEcAn.logger,logger.getLevel) -importFrom(PEcAn.logger,logger.info) -importFrom(PEcAn.logger,logger.setLevel) -importFrom(PEcAn.logger,logger.setOutputFile) -importFrom(PEcAn.logger,logger.setQuitOnSevere) -importFrom(PEcAn.logger,logger.setWidth) -importFrom(PEcAn.logger,logger.severe) -importFrom(PEcAn.logger,logger.warn) importFrom(magrittr,"%>%") +importFrom(rlang,.data) diff --git a/base/utils/R/convert.input.R b/base/utils/R/convert.input.R index ff036039d21..e5f488987dd 100644 --- a/base/utils/R/convert.input.R +++ b/base/utils/R/convert.input.R @@ -56,6 +56,7 @@ ##' @param ensemble An integer representing the number of ensembles, or FALSE if it data product is not an ensemble. ##' @param ensemble_name If convert.input is being called iteratively for each ensemble, ensemble_name contains the identifying name/number for that ensemble. ##' @param ... Additional arguments, passed unchanged to \code{fcn} +##' @param dbparms list of parameters to use for opening a database connection ##' ##' @return A list of two BETY IDs (input.id, dbfile.id) identifying a pre-existing file if one was available, or a newly created file if not. Each id may be a vector of ids if the function is processing an entire ensemble at once. ##' @@ -168,7 +169,7 @@ convert.input <- hostname = host$name, exact.dates = TRUE, pattern = filename_pattern) - + if(nrow(existing.dbfile[[i]]) > 0) { existing.input[[i]] <- PEcAn.DB::db.query(paste0("SELECT * FROM inputs WHERE id=", existing.dbfile[[i]]$container_id),con) @@ -221,18 +222,23 @@ convert.input <- verbose = TRUE,R = Rbinary, scratchdir = outfolder) successful <- FALSE - on.exit(if (exists("successful") && successful) { - PEcAn.logger::logger.info("Conversion successful, with overwrite=TRUE. Deleting old files.") - PEcAn.remote::remote.execute.R( file.deletion.commands$delete.tmp, - host, user = NA, - verbose = TRUE, R = Rbinary, scratchdir = outfolder ) - } else { - PEcAn.logger::logger.info("Conversion failed. Replacing old files.") - PEcAn.remote::remote.execute.R( file.deletion.commands$replace.from.tmp, - host, user = NA, - verbose = TRUE, R = Rbinary, scratchdir = outfolder ) - } - )#Close on.exit + on.exit( + if (exists("successful") && successful) { + PEcAn.logger::logger.info( + "Conversion successful, with overwrite=TRUE. Deleting old files.") + PEcAn.remote::remote.execute.R( + file.deletion.commands$delete.tmp, + host, user = NA, + verbose = TRUE, R = Rbinary, scratchdir = outfolder) + } else { + PEcAn.logger::logger.info("Conversion failed. Replacing old files.") + PEcAn.remote::remote.execute.R( + file.deletion.commands$replace.from.tmp, + host, user = NA, + verbose = TRUE, R = Rbinary, scratchdir = outfolder) + }, + add = TRUE + ) # Close on.exit } # If all of the files for an existing ensemble exist, we'll just use those files. Otherwise, we'll need to run the function to @@ -265,8 +271,11 @@ convert.input <- hostname = host$name, exact.dates = TRUE, pattern = pattern - ) %>% - dplyr::filter(id==input.args$dbfile.id) + ) + if ("id" %in% colnames(existing.dbfile)) { + existing.dbfile <- existing.dbfile %>% + dplyr::filter(.data$id==input.args$dbfile.id) + } }else{ existing.dbfile <- PEcAn.DB::dbfile.input.check(siteid = site.id, mimetype = mimetype, @@ -319,18 +328,22 @@ convert.input <- # Schedule files to be replaced or deleted on exiting the function successful <- FALSE - on.exit(if (exists("successful") && successful) { - PEcAn.logger::logger.info("Conversion successful, with overwrite=TRUE. Deleting old files.") - PEcAn.remote::remote.execute.R( file.deletion.commands$delete.tmp, - host, user = NA, - verbose = TRUE, R = Rbinary, scratchdir = outfolder ) - } else { - PEcAn.logger::logger.info("Conversion failed. Replacing old files.") - PEcAn.remote::remote.execute.R( file.deletion.commands$replace.from.tmp, - host, user = NA, - verbose = TRUE, R = Rbinary, scratchdir = outfolder ) - } - )#Close on.exit + on.exit( + if (exists("successful") && successful) { + PEcAn.logger::logger.info("Conversion successful, with overwrite=TRUE. Deleting old files.") + PEcAn.remote::remote.execute.R( + file.deletion.commands$delete.tmp, + host, user = NA, + verbose = TRUE, R = Rbinary, scratchdir = outfolder) + } else { + PEcAn.logger::logger.info("Conversion failed. Replacing old files.") + PEcAn.remote::remote.execute.R( + file.deletion.commands$replace.from.tmp, + host, user = NA, + verbose = TRUE, R = Rbinary, scratchdir = outfolder) + }, + add = TRUE + ) # Close on.exit } @@ -436,21 +449,25 @@ convert.input <- # Schedule files to be replaced or deleted on exiting the function successful <- FALSE - on.exit(if (exists("successful") && successful) { - PEcAn.logger::logger.info("Conversion successful, with overwrite=TRUE. Deleting old files.") - PEcAn.remote::remote.execute.R( file.deletion.commands$delete.tmp, - host, user = NA, - verbose = TRUE, R = Rbinary, scratchdir = outfolder ) - - } else { - - PEcAn.logger::logger.info("Conversion failed. Replacing old files.") - PEcAn.remote::remote.execute.R( file.deletion.commands$replace.from.tmp, - host, user = NA, - verbose = TRUE, R = Rbinary, scratchdir = outfolder ) - } - )#close on on.exit - + on.exit( + if (exists("successful") && successful) { + PEcAn.logger::logger.info( + "Conversion successful, with overwrite=TRUE. Deleting old files.") + PEcAn.remote::remote.execute.R( + file.deletion.commands$delete.tmp, + host, user = NA, + verbose = TRUE, R = Rbinary, scratchdir = outfolder) + } else { + PEcAn.logger::logger.info( + "Conversion failed. Replacing old files.") + PEcAn.remote::remote.execute.R( + file.deletion.commands$replace.from.tmp, + host, user = NA, + verbose = TRUE, R = Rbinary, scratchdir = outfolder) + }, + add = TRUE + ) # close on.exit + } else if ((start_date >= existing.input$start_date) && (end_date <= existing.input$end_date)) { @@ -638,32 +655,17 @@ convert.input <- fname <- list.files(outfolder) } } - - # settings$run$inputs$path <- outputfile - # what if there is more than 1 output file? - rows <- length(fname) - result <- data.frame(file = character(rows), - host = character(rows), - mimetype = character(rows), - formatname = character(rows), - startdate = character(rows), - enddate = character(rows), - stringsAsFactors = FALSE) - - - - for (i in seq_len(rows)) { - old.file <- file.path(dbfile$file_path, files[i]) - new.file <- file.path(outfolder, fname[i]) - - # create array with results - result$file[i] <- new.file - result$host[i] <- PEcAn.remote::fqdn() - result$startdate[i] <- paste(input$start_date, "00:00:00") - result$enddate[i] <- paste(input$end_date, "23:59:59") - result$mimetype[i] <- mimetype - result$formatname[i] <- formatname - } + + result <- data.frame( + # contains one row for each file in fname + file = file.path(outfolder, fname), + host = PEcAn.remote::fqdn(), + mimetype = mimetype, + formatname = formatname, + startdate = paste(input$start_date, "00:00:00"), + enddate = paste(input$end_date, "23:59:59"), + stringsAsFactors = FALSE) + } else if (conversion == "local.remote") { # perform conversion on local or remote host diff --git a/base/utils/R/datasets.R b/base/utils/R/datasets.R index 384e0f1ba86..c5ada7f5679 100644 --- a/base/utils/R/datasets.R +++ b/base/utils/R/datasets.R @@ -15,7 +15,7 @@ #' \item{Variable.Name}{Short name suitable for programming with} #' \item{standard_name}{Name used in the NetCDF \href{http://cfconventions.org/standard-names.html}{CF metadata conventions} } #' \item{Units}{Standard units for this variable. Do not call variables by these names if they are in different units. -#' See \code{\link[udunits2]{udunits}} for conversions to and from non-standard units} +#' See \code{\link[udunits2]{ud.convert}} for conversions to and from non-standard units} #' \item{Long.Name}{Human-readable variable name, suitable for e.g. axis labels} #' \item{Category}{What kind of variable is it? (Carbon pool, N flux, dimension, input driver, etc)} #' \item{var_type}{Storage type (character, integer, etc)} diff --git a/base/utils/R/do_conversions.R b/base/utils/R/do_conversions.R deleted file mode 100644 index ff7e2211667..00000000000 --- a/base/utils/R/do_conversions.R +++ /dev/null @@ -1,103 +0,0 @@ -##' @export -##' @aliases do.conversions -##' @name do_conversions -##' @title do_conversions -##' @description Input conversion workflow -##' -##' DEPRECATED: This function has been moved to the PEcAn.workflow package and will be removed from PEcAn.utils. -##' @param settings PEcAn settings list -##' @param overwrite.met,overwrite.fia,overwrite.ic logical -##' -##' @author Ryan Kelly, Rob Kooper, Betsy Cowdery, Istem Fer - -do_conversions <- function(settings, overwrite.met = FALSE, overwrite.fia = FALSE, overwrite.ic = FALSE) { - - .Deprecated("PEcAn.workflow::do_conversions") - - if (PEcAn.settings::is.MultiSettings(settings)) { - return(PEcAn.settings::papply(settings, do_conversions)) - } - - needsave <- FALSE - if (is.character(settings$run$inputs)) { - settings$run$inputs <- NULL ## check for empty set - } - - dbfiles.local <- settings$database$dbfiles - dbfiles <- ifelse(!PEcAn.remote::is.localhost(settings$host) & !is.null(settings$host$folder), settings$host$folder, dbfiles.local) - PEcAn.logger::logger.debug("do.conversion outdir",dbfiles) - for (i in seq_along(settings$run$inputs)) { - input <- settings$run$inputs[[i]] - if (is.null(input)) { - next - } - - input.tag <- names(settings$run$input)[i] - PEcAn.logger::logger.info("PROCESSING: ",input.tag) - - - ic.flag <- fia.flag <- FALSE - - if ((input.tag %in% c("css", "pss", "site")) && - is.null(input$path) && !is.null(input$source)) { - if(!is.null(input$useic)){ # set TRUE if IC Workflow, leave empty if not - ic.flag <- TRUE - }else if(input$source == "FIA"){ - fia.flag <- TRUE - # possibly a warning for deprecation in the future - } - } - - # IC conversion : for now for ED only, hence the css/pss/site check - # TRUE - if (ic.flag) { - settings <- PEcAn.data.land::ic_process(settings, input, dir = dbfiles, overwrite = overwrite.ic) - needsave <- TRUE - } - - # keep fia.to.psscss - if (fia.flag) { - settings <- PEcAn.data.land::fia.to.psscss(settings, overwrite = overwrite.fia) - needsave <- TRUE - } - - # soil extraction - if(input.tag == "soil"&& is.null(input$path)){ - settings$run$inputs[[i]][['path']] <- PEcAn.data.land::soil_process(settings,input,dbfiles.local,overwrite=FALSE) - needsave <- TRUE - ## NOTES: at the moment only processing soil locally. Need to think about how to generalize this - ## because many models will read PEcAn standard in write.configs and write out into settings - ## which is done locally in rundir and then rsync'ed to remote - ## rather than having a model-format soils file that is processed remotely - } - # met conversion - - if (input.tag == "met") { - name <- ifelse(is.null(settings$browndog), "MET Process", "BrownDog") - if ( (PEcAn.utils::status.check(name) == 0)) { ## previously is.null(input$path) && - PEcAn.logger::logger.info("calling met.process: ",settings$run$inputs[[i]][['path']]) - settings$run$inputs[[i]] <- - PEcAn.data.atmosphere::met.process( - site = settings$run$site, - input_met = settings$run$inputs$met, - start_date = settings$run$start.date, - end_date = settings$run$end.date, - model = settings$model$type, - host = settings$host, - dbparms = settings$database$bety, - dir = dbfiles, - browndog = settings$browndog, - spin = settings$spin, - overwrite = overwrite.met) - PEcAn.logger::logger.debug("updated met path: ",settings$run$inputs[[i]][['path']]) - needsave <- TRUE - } - } - } - if (needsave) { - XML::saveXML(PEcAn.settings::listToXml(settings, "pecan"), file = file.path(settings$outdir, "pecan.METProcess.xml")) - } else if (file.exists(file.path(settings$outdir, "pecan.METProcess.xml"))) { - settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.METProcess.xml")) - } - return(settings) -} diff --git a/base/utils/R/ensemble.R b/base/utils/R/ensemble.R deleted file mode 100644 index 5d1cddafea7..00000000000 --- a/base/utils/R/ensemble.R +++ /dev/null @@ -1,352 +0,0 @@ -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - -##' Reads output from model ensemble -##' -##' Reads output for an ensemble of length specified by \code{ensemble.size} and bounded by \code{start.year} -##' and \code{end.year} -##' -##' DEPRECATED: This function has been moved to the \code{PEcAn.uncertainty} package. -##' The version in \code{PEcAn.utils} is deprecated, will not be updated to add any new features, -##' and will be removed in a future release of PEcAn. -##' Please use \code{PEcAn.uncertainty::read.ensemble.output} instead. -##' -##' @title Read ensemble output -##' @return a list of ensemble model output -##' @param ensemble.size the number of ensemble members run -##' @param pecandir specifies where pecan writes its configuration files -##' @param outdir directory with model output to use in ensemble analysis -##' @param start.year first year to include in ensemble analysis -##' @param end.year last year to include in ensemble analysis -##' @param variables target variables for ensemble analysis -##' @export -##' @author Ryan Kelly, David LeBauer, Rob Kooper -#--------------------------------------------------------------------------------------------------# -read.ensemble.output <- function(ensemble.size, pecandir, outdir, start.year, end.year, - variable, ens.run.ids = NULL) { - - .Deprecated( - new = "PEcAn.uncertainty::read.ensemble.output", - msg = paste( - "read.ensemble.output has been moved to PEcAn.uncertainty and is deprecated from PEcAn.utils.", - "Please use PEcAn.uncertainty::read.ensemble.output instead.", - "PEcAn.utils::read.ensemble.output will not be updated and will be removed from a future version of PEcAn.", - sep = "\n")) - - if (is.null(ens.run.ids)) { - samples.file <- file.path(pecandir, "samples.Rdata") - if (file.exists(samples.file)) { - load(samples.file) - ens.run.ids <- runs.samples$ensemble - } else { - stop(samples.file, "not found required by read.ensemble.output") - } - } - - expr <- variable$expression - variables <- variable$variables - - ensemble.output <- list() - for (row in rownames(ens.run.ids)) { - run.id <- ens.run.ids[row, "id"] - PEcAn.logger::logger.info("reading ensemble output from run id: ", run.id) - - for(var in seq_along(variables)){ - out.tmp <- read.output(run.id, file.path(outdir, run.id), start.year, end.year, variables[var]) - assign(variables[var], out.tmp[[variables[var]]]) - } - - # derivation - out <- eval(parse(text = expr)) - - ensemble.output[[row]] <- mean(out, na.rm= TRUE) - - } - return(ensemble.output) -} # read.ensemble.output - - -##' Get parameter values used in ensemble -##' -##' DEPRECATED: This function has been moved to the \code{PEcAn.uncertainty} package. -##' The version in \code{PEcAn.utils} is deprecated, will not be updated to add any new features, -##' and will be removed in a future release of PEcAn. -##' Please use \code{PEcAn.uncertainty::get.ensemble.samples} instead. - -##' Returns a matrix of randomly or quasi-randomly sampled trait values -##' to be assigned to traits over several model runs. -##' given the number of model runs and a list of sample distributions for traits -##' The model run is indexed first by model run, then by trait -##' -##' @title Get Ensemble Samples -##' @name get.ensemble.samples -##' @param ensemble.size number of runs in model ensemble -##' @param pft.samples random samples from parameter distribution, e.g. from a MCMC chain -##' @param env.samples env samples -##' @param method the method used to generate the ensemble samples. Random generators: uniform, uniform with latin hypercube permutation. Quasi-random generators: halton, sobol, torus. Random generation draws random variates whereas quasi-random generation is deterministic but well equidistributed. Default is uniform. For small ensemble size with relatively large parameter number (e.g ensemble size < 5 and # of traits > 5) use methods other than halton. -##' @param param.names a list of parameter names that were fitted either by MA or PDA, important argument, if NULL parameters will be resampled independently -##' -##' @return matrix of (quasi-)random samples from trait distributions -##' @export -##' @author David LeBauer, Istem Fer -get.ensemble.samples <- function(ensemble.size, pft.samples, env.samples, - method = "uniform", param.names = NULL, ...) { - - .Deprecated( - new = "PEcAn.uncertainty::get.ensemble.samples", - msg = paste( - "get.ensemble.samples has been moved to PEcAn.uncertainty and is deprecated from PEcAn.utils.", - "Please use PEcAn.uncertainty::get.ensemble.samples instead.", - "PEcAn.utils::get.ensemble.samples will not be updated and will be removed from a future version of PEcAn.", - sep = "\n")) - - if (is.null(method)) { - PEcAn.logger::logger.info("No sampling method supplied, defaulting to uniform random sampling") - method <- "uniform" - } - - ## force as numeric for compatibility with Fortran code in halton() - ensemble.size <- as.numeric(ensemble.size) - if (ensemble.size <= 0) { - ans <- NULL - } else if (ensemble.size == 1) { - ans <- get.sa.sample.list(pft.samples, env.samples, 0.5) - } else { - pft.samples[[length(pft.samples) + 1]] <- env.samples - names(pft.samples)[length(pft.samples)] <- "env" - pft2col <- NULL - for (i in seq_along(pft.samples)) { - pft2col <- c(pft2col, rep(i, length(pft.samples[[i]]))) - } - - - total.sample.num <- sum(sapply(pft.samples, length)) - random.samples <- NULL - - - if (method == "halton") { - need_packages("randtoolbox") - PEcAn.logger::logger.info("Using ", method, "method for sampling") - random.samples <- randtoolbox::halton(n = ensemble.size, dim = total.sample.num, ...) - ## force as a matrix in case length(samples)=1 - random.samples <- as.matrix(random.samples) - } else if (method == "sobol") { - need_packages("randtoolbox") - PEcAn.logger::logger.info("Using ", method, "method for sampling") - random.samples <- randtoolbox::sobol(n = ensemble.size, dim = total.sample.num, ...) - ## force as a matrix in case length(samples)=1 - random.samples <- as.matrix(random.samples) - } else if (method == "torus") { - need_packages("randtoolbox") - PEcAn.logger::logger.info("Using ", method, "method for sampling") - random.samples <- randtoolbox::torus(n = ensemble.size, dim = total.sample.num, ...) - ## force as a matrix in case length(samples)=1 - random.samples <- as.matrix(random.samples) - } else if (method == "lhc") { - need_packages("PEcAn.emulator") - PEcAn.logger::logger.info("Using ", method, "method for sampling") - random.samples <- PEcAn.emulator::lhc(t(matrix(0:1, ncol = total.sample.num, nrow = 2)), ensemble.size) - } else if (method == "uniform") { - PEcAn.logger::logger.info("Using ", method, "random sampling") - # uniform random - random.samples <- matrix(stats::runif(ensemble.size * total.sample.num), - ensemble.size, - total.sample.num) - } else { - PEcAn.logger::logger.info("Method ", method, " has not been implemented yet, using uniform random sampling") - # uniform random - random.samples <- matrix(stats::runif(ensemble.size * total.sample.num), - ensemble.size, - total.sample.num) - } - - - ensemble.samples <- list() - - - col.i <- 0 - for (pft.i in seq(pft.samples)) { - ensemble.samples[[pft.i]] <- matrix(nrow = ensemble.size, ncol = length(pft.samples[[pft.i]])) - - # meaning we want to keep MCMC samples together - if(length(pft.samples[[pft.i]])>0 & !is.null(param.names)){ - # TODO: for now we are sampling row numbers uniformly - # stop if other methods were requested - if(method != "uniform"){ - PEcAn.logger::logger.severe("Only uniform sampling is available for joint sampling at the moment. Other approaches are not implemented yet.") - } - same.i <- sample.int(length(pft.samples[[pft.i]][[1]]), ensemble.size) - } - - for (trait.i in seq(pft.samples[[pft.i]])) { - col.i <- col.i + 1 - if(names(pft.samples[[pft.i]])[trait.i] %in% param.names[[pft.i]]){ # keeping samples - ensemble.samples[[pft.i]][, trait.i] <- pft.samples[[pft.i]][[trait.i]][same.i] - }else{ - ensemble.samples[[pft.i]][, trait.i] <- stats::quantile(pft.samples[[pft.i]][[trait.i]], - random.samples[, col.i]) - } - } # end trait - ensemble.samples[[pft.i]] <- as.data.frame(ensemble.samples[[pft.i]]) - colnames(ensemble.samples[[pft.i]]) <- names(pft.samples[[pft.i]]) - } #end pft - names(ensemble.samples) <- names(pft.samples) - ans <- ensemble.samples - } - return(ans) -} # get.ensemble.samples - - -##' Write ensemble config files -##' -##' DEPRECATED: This function has been moved to the \code{PEcAn.uncertainty} package. -##' The version in \code{PEcAn.utils} is deprecated, will not be updated to add any new features, -##' and will be removed in a future release of PEcAn. -##' Please use \code{PEcAn.uncertainty::write.ensemble.configs} instead. -##' -##' Writes config files for use in meta-analysis and returns a list of run ids. -##' Given a pft.xml object, a list of lists as supplied by get.sa.samples, -##' a name to distinguish the output files, and the directory to place the files. -##' @title Write ensemble configs -##' @param defaults pft -##' @param ensemble.samples list of lists supplied by \link{get.ensemble.samples} -##' @param settings list of PEcAn settings -##' @param write.config a model-specific function to write config files, e.g. \link{write.config.ED} -##' @param clean remove old output first? -##' @return list, containing $runs = data frame of runids, and $ensemble.id = the ensemble ID for these runs. Also writes sensitivity analysis configuration files as a side effect -##' @export -##' @author David LeBauer, Carl Davidson -write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, - clean = FALSE, write.to.db = TRUE) { - - .Deprecated( - new = "PEcAn.uncertainty::write.ensemble.configs", - msg = paste( - "write.ensemble.configs has been moved to PEcAn.uncertainty and is deprecated from PEcAn.utils.", - "Please use PEcAn.uncertainty::write.ensemble.configs instead.", - "PEcAn.utils::write.ensemble.configs will not be updated and will be removed from a future version of PEcAn.", - sep = "\n")) - - my.write.config <- paste("write.config.", model, sep = "") - - if (is.null(ensemble.samples)) { - return(list(runs = NULL, ensemble.id = NULL)) - } - - # Open connection to database so we can store all run/ensemble information - if (write.to.db) { - con <- try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) - if (inherits(con, "try-error")) { - con <- NULL - } else { - on.exit(PEcAn.DB::db.close(con)) - } - } else { - con <- NULL - } - - # Get the workflow id - if ("workflow" %in% names(settings)) { - workflow.id <- settings$workflow$id - } else { - workflow.id <- -1 - } - - # create an ensemble id - if (!is.null(con)) { - # write ensemble first - ensemble.id <- PEcAn.DB::db.query(paste0( - "INSERT INTO ensembles (runtype, workflow_id) ", - "VALUES ('ensemble', ", format(workflow.id, scientific = FALSE), ")", - "RETURNING id"), con = con)[['id']] - - for (pft in defaults) { - PEcAn.DB::db.query(paste0( - "INSERT INTO posteriors_ensembles (posterior_id, ensemble_id) ", - "values (", pft$posteriorid, ", ", ensemble.id, ")"), con = con) - } - } else { - ensemble.id <- NA - } - - # find all inputs that have an id - inputs <- names(settings$run$inputs) - inputs <- inputs[grepl(".id$", inputs)] - - # write configuration for each run of the ensemble - runs <- data.frame() - for (counter in seq_len(settings$ensemble$size)) { - if (!is.null(con)) { - paramlist <- paste("ensemble=", counter, sep = "") - run.id <- PEcAn.DB::db.query(paste0( - "INSERT INTO runs (model_id, site_id, start_time, finish_time, outdir, ensemble_id, parameter_list) ", - "values ('", - settings$model$id, "', '", - settings$run$site$id, "', '", - settings$run$start.date, "', '", - settings$run$end.date, "', '", - settings$run$outdir, "', ", - ensemble.id, ", '", - paramlist, "') ", - "RETURNING id"), con = con)[['id']] - - # associate inputs with runs - if (!is.null(inputs)) { - for (x in inputs) { - PEcAn.DB::db.query(paste0("INSERT INTO inputs_runs (input_id, run_id) ", - "values (", settings$run$inputs[[x]], ", ", run.id, ")"), - con = con) - } - } - - } else { - run.id <- get.run.id("ENS", left.pad.zeros(counter, 5)) - } - runs[counter, "id"] <- run.id - - # create folders (cleaning up old ones if needed) - if (clean) { - unlink(file.path(settings$rundir, run.id)) - unlink(file.path(settings$modeloutdir, run.id)) - } - dir.create(file.path(settings$rundir, run.id), recursive = TRUE) - dir.create(file.path(settings$modeloutdir, run.id), recursive = TRUE) - - # write run information to disk - cat("runtype : ensemble\n", - "workflow id : ", workflow.id, "\n", - "ensemble id : ", ensemble.id, "\n", - "run : ", counter, "/", settings$ensemble$size, "\n", - "run id : ", run.id, "\n", - "pft names : ", as.character(lapply(settings$pfts, function(x) x[['name']])), "\n", - "model : ", model, "\n", - "model id : ", settings$model$id, "\n", - "site : ", settings$run$site$name, "\n", - "site id : ", settings$run$site$id, "\n", - "met data : ", settings$run$site$met, "\n", - "start date : ", settings$run$start.date, "\n", - "end date : ", settings$run$end.date, "\n", - "hostname : ", settings$host$name, "\n", - "rundir : ", file.path(settings$host$rundir, run.id), "\n", - "outdir : ", file.path(settings$host$outdir, run.id), "\n", - file = file.path(settings$rundir, run.id, "README.txt")) - - do.call(my.write.config, args = list( - defaults = defaults, - trait.values = lapply( - ensemble.samples, function(x, n) { x[n, , drop=FALSE] }, n=counter - ), - settings = settings, - run.id = run.id) - ) - cat(run.id, file = file.path(settings$rundir, "runs.txt"), sep = "\n", append = TRUE) - } - - return(invisible(list(runs = runs, ensemble.id = ensemble.id))) -} # write.ensemble.configs diff --git a/base/utils/R/full.path.R b/base/utils/R/full.path.R index c95481acb1a..7a0b681cdb0 100644 --- a/base/utils/R/full.path.R +++ b/base/utils/R/full.path.R @@ -1,7 +1,7 @@ #------------------------------------------------------------------------------- # Copyright (c) 2012 University of Illinois, NCSA. # All rights reserved. This program and the accompanying materials -# are made available under the terms of the +# are made available under the terms of the # University of Illinois/NCSA Open Source License # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html @@ -15,6 +15,7 @@ ##' ##' @title Creates an absolute path to a folder ##' @name full.path +##' @param folder folder for file paths. ##' @author Rob Kooper ##' @return absolute path ##' @export @@ -23,12 +24,12 @@ full.path <- function(folder) { # normalize pathname folder <- normalizePath(folder, mustWork = FALSE) - + # add cwd if needed if (substr(folder, 1, 1) != "/") { folder <- file.path(getwd(), folder) folder <- normalizePath(folder, mustWork = FALSE) } - + return(invisible(folder)) } # full.path diff --git a/base/utils/R/get.model.output.R b/base/utils/R/get.model.output.R deleted file mode 100644 index af2ce092198..00000000000 --- a/base/utils/R/get.model.output.R +++ /dev/null @@ -1,28 +0,0 @@ -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - -##' -##' This function retrieves model output for further analyses -##' @name get.model.output -##' @title Retrieve model output -##' -##' @param model the ecosystem model run -##' -##' @export -##' -##' @examples -##' \dontrun{ -##' get.model.output(model) -##' get.model.output('ED2') -##' } -##' -##' @author Michael Dietze, Shawn Serbin, David LeBauer -get.model.output <- function(model, settings) { - PEcAn.logger::logger.severe("Same as get.results(settings), please update your workflow") -} # get.model.output diff --git a/base/utils/R/logger.R b/base/utils/R/logger.R deleted file mode 100644 index b4da35028b7..00000000000 --- a/base/utils/R/logger.R +++ /dev/null @@ -1,76 +0,0 @@ -logger_deprecated <- function() { - warning('Logger functions have moved from PEcAn.utils to PEcAn.logger.', - 'This usage is deprecated') -} - -#' Logger functions (imported temporarily from PEcAn.logger) -#' -#' @importFrom PEcAn.logger logger.debug -#' @export -logger.debug <- function(...) { - logger_deprecated() - PEcAn.logger::logger.debug(...) -} - -#' @importFrom PEcAn.logger logger.info -#' @export -logger.info <- function(...) { - logger_deprecated() - PEcAn.logger::logger.info(...) -} - -#' @importFrom PEcAn.logger logger.warn -#' @export -logger.warn <- function(...) { - logger_deprecated() - PEcAn.logger::logger.warn(...) -} - -#' @importFrom PEcAn.logger logger.error -#' @export -logger.error <- function(...) { - logger_deprecated() - PEcAn.logger::logger.error(...) -} - -#' @importFrom PEcAn.logger logger.severe -#' @export -logger.severe <- function(...) { - logger_deprecated() - PEcAn.logger::logger.severe(...) -} - -#' @importFrom PEcAn.logger logger.setLevel -#' @export -logger.setLevel <- function(...) { - logger_deprecated() - PEcAn.logger::logger.setLevel(...) -} - -#' @importFrom PEcAn.logger logger.getLevel -#' @export -logger.getLevel <- function(...) { - logger_deprecated() - PEcAn.logger::logger.getLevel(...) -} - -#' @importFrom PEcAn.logger logger.setOutputFile -#' @export -logger.setOutputFile <- function(...) { - logger_deprecated() - PEcAn.logger::logger.setOutputFile(...) -} - -#' @importFrom PEcAn.logger logger.setQuitOnSevere -#' @export -logger.setQuitOnSevere <- function(...) { - logger_deprecated() - PEcAn.logger::logger.setQuitOnSevere(...) -} - -#' @importFrom PEcAn.logger logger.setWidth -#' @export -logger.setWidth <- function(...) { - logger_deprecated() - PEcAn.logger::logger.setWidth(...) -} diff --git a/base/utils/R/mcmc.list2init.R b/base/utils/R/mcmc.list2init.R index ef3f8b4f954..73ee039d0c8 100644 --- a/base/utils/R/mcmc.list2init.R +++ b/base/utils/R/mcmc.list2init.R @@ -38,7 +38,6 @@ mcmc.list2init <- function(dat) { ## detect variable type (scalar, vector, matrix) cols <- which(firstname == uname[v]) - if(length(cols) == 1){ ## SCALAR for(c in seq_len(nc)){ @@ -66,7 +65,7 @@ mcmc.list2init <- function(dat) { } } else { - PEcAn.utils::logger.severe("dimension not supported",dim,uname[v]) + PEcAn.logger::logger.severe("dimension not supported",dim,uname[v]) } } ## end else VECTOR or MATRIX diff --git a/base/utils/R/r2bugs.distributions.R b/base/utils/R/r2bugs.distributions.R index 455f3b60150..0e832c3183d 100644 --- a/base/utils/R/r2bugs.distributions.R +++ b/base/utils/R/r2bugs.distributions.R @@ -1,17 +1,18 @@ #------------------------------------------------------------------------------- # Copyright (c) 2012 University of Illinois, NCSA. # All rights reserved. This program and the accompanying materials -# are made available under the terms of the +# are made available under the terms of the # University of Illinois/NCSA Open Source License # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html #------------------------------------------------------------------------------- ##' convert R parameterizations to BUGS paramaterizations -##' +##' ##' R and BUGS have different parameterizations for some distributions. This function transforms the distributions from R defaults to BUGS defaults. BUGS is an implementation of the BUGS language, and these transformations are expected to work for bugs. ##' @title convert R parameterizations to BUGS paramaterizations -##' @param priors data.frame with columns distn = distribution name, parama, paramb using R default parameterizations +##' @param priors data.frame with columns distn = distribution name, parama, paramb using R default parameterizations. +##' @param direction One of "r2bugs" or "bugs2r" ##' @return priors dataframe using JAGS default parameterizations ##' @author David LeBauer, Ben Bolker ##' @export @@ -21,11 +22,11 @@ ##' paramb = c(2, 2, 2, 2)) ##' r2bugs.distributions(priors) r2bugs.distributions <- function(priors, direction = "r2bugs") { - + priors$distn <- as.character(priors$distn) priors$parama <- as.numeric(priors$parama) priors$paramb <- as.numeric(priors$paramb) - + ## index dataframe according to distribution norm <- priors$distn %in% c("norm", "lnorm") # these have same tramsform weib <- grepl("weib", priors$distn) # matches r and bugs version @@ -33,13 +34,13 @@ r2bugs.distributions <- function(priors, direction = "r2bugs") { chsq <- grepl("chisq", priors$distn) # matches r and bugs version bin <- priors$distn %in% c("binom", "bin") # matches r and bugs version nbin <- priors$distn %in% c("nbinom", "negbin") # matches r and bugs version - + ## Check that no rows are categorized into two distributions if (max(rowSums(cbind(norm, weib, gamma, chsq, bin, nbin))) > 1) { badrow <- rowSums(cbind(norm, weib, gamma, chsq, bin, nbin)) > 1 stop(paste(unique(priors$distn[badrow])), "are identified as > 1 distribution") } - + exponent <- ifelse(direction == "r2bugs", -2, -0.5) ## Convert sd to precision for norm & lnorm priors$paramb[norm] <- priors$paramb[norm]^exponent @@ -49,11 +50,11 @@ r2bugs.distributions <- function(priors, direction = "r2bugs") { } else if (direction == "bugs2r") { ## Convert BUGS parameter lambda to BUGS parameter b by b = l^(-1/a) priors$paramb[weib] <- priors$paramb[weib] ^ (-1 / priors$parama[weib]) - + } ## Reverse parameter order for binomial and negative binomial priors[bin | nbin, c("parama", "paramb")] <- priors[bin | nbin, c("paramb", "parama")] - + ## Translate distribution names if (direction == "r2bugs") { priors$distn[weib] <- "weib" @@ -81,13 +82,14 @@ bugs2r.distributions <- function(..., direction = "bugs2r") { ##' BUGS parameterization, and then samples from the distribution using ##' JAGS ##' @title bugs.rdist -##' @param prior dataframe with distribution name and parameters -##' @param n.iter number of samples, output will have n.iter/4 samples -##' @param n +##' @param prior dataframe with distribution name and parameters +##' @param n.iter number of MCMC samples. Output will have n.iter/4 samples +##' @param n number of randomly chosen samples to return. +## If NULL, returns all n.iter/4 of them ##' @return vector of samples ##' @export ##' @author David LeBauer -bugs.rdist <- function(prior = data.frame(distn = "norm", parama = 0, paramb = 1), +bugs.rdist <- function(prior = data.frame(distn = "norm", parama = 0, paramb = 1), n.iter = 1e+05, n = NULL) { need_packages("rjags") if (!grepl("chisq", prior$distn)) { @@ -97,12 +99,12 @@ bugs.rdist <- function(prior = data.frame(distn = "norm", parama = 0, paramb = 1 } else { PEcAn.logger::logger.severe(paste("Unknown model.string", model.string)) } - + writeLines(model.string, con = "test.bug") j.model <- rjags::jags.model(file = "test.bug", data = list(x = 1)) mcmc.object <- stats::window(rjags::coda.samples(model = j.model, - variable.names = c("Y"), - n.iter = n.iter, thin = 2), + variable.names = c("Y"), + n.iter = n.iter, thin = 2), start = n.iter / 2) Y <- as.matrix(mcmc.object)[, "Y"] if (!is.null(n)) { diff --git a/base/utils/R/read.output.R b/base/utils/R/read.output.R index 5720e47ca57..1fa2aa4a689 100644 --- a/base/utils/R/read.output.R +++ b/base/utils/R/read.output.R @@ -1,7 +1,7 @@ #------------------------------------------------------------------------------- # Copyright (c) 2012 University of Illinois, NCSA. # All rights reserved. This program and the accompanying materials -# are made available under the terms of the +# are made available under the terms of the # University of Illinois/NCSA Open Source License # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html @@ -11,7 +11,7 @@ ##' ##' Reads the output of a single model run ##' -##' Generic function to convert model output from model-specific format to +##' Generic function to convert model output from model-specific format to ##' a common PEcAn format. This function uses MsTMIP variables except that units of ##' (kg m-2 d-1) are converted to kg ha-1 y-1. Currently this function converts ##' Carbon fluxes: GPP, NPP, NEE, TotalResp, AutoResp, HeteroResp, @@ -31,7 +31,7 @@ ##' variables in output file.. ##' @param dataframe Logical: if TRUE, will return output in a ##' `data.frame` format with a posix column. Useful for -##' [PEcAn.benchmark::align.data()] and plotting. +##' `PEcAn.benchmark::align.data` and plotting. ##' @param pft.name character string, name of the plant functional ##' type (PFT) to read PFT-specific output. If `NULL` no ##' PFT-specific output will be read even the variable has PFT as a @@ -236,7 +236,7 @@ read.output <- function(runid, outdir, # check if the variable has 'pft' as a dimension if ("pft" %in% sapply(nc$var[[v]]$dim, `[[`, "name")) { # means there are PFT specific outputs we want - # the variable *PFT* in standard netcdfs has *pft* dimension, + # the variable *PFT* in standard netcdfs has *pft* dimension, # numbers as values, and full pft names as an attribute # parse pft names and match the requested pft.string <- ncdf4::ncatt_get(nc, "PFT", verbose = verbose) @@ -260,7 +260,7 @@ read.output <- function(runid, outdir, } } } # end of per-pft read - + # Dropping attempt to provide more sensible units because of graph unit errors, # issue #792 # if (v %in% c(cflux, wflux)) { @@ -273,7 +273,7 @@ read.output <- function(runid, outdir, if (print_summary) { result_means <- vapply(result, mean, numeric(1), na.rm = TRUE) - result_medians <- vapply(result, median, numeric(1), na.rm = TRUE) + result_medians <- vapply(result, stats::median, numeric(1), na.rm = TRUE) summary_matrix <- signif(cbind(Mean = result_means, Median = result_medians), 3) rownames(summary_matrix) <- names(result) PEcAn.logger::logger.info( diff --git a/base/utils/R/read_web_config.R b/base/utils/R/read_web_config.R index 669822c1db3..4b5c5a8f4a3 100644 --- a/base/utils/R/read_web_config.R +++ b/base/utils/R/read_web_config.R @@ -5,13 +5,13 @@ #' @param parse Logical. If `TRUE` (default), try to parse numbers and #' unquote strings. #' @param expand Logical. If `TRUE` (default), try to perform some -#' variable substitutions (only done if parse = TRUE). +#' variable substitutions. #' @return Named list of variable-value pairs set in `config.php` #' @export #' @examples -#' # Read Docker configuration and extract the `dbfiles` and output folders #' \dontrun{ -#' docker_config <- read_web_config("/home/carya/web/config.php") +#' # Read Docker configuration and extract the `dbfiles` and output folders. +#' docker_config <- read_web_config(file.path("..", "..", "docker", "web", "config.docker.php")) #' docker_config[["dbfiles_folder"]] #' docker_config[["output_folder"]] #' } @@ -30,30 +30,25 @@ read_web_config <- function(php.config = "../../web/config.php", config_list <- lapply(results, `[[`, 3) names(config_list) <- list_names - # always remove the \" - config_list <- lapply(config_list, gsub, - pattern = "\"(.*?)\"", replacement = "\\1") - - # parse data and cleanup + # Convert to numeric if possible if (parse) { - # try to conver to number/boolean (as.numeric(FALSE) == 0) - config_list <- lapply(config_list, function(s) { - s <- tryCatch(as.numeric(s), warning = function(e) { - b = as.logical(s) - ifelse(is.na(b), s, b) - }) - }) + # Remove surrounding quotes + config_list <- lapply(config_list, gsub, + pattern = "\"(.*?)\"", replacement = "\\1") - if (expand) { - of <- config_list[["output_folder"]] - if (!is.null(of)) { - modify <- grep("\\$output_folder *\\. *", config_list) - # gsub will force all fields to character - config_list[modify] <- lapply(config_list[modify], gsub, - pattern = "\\$output_folder *\\. *", replacement = of) - } - } + # Try to convert numbers to numeric + config_list <- lapply( + config_list, + function(x) tryCatch(as.numeric(x), warning = function(e) x) + ) } + if (expand) { + # Replace $output_folder with its value, and concatenate strings + chr <- vapply(config_list, is.character, logical(1)) + config_list[chr] <- lapply(config_list[chr], gsub, + pattern = "\\$output_folder *\\. *", + replacement = config_list[["output_folder"]]) + } config_list } diff --git a/base/utils/R/regrid.R b/base/utils/R/regrid.R index 1f618c67865..6e8768104e2 100644 --- a/base/utils/R/regrid.R +++ b/base/utils/R/regrid.R @@ -1,5 +1,5 @@ ##' Regrid dataset to even grid -##' +##' ##' @title regrid ##' @param latlon.data dataframe with lat, lon, and some value to be regridded ##' @return dataframe with regridded data @@ -13,15 +13,15 @@ regrid <- function(latlon.data) { e <- raster::extent(spdf) ## Determine ratio between x and y dimensions ratio <- (e@xmax - e@xmin) / (e@ymax - e@ymin) - + ## Create template raster to sample to r <- raster::raster(nrows = 56, ncols = floor(56 * ratio), ext = raster::extent(spdf)) rf <- raster::rasterize(spdf, r, field = "z", fun = mean) - + # rdf <- data.frame( rasterToPoints( rf ) ) colnames(rdf) <- # colnames(latlon.data) arf <- as.array(rf) - + # return(rdf) return(arf) } # regrid @@ -30,7 +30,9 @@ regrid <- function(latlon.data) { ##' Write gridded data to netcdf file ##' ##' @title grid2netcdf -##' @param grid.data +##' @param gdata gridded data to write out +##' @param date currently ignored; date(s) from `gdata` are used instead +##' @param outfile name for generated netCDF file. ##' @return writes netCDF file ##' @author David LeBauer grid2netcdf <- function(gdata, date = "9999-09-09", outfile = "out.nc") { @@ -52,19 +54,19 @@ grid2netcdf <- function(gdata, date = "9999-09-09", outfile = "out.nc") { grid.data <- merge(latlons, gdata, by = c("lat", "lon", "date"), all.x = TRUE) lat <- ncdf4::ncdim_def("lat", "degrees_east", vals = lats, longname = "station_latitude") lon <- ncdf4::ncdim_def("lon", "degrees_north", vals = lons, longname = "station_longitude") - time <- ncdf4::ncdim_def(name = "time", units = paste0("days since 1700-01-01"), + time <- ncdf4::ncdim_def(name = "time", units = paste0("days since 1700-01-01"), vals = as.numeric(lubridate::ymd(paste0(years, "01-01")) - lubridate::ymd("1700-01-01")), calendar = "standard", unlim = TRUE) - + yieldvar <- to_ncvar("CropYield", list(lat, lon, time)) nc <- ncdf4::nc_create(filename = outfile, vars = list(CropYield = yieldvar)) - + ## Output netCDF data # ncvar_put(nc, varid = yieldvar, vals = grid.data[order(lat, lon, order(lubridate::ymd(date )))]$yield) # ncvar_put(nc, varid = yieldvar, vals = grid.data[order(order(lubridate::ymd(date), lat, lon))]$yield) ncdf4::ncvar_put(nc, varid = yieldvar, vals = yieldarray) - + ncdf4::ncatt_put(nc, 0, "description", "put description here") ncdf4::nc_close(nc) } # grid2netcdf diff --git a/base/utils/R/run.write.configs.R b/base/utils/R/run.write.configs.R deleted file mode 100644 index 8a84f7eb976..00000000000 --- a/base/utils/R/run.write.configs.R +++ /dev/null @@ -1,172 +0,0 @@ -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - -##' Main driver function to call the ecosystem model specific (e.g. ED, SiPNET) -##' run and configuration file scripts -##' -##' DEPRECATED: This function has been moved to the PEcAn.workflow package and will be removed from PEcAn.utils. -##' -##' @name run.write.configs -##' @title Run model specific write configuration functions -##' @param model the ecosystem model to generate the configuration files for -##' @param write should the runs be written to the database -##' @param ens.sample.method how to sample the ensemble members('halton' sequence or 'uniform' random) -##' @param posterior.files Filenames for posteriors for drawing samples for ensemble and sensitivity -##' analysis (e.g. post.distns.Rdata, or prior.distns.Rdata). Defaults to NA, in which case the -##' most recent posterior or prior (in that order) for the workflow is used. Should be a vector, -##' with one entry for each PFT. File name only; PFT outdirs will be appended (this forces use of only -##' files within this workflow, to avoid confusion). -##' -##' @return an updated settings list, which includes ensemble IDs for SA and ensemble analysis -##' -##' @author David LeBauer, Shawn Serbin, Ryan Kelly, Mike Dietze -##' @export -run.write.configs <- function(settings, write = TRUE, ens.sample.method = "uniform", - posterior.files = rep(NA, length(settings$pfts)), - overwrite = TRUE) { - .Deprecated("PEcAn.workflow::run.write.configs") - - con <- PEcAn.DB::db.open(settings$database$bety) - on.exit(PEcAn.DB::db.close(con)) - - ## Which posterior to use? - for (i in seq_along(settings$pfts)) { - ## if posterior.files is specified us that - if (is.na(posterior.files[i])) { - ## otherwise, check to see if posteriorid exists - if (!is.null(settings$pfts[[i]]$posteriorid)) { - files <- PEcAn.DB::dbfile.check("Posterior", - settings$pfts[[i]]$posteriorid, - con, settings$host$name, return.all = TRUE) - pid <- grep("post.distns.*Rdata", files$file_name) ## is there a posterior file? - if (length(pid) == 0) { - pid <- grep("prior.distns.Rdata", files$file_name) ## is there a prior file? - } - if (length(pid) > 0) { - posterior.files[i] <- file.path(files$file_path[pid], files$file_name[pid]) - } ## otherwise leave posteriors as NA - } - ## otherwise leave NA and get.parameter.samples will look for local - } - } - - ## Sample parameters - model <- settings$model$type - scipen <- getOption("scipen") - options(scipen = 12) - #sample from parameters used for both sensitivity analysis and Ens - get.parameter.samples(settings, posterior.files, ens.sample.method) - load(file.path(settings$outdir, "samples.Rdata")) - - ## remove previous runs.txt - if (overwrite && file.exists(file.path(settings$rundir, "runs.txt"))) { - PEcAn.logger::logger.warn("Existing runs.txt file will be removed.") - unlink(file.path(settings$rundir, "runs.txt")) - } - - load.modelpkg(model) - - ## Check for model-specific write configs - - my.write.config <- paste0("write.config.",model) - if (!exists(my.write.config)) { - PEcAn.logger::logger.error(my.write.config, - "does not exist, please make sure that the model package contains a function called", - my.write.config) - } - - ## Prepare for model output. Clean up any old config files (if exists) - my.remove.config <- paste0("remove.config.", model) - if (exists(my.remove.config)) { - do.call(my.remove.config, args = list(settings$rundir, settings)) - } - - # TODO RK : need to write to runs_inputs table - - # Save names - pft.names <- names(trait.samples) - trait.names <- lapply(trait.samples, names) - - ### NEED TO IMPLEMENT: Load Environmental Priors and Posteriors - - ### Sensitivity Analysis - if ("sensitivity.analysis" %in% names(settings)) { - - ### Write out SA config files - PEcAn.logger::logger.info("\n ----- Writing model run config files ----") - sa.runs <- write.sa.configs(defaults = settings$pfts, - quantile.samples = sa.samples, - settings = settings, - model = model, - write.to.db = write) - - # Store output in settings and output variables - runs.samples$sa <- sa.run.ids <- sa.runs$runs - settings$sensitivity.analysis$ensemble.id <- sa.ensemble.id <- sa.runs$ensemble.id - - # Save sensitivity analysis info - fname <- sensitivity.filename(settings, "sensitivity.samples", "Rdata", - all.var.yr = TRUE, pft = NULL) - save(sa.run.ids, sa.ensemble.id, sa.samples, pft.names, trait.names, file = fname) - - } ### End of SA - - ### Write ENSEMBLE - if ("ensemble" %in% names(settings)) { - ens.runs <- write.ensemble.configs(defaults = settings$pfts, - ensemble.samples = ensemble.samples, - settings = settings, - model = model, - write.to.db = write) - - # Store output in settings and output variables - runs.samples$ensemble <- ens.run.ids <- ens.runs$runs - settings$ensemble$ensemble.id <- ens.ensemble.id <- ens.runs$ensemble.id - ens.samples <- ensemble.samples # rename just for consistency - - # Save ensemble analysis info - fname <- ensemble.filename(settings, "ensemble.samples", "Rdata", all.var.yr = TRUE) - save(ens.run.ids, ens.ensemble.id, ens.samples, pft.names, trait.names, file = fname) - } else { - PEcAn.logger::logger.info("not writing config files for ensemble, settings are NULL") - } ### End of Ensemble - - PEcAn.logger::logger.info("###### Finished writing model run config files #####") - PEcAn.logger::logger.info("config files samples in ", file.path(settings$outdir, "run")) - - ### Save output from SA/Ensemble runs - # A lot of this is duplicate with the ensemble/sa specific output above, but kept for backwards compatibility. - save(ensemble.samples, trait.samples, sa.samples, runs.samples, pft.names, trait.names, - file = file.path(settings$outdir, "samples.Rdata")) - PEcAn.logger::logger.info("parameter values for runs in ", file.path(settings$outdir, "samples.RData")) - options(scipen = scipen) - - return(invisible(settings)) -} # run.write.configs - - -#' @export -runModule.run.write.configs <- function(settings, overwrite = TRUE) { - .Deprecated("PEcAn.workflow::runModule.run.write.configs") - if (PEcAn.settings::is.MultiSettings(settings)) { - if (overwrite && file.exists(file.path(settings$rundir, "runs.txt"))) { - PEcAn.logger::logger.warn("Existing runs.txt file will be removed.") - unlink(file.path(settings$rundir, "runs.txt")) - } - return(PEcAn.settings::papply(settings, runModule.run.write.configs, overwrite = FALSE)) - } else if (PEcAn.settings::is.Settings(settings)) { - write <- settings$database$bety$write - # double check making sure we have method for parameter sampling - if (is.null(settings$ensemble$samplingspace$parameters$method)) settings$ensemble$samplingspace$parameters$method <- "uniform" - ens.sample.method <- settings$ensemble$samplingspace$parameters$method - return(run.write.configs(settings, write, ens.sample.method, overwrite = overwrite)) - } else { - stop("runModule.run.write.configs only works with Settings or MultiSettings") - } -} # runModule.run.write.configs diff --git a/base/utils/R/seconds_in_year.R b/base/utils/R/seconds_in_year.R index f8124d2b419..d45ab750bd8 100644 --- a/base/utils/R/seconds_in_year.R +++ b/base/utils/R/seconds_in_year.R @@ -2,12 +2,12 @@ #' #' @author Alexey Shiklomanov #' @param year Numeric year (can be a vector) -#' @param leap_year Default = TRUE. If set to FALSE will always return 31536000 +#' @param leap_year Default = TRUE. If set to FALSE will always return 31536000. +#' @param ... additional arguments, all currently ignored #' @examples #' seconds_in_year(2000) # Leap year -- 366 x 24 x 60 x 60 = 31622400 #' seconds_in_year(2001) # Regular year -- 365 x 24 x 60 x 60 = 31536000 #' seconds_in_year(2000:2005) # Vectorized over year -#' @inheritParams days_in_year #' @export seconds_in_year <- function(year, leap_year = TRUE, ...) { diy <- days_in_year(year, leap_year) diff --git a/base/utils/R/status.R b/base/utils/R/status.R index b28b7685dce..868be2d091f 100644 --- a/base/utils/R/status.R +++ b/base/utils/R/status.R @@ -1,73 +1,131 @@ -#--------------------------------------------------------------------------------# +#------------------------------------------------------------------------------ # Functions used to write STATUS used by history -#--------------------------------------------------------------------------------# -##' @export -##' @name status.start -##' @title status.start -##' @description PEcAn workflow status tracking: start module -##' @author Rob Kooper -status.start <- function(name) { - if (exists("settings")) { - cat(paste(name, format(Sys.time(), "%F %T"), sep = "\t"), file = file.path(settings$outdir, - "STATUS"), append = TRUE) - } +#------------------------------------------------------------------------------ + +#' PEcAn workflow status tracking +#' +#' Records the progress of a PEcAn workflow by writing statuses and timestamps +#' to a STATUS file. Use these each time a module starts, finishes, +#' or is skipped. + +#' @details +#' All of these functions write to or read from a STATUS file in your run's +#' output directory. If the file is not specified in the call, they will look +#' for a `settings` object in the global environment and use +#' `/STATUS` if possible. +#' +#' Since the status functions may be called inside error-handling routines, +#' it's important that they not produce new errors of their own. Therefore +#' if the output file doesn't exist or is not writable, rather than complain +#' the writer functions (`status.start`, `status.end`, `status.skip`) will +#' print to the console and `status.check` will simply return 0. +#' +#' @name status +#' @author Rob Kooper +#' @param name one-word description of the module being checked or recorded, +#' e.g. "TRAIT", "MODEL", "ENSEMBLE" +#' @param status one-word summary of the module result, e.g. "DONE", "ERROR" +#' @param file path to status file. +#' If NULL, taken from `settings` (see details) +#' @return For `status.start`, `status.end`, and `status.skip`: NULL, invisibly +#' +NULL + +#' @describeIn status Record module start time +#' @export +status.start <- function(name, file = NULL) { + file <- get_status_path(file) + cat( + paste(name, format(Sys.time(), "%F %T"), sep = "\t"), + file = file, + append = TRUE) } -##' @name status.end -##' @title status.end -##' @description PEcAn workflow status tracking: end module -##' @author Rob Kooper -##' @export -status.end <- function(status = "DONE") { - if (exists("settings")) { - cat(paste("", format(Sys.time(), "%F %T"), status, "\n", sep = "\t"), file = file.path(settings$outdir, - "STATUS"), append = TRUE) - } +#' @describeIn status Record module completion time and status +#' @export +status.end <- function(status = "DONE", file = NULL) { + file <- get_status_path(file) + cat( + paste("", format(Sys.time(), "%F %T"), status, "\n", sep = "\t"), + file = file, + append = TRUE) } -##' @name status.skip -##' @title status.skip -##' @description PEcAn workflow status tracking: skip module -##' @author Rob Kooper -##' @export -status.skip <- function(name) { - if (exists("settings")) { - cat(paste(name, - format(Sys.time(), "%F %T"), "", - format(Sys.time(), "%F %T"), - "SKIPPED", "\n", sep = "\t"), - file = file.path(settings$outdir, "STATUS"), - append = TRUE) - } -} # status.skip +#' @describeIn status Record that module was skipped +#' @export +status.skip <- function(name, file = NULL) { + file <- get_status_path(file) + cat( + paste( + name, + format(Sys.time(), "%F %T"), "", + format(Sys.time(), "%F %T"), + "SKIPPED", "\n", sep = "\t"), + file = file, + append = TRUE) +} -##' @name status.check -##' @title status.check -##' @description PEcAn workflow status tracking: check module status -##' @author Rob Kooper -##' @export -status.check <- function(name) { - if (!exists("settings")) - return(0) - status.file <- file.path(settings$outdir, "STATUS") - if (!file.exists(status.file)) { - return(0) +#' @describeIn status Look up module status from file +#' @return For `status.check`, an integer: +#' 0 if module not run, 1 if done, -1 if error +#' @export +status.check <- function(name, file = NULL) { + file <- get_status_path(file) + if (!file.exists(file)) { + return(0L) } - status.data <- utils::read.table(status.file, row.names = 1, header = FALSE, sep = "\t", - quote = "", fill = TRUE) - if (!name %in% row.names(status.data)) { - return(0) + status_data <- utils::read.table( + file, row.names = 1, header = FALSE, + sep = "\t", quote = "", fill = TRUE) + if (!name %in% row.names(status_data)) { + return(0L) } - status.data[name, ] - if (is.na(status.data[name, 3])) { + status_data[name, ] + if (is.na(status_data[name, 3])) { PEcAn.logger::logger.warn("UNKNOWN STATUS FOR", name) - return(0) + return(0L) + } + if (status_data[name, 3] == "DONE") { + return(1L) + } + if (status_data[name, 3] == "ERROR") { + return(-1L) } - if (status.data[name, 3] == "DONE") { - return(1) + return(0L) +} + +# Verify user-provided output path, or if null try to read it from a +# `settings` object visible in the scope where status.* was called +# Example: +# ``` +# settings <- list(outdir = "foo") +# status.start("outer") +# f <- function() { settings$outdir <- "bar"; status.start("inner") } +# f() +# ``` +# writes "outer" to a file named `foo/STATUS` and "inner" to `bar/STATUS`. +get_status_path <- function(file) { + if (!is.null(file)) { + if (dir.exists(file)) { + dir <- file + base <- "STATUS" + } else { + dir <- dirname(file) + base <- basename(file) + } + } else { + dir <- get0( + x = "settings", + envir = parent.frame(2), + inherits = TRUE, + ifnotfound = list())$outdir + base <- "STATUS" } - if (status.data[name, 3] == "ERROR") { - return(-1) + + if (!is.null(dir) && dir.exists(dir)) { + return(file.path(dir, base)) + } else { + # cat treats empty path as "write to stdout" + return("") } - return(0) -} # status.check +} \ No newline at end of file diff --git a/base/utils/R/to_nc.R b/base/utils/R/to_nc.R index 26beec2cd7e..6b244be05c0 100644 --- a/base/utils/R/to_nc.R +++ b/base/utils/R/to_nc.R @@ -39,21 +39,21 @@ to_ncdim <- function(dimname,vals){ ##' @return ncvar defined according to standard_vars ##' @author Anne Thomas to_ncvar <- function(varname,dims){ - var <- PEcAn.utils::standard_vars[which(PEcAn.utils::standard_vars$Variable.Name == varname),] - #check var exists - if(nrow(var)==0){ + nc_var <- PEcAn.utils::standard_vars[which(PEcAn.utils::standard_vars$Variable.Name == varname),] + #check nc_var exists + if(nrow(nc_var)==0){ PEcAn.logger::logger.severe(paste("Variable",varname,"not in standard_vars")) } - dimset <- var[,c("dim1","dim2","dim3","dim4")] + dimset <- nc_var[,c("dim1","dim2","dim3","dim4")] dim <- dims[which(names(dims) %in% dimset)] #subset list of all dims for this variable #check that dim isn't 0 if(length(dim)==0 || is.null(dim)){ PEcAn.logger::logger.severe(paste("No dimensions were loaded for",varname)) } - units = as.character(var$Units) #if the units are a factor the function fails - longname <- as.character(var$Long.name) + units = as.character(nc_var$Units) #if the units are a factor the function fails + longname <- as.character(nc_var$Long.name) ncvar <- ncdf4::ncvar_def(name = varname, units = units, longname = longname, dim = dim, -999, prec = "double") diff --git a/base/utils/R/transformstats.R b/base/utils/R/transformstats.R index a2423440ee3..d128f0d785a 100644 --- a/base/utils/R/transformstats.R +++ b/base/utils/R/transformstats.R @@ -1,46 +1,54 @@ -#--------------------------------------------------------------------------------------------------# ##' Transform misc. statistics to SE ##' -##' Automates transformations of SD, MSE, LSD, 95\%CI, HSD, and MSD to conservative estimates of SE. -##' @name transformstats -##' @title Transform Stats -##' @param data data frame with mean, statistic, n, and statistic name: \code{example data <- data.frame(Y=rep(1,5), stat=rep(1,5), n=rep(4,5), statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD'))} -##' @return dataframe with statistics transformed to SE +##' Automates transformations of SD, MSE, LSD, 95%CI, HSD, and MSD +##' to conservative estimates of SE. +##' Method details and assumptions described in +##' LeBauer 2020 Transforming ANOVA and Regression statistics for Meta-analysis. +##' Authorea. DOI: https://doi.org/10.22541/au.158359749.96662550 +##' @param data data frame with columns for mean, statistic, n, +##' and statistic name +##' @return data frame with statistics transformed to SE ##' @author David LeBauer ##' @export -##' @examples statdf <- data.frame(Y=rep(1,5), -##' stat=rep(1,5), -##' n=rep(4,5), -##' statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD')) +##' @examples +##' statdf <- data.frame(Y=rep(1,5), +##' stat=rep(1,5), +##' n=rep(4,5), +##' statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD')) ##' transformstats(statdf) transformstats <- function(data) { - if (!"SE" %in% levels(data$statname)) { - data$statname <- factor(data$statname, levels = c(levels(data$statname), "SE")) + if (is.factor(data$statname) && !"SE" %in% levels(data$statname)) { + data$statname <- factor( + data$statname, + levels = c(levels(data$statname), "SE")) } ## Transformation of stats to SE transform SD to SE if (max(c("SD", "sd") %in% data$statname)) { sdi <- which(data$statname %in% c("SD", "sd")) - data$stat[sdi] <- data$stat[sdi]/sqrt(data$n[sdi]) + data$stat[sdi] <- data$stat[sdi] / sqrt(data$n[sdi]) data$statname[sdi] <- "SE" } ## transform MSE to SE if ("MSE" %in% data$statname) { msei <- which(data$statname == "MSE") - data$stat[msei] <- sqrt(data$stat[msei]/data$n[msei]) + data$stat[msei] <- sqrt(data$stat[msei] / data$n[msei]) data$statname[msei] <- "SE" } ## 95%CI measured from mean to upper or lower CI SE = CI/t if ("95%CI" %in% data$statname) { cii <- which(data$statname == "95%CI") - data$stat[cii] <- data$stat[cii]/stats::qt(0.975, data$n[cii]) + data$stat[cii] <- data$stat[cii] / stats::qt(0.975, data$n[cii]) data$statname[cii] <- "SE" } ## Fisher's Least Significant Difference (LSD) ## conservatively assume no within block replication if ("LSD" %in% data$statname) { lsdi <- which(data$statname == "LSD") - data$stat[lsdi] <- data$stat[lsdi]/(stats::qt(0.975, data$n[lsdi]) * sqrt((2 * data$n[lsdi]))) + data$stat[lsdi] <- ( + data$stat[lsdi] + / (stats::qt(0.975, data$n[lsdi]) + * sqrt((2 * data$n[lsdi])))) data$statname[lsdi] <- "SE" } ## Tukey's Honestly Significant Difference (HSD), @@ -49,7 +57,7 @@ transformstats <- function(data) { hsdi <- which(data$statname == "HSD") n <- data$n[hsdi] n[is.na(n)] <- 2 ## minimum n that can be used if NA - data$stat[hsdi] <- data$stat[hsdi]/(stats::qtukey(0.975, n, df = 2)) + data$stat[hsdi] <- data$stat[hsdi] / (stats::qtukey(0.975, n, df = 2)) data$statname[hsdi] <- "SE" data$n[hsdi] <- n } @@ -58,11 +66,14 @@ transformstats <- function(data) { ## SE = MSD*n/(t*sqrt(2)) if ("MSD" %in% data$statname) { msdi <- which(data$statname == "MSD") - data$stat[msdi] <- data$stat[msdi] * data$n[msdi] / (stats::qt(0.975, 2 * data$n[msdi] - 2) * sqrt(2)) + data$stat[msdi] <- ( + data$stat[msdi] + * data$n[msdi] + / (stats::qt(0.975, 2 * data$n[msdi] - 2) * sqrt(2))) data$statname[msdi] <- "SE" } - if (FALSE %in% c("SE", "none") %in% data$statname) { - print(paste(trait, ": ERROR!!! data contains untransformed statistics")) + if (!all(data$statname %in% c("SE", "none"))) { + PEcAn.logger::logger.error("data contains untransformed statistics") } return(data) } # transformstats diff --git a/base/utils/R/utils.R b/base/utils/R/utils.R index f5aeba7056d..bf0bc04b763 100644 --- a/base/utils/R/utils.R +++ b/base/utils/R/utils.R @@ -19,33 +19,30 @@ ##' ##' @title MstMIP variable ##' @export -##' @param name name of variable +##' @param name of variable ##' @param lat latitude if dimension requests it ##' @param lon longitude if dimension requests it ##' @param time time if dimension requests it ##' @param nsoil nsoil if dimension requests it +##' @param silent logical: suppress log messages about missing variables? ##' @return ncvar based on MstMIP definition ##' @author Rob Kooper mstmipvar <- function(name, lat = NA, lon = NA, time = NA, nsoil = NA, silent = FALSE) { - var <- PEcAn.utils::mstmip_vars[PEcAn.utils::mstmip_vars$Variable.Name == name, ] + nc_var <- PEcAn.utils::standard_vars[PEcAn.utils::standard_vars$Variable.Name == name, ] dims <- list() - - if (nrow(var) == 0) { - var <- PEcAn.utils::mstmip_local[PEcAn.utils::mstmip_local$Variable.Name == name, ] - if (nrow(var) == 0) { - if (!silent) { - PEcAn.logger::logger.info("Don't know about variable", name, " in mstmip_vars in PEcAn.utils") - } - if (is.na(time)) { - time <- ncdf4::ncdim_def(name = "time", units = "days since 1900-01-01 00:00:00", - vals = 1:365, calendar = "standard", unlim = TRUE) - } - return(ncdf4::ncvar_def(name, "", list(time), -999, name)) + + if (nrow(nc_var) == 0) { + if (!silent) { + PEcAn.logger::logger.info("Don't know about variable", name, " in standard_vars in PEcAn.utils") + } + if (is.na(time)) { + time <- ncdf4::ncdim_def(name = "time", units = "days since 1900-01-01 00:00:00", + vals = 1:365, calendar = "standard", unlim = TRUE) } + return(ncdf4::ncvar_def(name, "", list(time), -999, name)) } - for (i in 1:4) { - vd <- var[[paste0("dim", i)]] + vd <- nc_var[[paste0("dim", i)]] if (vd == "lon" && !is.na(lon)) { dims[[length(dims) + 1]] <- lon } else if (vd == "lat" && !is.na(lat)) { @@ -54,7 +51,7 @@ mstmipvar <- function(name, lat = NA, lon = NA, time = NA, nsoil = NA, silent = dims[[length(dims) + 1]] <- time } else if (vd == "nsoil" && !is.na(nsoil)) { dims[[length(dims) + 1]] <- nsoil - } else if (vd == "na") { + } else if (is.na(vd)) { # skip } else { if (!silent) { @@ -62,9 +59,9 @@ mstmipvar <- function(name, lat = NA, lon = NA, time = NA, nsoil = NA, silent = } } } - ncvar <- ncdf4::ncvar_def(name, as.character(var$Units), dims, -999) - if (var$Long.name != "na") { - ncvar$longname <- as.character(var$Long.name) + ncvar <- ncdf4::ncvar_def(name, as.character(nc_var$Units), dims, -999) + if (nc_var$Long.name != "na") { + ncvar$longname <- as.character(nc_var$Long.name) } return(ncvar) } # mstimipvar @@ -93,7 +90,7 @@ left.pad.zeros <- function(num, digits = 5) { ##' @param y numeric vector ##' @return numeric vector with all values less than 0 set to 0 ##' @export -##' @author +##' @author unknown zero.truncate <- function(y) { y[y < 0 | is.na(y)] <- 0 return(y) @@ -183,7 +180,7 @@ get.run.id <- function(run.type, index, trait = NULL, pft.name = NULL, site.id=N ##' @param bw The smoothing bandwidth to be used. See 'bw.nrd' ##' @param n number of points to use in kernel density estimate. See \code{\link[stats]{density}} ##' @return data frame with back-transformed log density estimate -##' @author \href{http://stats.stackexchange.com/q/6588/2750}{Rob Hyndman} +##' @author \href{https://stats.stackexchange.com/q/6588/2750}{Rob Hyndman} ##' @references M. P. Wand, J. S. Marron and D. Ruppert, 1991. Transformations in Density Estimation. Journal of the American Statistical Association. 86(414):343-353 \url{http://www.jstor.org/stable/2290569} zero.bounded.density <- function(x, bw = "SJ", n = 1001) { y <- log(x) @@ -203,25 +200,30 @@ zero.bounded.density <- function(x, bw = "SJ", n = 1001) { ##' @return result with replicate observations summarized ##' @export summarize.result ##' @usage summarize.result(result) +##' @importFrom rlang .data ##' @author David LeBauer, Alexey Shiklomanov summarize.result <- function(result) { ans1 <- result %>% - dplyr::filter(n == 1) %>% - dplyr::group_by(citation_id, site_id, trt_id, - control, greenhouse, date, time, - cultivar_id, specie_id) %>% - dplyr::summarize( - n = length(n), - mean = mean(mean), - statname = dplyr::if_else(length(n) == 1, "none", "SE"), - stat = stats::sd(mean) / sqrt(length(n)) + dplyr::filter(.data$n == 1) %>% + dplyr::group_by(.data$citation_id, .data$site_id, .data$trt_id, + .data$control, .data$greenhouse, .data$date, .data$time, + .data$cultivar_id, .data$specie_id, .data$name, .data$treatment_id) %>% + dplyr::summarize( # stat must be computed first, before n and mean + statname = dplyr::if_else(length(.data$n) == 1, "none", "SE"), + stat = stats::sd(.data$mean) / sqrt(length(.data$n)), + n = length(.data$n), + mean = mean(mean) ) %>% dplyr::ungroup() ans2 <- result %>% - dplyr::filter(n != 1) %>% + dplyr::filter(.data$n != 1) %>% # ANS: Silence factor to character conversion warning - dplyr::mutate(statname = as.character(statname)) - return(dplyr::bind_rows(ans1, ans2)) + dplyr::mutate(statname = as.character(.data$statname)) + if (nrow(ans2) > 0) { + dplyr::bind_rows(ans1, ans2) + } else { + return(ans1) + } } # summarize.result @@ -302,24 +304,24 @@ get.parameter.stat <- function(mcmc.summary, parameter) { pdf.stats <- function(distn, A, B) { distn <- as.character(distn) mean <- switch(distn, - gamma = A/B, - lnorm = exp(A + 1/2 * B^2), - beta = A/(A + B), - weibull = B * gamma(1 + 1/A), - norm = A, - f = ifelse(B > 2, - B/(B - 2), - mean(stats::rf(10000, A, B)))) + gamma = A/B, + lnorm = exp(A + 1/2 * B^2), + beta = A/(A + B), + weibull = B * gamma(1 + 1/A), + norm = A, + f = ifelse(B > 2, + B/(B - 2), + mean(stats::rf(10000, A, B)))) var <- switch(distn, - gamma = A/B^2, - lnorm = exp(2 * A + B ^ 2) * (exp(B ^ 2) - 1), - beta = A * B/((A + B) ^ 2 * (A + B + 1)), - weibull = B ^ 2 * (gamma(1 + 2 / A) - - gamma(1 + 1 / A) ^ 2), - norm = B ^ 2, - f = ifelse(B > 4, - 2 * B^2 * (A + B - 2) / (A * (B - 2) ^ 2 * (B - 4)), - var(stats::rf(1e+05, A, B)))) + gamma = A/B^2, + lnorm = exp(2 * A + B ^ 2) * (exp(B ^ 2) - 1), + beta = A * B/((A + B) ^ 2 * (A + B + 1)), + weibull = B ^ 2 * (gamma(1 + 2 / A) - + gamma(1 + 1 / A) ^ 2), + norm = B ^ 2, + f = ifelse(B > 4, + 2 * B^2 * (A + B - 2) / (A * (B - 2) ^ 2 * (B - 4)), + stats::var(stats::rf(1e+05, A, B)))) qci <- get(paste0("q", distn)) ci <- qci(c(0.025, 0.975), A, B) lcl <- ci[1] @@ -488,7 +490,7 @@ as.sequence <- function(x, na.rm = TRUE) { ##' @author David LeBauer temp.settings <- function(settings.txt) { temp <- tempfile() - on.exit(unlink(temp)) + on.exit(unlink(temp), add = TRUE) writeLines(settings.txt, con = temp) settings <- readLines(temp) return(settings) @@ -512,7 +514,7 @@ temp.settings <- function(settings.txt) { ##' @author David LeBauer tryl <- function(FUN) { out <- tryCatch(FUN, error = function(e) e) - ans <- !any(class(out) == "error") + ans <- !inherits(out, "error") return(ans) } # tryl #--------------------------------------------------------------------------------------------------# @@ -534,7 +536,7 @@ load.modelpkg <- function(model) { do.call(require, args = list(pecan.modelpkg)) } else { PEcAn.logger::logger.error("I can't find a package for the ", model, - "model; I expect it to be named ", pecan.modelpkg) + "model; I expect it to be named ", pecan.modelpkg) } } } # load.modelpkg @@ -551,10 +553,10 @@ load.modelpkg <- function(model) { ##' @return val converted values ##' @author Istem Fer, Shawn Serbin misc.convert <- function(x, u1, u2) { - + amC <- 12.0107 # atomic mass of carbon mmH2O <- 18.01528 # molar mass of H2O, g/mol - + if (u1 == "umol C m-2 s-1" & u2 == "kg C m-2 s-1") { val <- udunits2::ud.convert(x, "ug", "kg") * amC } else if (u1 == "kg C m-2 s-1" & u2 == "umol C m-2 s-1") { @@ -571,9 +573,9 @@ misc.convert <- function(x, u1, u2) { u1 <- gsub("gC","g*12",u1) u2 <- gsub("gC","g*12",u2) val <- udunits2::ud.convert(x,u1,u2) - - -# PEcAn.logger::logger.severe(paste("Unknown units", u1, u2)) + + + # PEcAn.logger::logger.severe(paste("Unknown units", u1, u2)) } return(val) } # misc.convert @@ -589,7 +591,7 @@ misc.convert <- function(x, u1, u2) { ##' @return logical ##' @author Istem Fer, Shawn Serbin misc.are.convertible <- function(u1, u2) { - + # make sure the order of vectors match units.from <- c("umol C m-2 s-1", "kg C m-2 s-1", "mol H2O m-2 s-1", "kg H2O m-2 s-1", @@ -597,7 +599,7 @@ misc.are.convertible <- function(u1, u2) { units.to <- c("kg C m-2 s-1", "umol C m-2 s-1", "kg H2O m-2 s-1", "mol H2O m-2 s-1", "kg C m-2", "Mg ha-1") - + if(u1 %in% units.from & u2 %in% units.to) { if (which(units.from == u1) == which(units.to == u2)) { return(TRUE) @@ -622,7 +624,7 @@ convert.expr <- function(expression) { # split equation to LHS and RHS deri.var <- gsub("=.*$", "", expression) # name of the derived variable deri.eqn <- gsub(".*=", "", expression) # derivation eqn - + non.match <- gregexpr('[^a-zA-Z_.]', deri.eqn) # match characters that are not "a-zA-Z_." split.chars <- unlist(regmatches(deri.eqn, non.match)) # where to split at # split the expression to retrieve variable names to be used in read.output @@ -632,7 +634,7 @@ convert.expr <- function(expression) { } else { variables <- deri.eqn } - + return(list(variable.drv = deri.var, variable.eqn = list(variables = variables, expression = deri.eqn))) } #--------------------------------------------------------------------------------------------------# @@ -645,16 +647,13 @@ convert.expr <- function(expression) { ##' @title download.file ##' @param url complete URL for file download ##' @param filename destination file name -##' @param method Method of file retrieval. Can set this using the options(download.ftp.method=[method]) in your Rprofile. +##' @param method Method of file retrieval. Can set this using the `options(download.ftp.method=[method])` in your Rprofile. ##' example options(download.ftp.method="ncftpget") ##' ##' @examples ##' \dontrun{ ##' download.file("http://lib.stat.cmu.edu/datasets/csb/ch11b.txt","~/test.download.txt") -##' } ##' -##' @examples -##' \dontrun{ ##' download.file(" ##' ftp://ftp.cdc.noaa.gov/Datasets/NARR/monolevel/pres.sfc.2000.nc", ##' "~/pres.sfc.2000.nc") @@ -682,7 +681,7 @@ download.file <- function(url, filename, method) { #--------------------------------------------------------------------------------------------------# ##' Retry function X times before stopping in error -##' +##' ##' @title retry.func ##' @name retry.func ##' @description Retry function X times before stopping in error @@ -690,20 +689,26 @@ download.file <- function(url, filename, method) { ##' @param expr The function to try running ##' @param maxErrors The number of times to retry the function ##' @param sleep How long to wait before retrying the function call -##' +##' @param isError function to use for checking whether to try again. +##' Must take one argument that contains the result of evaluating `expr` +##' and return TRUE if another retry is needed +##' ##' @return retval returns the results of the function call -##' +##' ##' @examples ##' \dontrun{ +##' file_url <- paste0("https://thredds.daac.ornl.gov/", +##' "thredds/dodsC/ornldaac/1220", +##' "/mstmip_driver_global_hd_climate_lwdown_1999_v1.nc4") ##' dap <- retry.func( -##' ncdf4::nc_open('https://thredds.daac.ornl.gov/thredds/dodsC/ornldaac/1220/mstmip_driver_global_hd_climate_lwdown_1999_v1.nc4'), +##' ncdf4::nc_open(file_url) ##' maxErrors=10, ##' sleep=2) ##' } -##' +##' ##' @export ##' @author Shawn Serbin -retry.func <- function(expr, isError=function(x) "try-error" %in% class(x), maxErrors=5, sleep=0) { +retry.func <- function(expr, isError = function(x) inherits(x, "try-error"), maxErrors = 5, sleep = 0) { attempts = 0 retval = try(eval(expr)) while (isError(retval)) { @@ -713,7 +718,7 @@ retry.func <- function(expr, isError=function(x) "try-error" %in% class(x), maxE PEcAn.logger::logger.warn(msg) stop(msg) } else { - msg = sprintf("retry: error in attempt %i/%i [[%s]]", attempts, maxErrors, + msg = sprintf("retry: error in attempt %i/%i [[%s]]", attempts, maxErrors, utils::capture.output(utils::str(retval))) PEcAn.logger::logger.warn(msg) #warning(msg) diff --git a/base/utils/R/write.config.utils.R b/base/utils/R/write.config.utils.R index b349e8636dd..ce30d82adb0 100644 --- a/base/utils/R/write.config.utils.R +++ b/base/utils/R/write.config.utils.R @@ -11,10 +11,10 @@ ### TODO: Generalize this code for all ecosystem models (e.g. ED2.2, SiPNET, etc). #--------------------------------------------------------------------------------------------------# -#--------------------------------------------------------------------------------------------------# -##' Returns a vector of quantiles specified by a given xml tag +##' Get Quantiles +##' +##' Returns a vector of quantiles specified by a given `` xml tag ##' -##' @title Get Quantiles ##' @param quantiles.tag specifies tag used to specify quantiles ##' @return vector of quantiles ##' @export @@ -40,7 +40,6 @@ get.quantiles <- function(quantiles.tag) { ##' get sensitivity samples as a list ##' -##' @title get.sa.sample.list ##' @param pft Plant Functional Type ##' @param env ##' @param quantiles quantiles at which to obtain samples from parameter for @@ -58,16 +57,20 @@ get.sa.sample.list <- function(pft, env, quantiles) { } # get.sa.sample.list -#--------------------------------------------------------------------------------------------------# +##' Get sensitivity analysis samples +##' ##' Samples parameters for a model run at specified quantiles. -##' -##' Samples from long (>2000) vectors that represent random samples from a trait distribution. -##' Samples are either the MCMC chains output from the Bayesian meta-analysis or are randomly sampled from -##' the closed-form distribution of the parameter probability distribution function. +##' +##' Samples from long (>2000) vectors that represent random samples from a +##' trait distribution. +##' Samples are either the MCMC chains output from the Bayesian meta-analysis +##' or are randomly sampled from the closed-form distribution of the +##' parameter probability distribution function. ##' The list is indexed first by trait, then by quantile. -##' @title get sensitivity analysis samples -##' @param samples random samples from trait distribution -##' @param quantiles list of quantiles to at which to sample, set in settings file +##' +##' @param samples random samples from trait distribution +##' @param quantiles list of quantiles to at which to sample, +##' set in settings file ##' @return a list of lists representing quantile values of trait distributions ##' @export ##' @author David LeBauer @@ -83,12 +86,10 @@ get.sa.samples <- function(samples, quantiles) { } # get.sa.samples -#--------------------------------------------------------------------------------------------------# ##' checks that met2model function exists ##' -##' Checks if met2model. exists for a particular -##' model -##' @title met2model.exists +##' Checks if `met2model.` exists for a particular model +##' ##' @param model model package name ##' @return logical met2model.exists <- function(model) { diff --git a/base/utils/data/mstmip_local.csv b/base/utils/data/mstmip_local.csv deleted file mode 100644 index 288484d51b0..00000000000 --- a/base/utils/data/mstmip_local.csv +++ /dev/null @@ -1,21 +0,0 @@ -"Num";"Group";"order";"Saveit";"Variable.Name";"Units";"Long.name";"Priority";"Category";"X3.hourly";"Monthly";"var_type";"ndim";"dim1";"dim2";"dim3";"dim4";"Description" -"1";1;3;1;"Yes";"RootBiom";"kg C m-2";"Total root biomass";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"2";2;3;2;"Yes";"StemBiom";"kg C m-2";"Total stem biomass";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"3";3;3;3;"Yes";"CO2CAS";"ppmv";"CO2CAS";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"4";4;3;4;"Yes";"CropYield";"kg m-2";"CropYield";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"5";5;3;5;"Yes";"SnowFrac";"-";"SnowFrac";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"6";6;3;6;"Yes";"LWdown";"W m-2";"LWdown";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"7";7;3;7;"Yes";"SWdown";"W m-2";"SWdown";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"8";8;3;8;"Yes";"Qg";"W m-2";"Qg";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"9";9;3;9;"Yes";"Swnet";"W m-2";"Swnet";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"10";10;3;10;"Yes";"RootMoist";"kg m-2";"RootMoist";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"11";11;3;11;"Yes";"Tveg";"kg m-2 s-1";"Tveg";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"12";12;3;12;"Yes";"WaterTableD";"m";"WaterTableD";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"13";13;3;13;"Yes";"SMFrozFrac";"-";"SMFrozFrac";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"14";14;3;14;"Yes";"SMLiqFrac";"-";"SMLiqFrac";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"15";15;3;15;"Yes";"Albedo";"-";"Albedo";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"16";16;3;16;"Yes";"SnowT";"K";"SnowT";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"17";17;3;17;"Yes";"VegT";"K";"VegT";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"18";18;3;18;"Yes";"LeafC";"kg C m-2";"LeafC";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"19";19;3;19;"Yes";"Yield";"kg m-2";"Yield";0;"Carbon Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" -"20";20;3;20;"Yes";"stomatal_conductance";"kg m-2 s-1";"Stomatal Conductance";0;"Energy Fluxes";"Yes";"Yes";"real";1;"lon";"lat";"time";"na";"" diff --git a/base/utils/data/mstmip_vars.csv b/base/utils/data/mstmip_vars.csv deleted file mode 100644 index e7702c0bf50..00000000000 --- a/base/utils/data/mstmip_vars.csv +++ /dev/null @@ -1,64 +0,0 @@ -Num;Group;order;Saveit;Variable.Name;standard_name;Units;Long.name;Priority;Category;Hourly;Monthly;var_type;ndim;dim1;dim2;dim3;dim4;Description -1;1;1;Yes;lon;longitude;degrees_east;Longitude;0;Grid;Yes;Yes;real;1;lon;na;na;na;longitude at center of each grid cell -2;1;2;Yes;lat;latitude;degrees_north;Latitude;0;Grid;Yes;Yes;real;1;lat;na;na;na;latitude at center of each grid cell -3;1;3;Yes;lon_bnds;;degrees_east;Longitude west-east bounds;0;Grid;Yes;Yes;real;2;nbnds;lon;na;na;(west boundary of grid cell, east boundary of grid cell) -4;1;4;Yes;lat_bnds;;degrees_north;Latitude south-north bounds;0;Grid;Yes;Yes;real;2;nbnds;lat;na;na;(south boundary of grid cell, north boundary of grid cell) -5;2;1;Yes;time;time;days since 1700-01-01 00:00:00 UTC;Time middle averaging period;0;Time;Yes;Yes;double;1;time;na;na;na;julian days days since 1700-01-01 00:00:00 UTC for middle of time averaging period Proleptic_Gregorianc calendar -6;2;2;Yes;time_bnds;;days since 1700-01-01 00:00:00 UTC;Time beginning-end bounds;0;Time;Yes;Yes;double;2;nbnds;time;na;na;(julian days days since 1700-01-01 beginning time ave period, julian days days since 1700-01-01 end time ave period) -7;2;3;Yes;dec_date;;yr;Decimal date middle averaging period;0;Time;Yes;Yes;double;1;time;na;na;na;decimal date in fractional years for middle of time averaging period -8;2;4;Yes;dec_date_bnds;;yr;Decimal date beginning-end bounds;0;Time;Yes;Yes;double;2;nbnds;time;na;na;(decimal date beginning time ave period, decimal date end time ave period) -9;2;5;Yes;cal_date_mid;;yr, mon, day, hr, min, sec;Calender date middle averaging period;0;Time;Yes;Yes;integer;2;ncal;time;na;na;calender date middle of time ave period: year, month, day, hour, minute, second for UTC time zone -10;2;6;Yes;cal_date_beg;;yr, mon, day, hr, min, sec;Calender date beginning averaging period;0;Time;Yes;Yes;integer;2;ncal;time;na;na;calender date beginning of time ave period: year, month, day, hour, minute, second for UTC time zone -11;2;7;Yes;cal_date_end;;yr, mon, day, hr, min, sec;Calender date end averaging period;0;Time;Yes;Yes;integer;2;ncal;time;na;na;calender date end of time ave period: year, month, day, hour, minute, second for UTC time zone -12;3;1;Yes;GPP;;kg C m-2 s-1;Gross Primary Productivity;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Rate of photosynthesis (always positive) -13;3;2;Yes;NPP;;kg C m-2 s-1;Net Primary Productivity;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Net Primary Productivity (NPP=GPP-AutoResp, positive into plants) -14;3;3;Yes;TotalResp;;kg C m-2 s-1;Total Respiration;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Total respiration (TotalResp=AutoResp+heteroResp, always positive) -15;3;4;Yes;AutoResp;;kg C m-2 s-1;Autotrophic Respiration;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Autotrophic respiration rate (always positive) -16;3;5;Yes;HeteroResp;;kg C m-2 s-1;Heterotrophic Respiration;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Heterotrophic respiration rate (always positive) -17;3;6;Yes;DOC_flux;;kg C m-2 s-1;Dissolved Organic Carbon flux;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Loss of organic carbon dissolved in ground water or rivers (positive out of grid cell) -18;3;7;Yes;Fire_flux;;kg C m-2 s-1;Fire emissions;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Flux of carbon due to fires (always positive) -19;3;8;Yes;NEE;;kg C m-2 s-1;Net Ecosystem Exchange;1;Carbon Fluxes;Yes;Yes;real;3;lon;lat;time;na;Net Ecosystem Exchange (NEE=HeteroResp+AutoResp-GPP, positive into atmosphere) -21;4;2;Yes;poolname;;(-);Name of each Carbon Pool;1;Carbon Pools;No;Yes;character;2;nchar;npool;na;na;"Name of each carbon pool (i.e., \""wood,\"" or \""Coarse Woody Debris\"")" -22;4;3;Yes;CarbPools;;kg C m-2;Size of each carbon pool;1;Carbon Pools;No;Yes;real;4;lon;lat;npool;time;Total size of each carbon pool vertically integrated over the entire soil column -23;4;4;Yes;AbvGrndWood;;kg C m-2;Above ground woody biomass;1;Carbon Pools;No;Yes;real;3;lon;lat;time;na;Total above ground wood biomass -24;4;5;Yes;TotLivBiom;;kg C m-2;Total living biomass;1;Carbon Pools;No;Yes;real;3;lon;lat;time;na;Total carbon content of the living biomass (leaves+roots+wood) -25;4;6;Yes;TotSoilCarb;;kg C m-2;Total Soil Carbon;1;Carbon Pools;No;Yes;real;3;lon;lat;time;na;Total soil and litter carbon content vertically integrated over the enire soil column -26;4;7;Yes;LAI;;m2 m-2;Leaf Area Index;1;Carbon Pools;No;Yes;real;3;lon;lat;time;na;Area of leaves per area ground -27;5;1;Yes;Qh;;W m-2;Sensible heat;1;Energy Fluxes;Yes;Yes;real;3;lon;lat;time;na;Sensible heat flux into the boundary layer (positive into atmosphere) -28;5;2;Yes;Qle;;W m-2;Latent heat;1;Energy Fluxes;Yes;Yes;real;3;lon;lat;time;na;Latent heat flux into the boundary layer (positive into atmosphere) -29;5;3;Yes;Evap;;kg m-2 s-1;Total Evaporation;1;Energy Fluxes;No;Yes;real;3;lon;lat;time;na;Sum of all evaporation sources (positive into atmosphere) -30;5;4;Yes;TVeg;;kg m-2 s-1;Transpiration;1;Energy Fluxes;No;Yes;real;3;lon;lat;time;na;Total Plant transpiration (always positive) -31;5;5;Yes;LW_albedo;;(-);Longwave Albedo;1;Energy Fluxes;No;Yes;real;3;lon;lat;time;na;Longwave Albedo -32;5;6;Yes;SW_albedo;;(-);Shortwave Albedo;1;Energy Fluxes;No;Yes;real;3;lon;lat;time;na;Shortwave albedo -33;5;7;Yes;Lwnet;;W m-2;Net Longwave Radiation;1;Energy Fluxes;No;Yes;real;3;lon;lat;time;na;Incident longwave radiation minus simulated outgoing longwave radiation (positive into grnd) -34;5;8;Yes;SWnet;;W m-2;Net shortwave radiation;1;Energy Fluxes;No;Yes;real;3;lon;lat;time;na;Incident shortwave radiation minus simulated outgoing shortwave radiation (positive into grnd) -35;5;9;Yes;fPAR;;(-);Absorbed fraction incoming PAR;1;Energy Fluxes;No;Yes;real;3;lon;lat;time;na;absorbed fraction incoming photosyntetically active radiation -37;6;2;Yes;z_top;;m;Soil Layer Top Depth;1;Physical Variables;No;Yes;real;1;nsoil;na;na;na;Depth from soil surface to top of soil layer -38;6;3;Yes;z_node;;m;Soil Layer Node Depth;1;Physical Variables;No;Yes;real;1;nsoil;na;na;na;"Depth from soil surface to layer prognostic variables; typically center of soil layer" -39;6;4;Yes;z_bottom;;m;Soil Layer Bottom Depth;1;Physical Variables;No;Yes;real;1;nsoil;na;na;na;Depth from soil surface to bottom of soil layer -40;6;5;Yes;SoilMoist;;kg m-2;Average Layer Soil Moisture;1;Physical Variables;No;Yes;real;4;lon;lat;nsoil;time;Soil water content in each soil layer, including liquid, vapor and ice -41;6;5;Yes;SoilMoistFrac;;(-);Average Layer Fraction of Saturation;1;Physical Variables;No;Yes;real;4;lon;lat;nsoil;time;Fraction of saturation of soil water in each soil layer, including liquid and ice -42;6;6;Yes;SoilWet;;(-);Total Soil Wetness;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;Vertically integrated soil moisture divided by maximum allowable soil moisture above wilting point -43;6;7;Yes;Qs;;kg m-2 s-1;Surface runoff;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;Runoff from the landsurface and/or subsurface stormflow -44;6;8;Yes;Qsb;;kg m-2 s-1;Subsurface runoff;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;Gravity soil water drainage and/or soil water lateral flow -45;6;9;Yes;SoilTemp;;K;Average Layer Soil Temperature;1;Physical Variables;No;Yes;real;4;lon;lat;nsoil;time;Average soil temperature in each soil layer -46;6;10;Yes;Tdepth;;m;Active Layer Thickness;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;"Thaw depth; depth to zero centigrade isotherm in permafrost" -47;6;11;Yes;Fdepth;;m;Frozen Layer Thickness;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;"Freeze depth; depth to zero centigrade isotherm in non-permafrost" -48;6;12;Yes;Tcan;;K;Canopy Temperature;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;Canopy or vegetation temperature (or temperature used in photosynthesis calculations) -49;6;13;Yes;SWE;;kg m-2;Snow Water Equivalent;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;Total water mass of snow pack, including ice and liquid water -50;6;14;Yes;SnowDen;;kg m-3;Bulk Snow Density;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;Overall bulk density of the snow pack, including ice and liquid water -51;6;15;Yes;SnowDepth;;m;Total snow depth;1;Physical Variables;No;Yes;real;3;lon;lat;time;na;Total snow depth -52;7;1;Yes;CO2air;;micromol mol-1;Near surface CO2 concentration;1;Driver;No;Yes;real;3;lon;lat;time;na;Near surface dry air CO2 mole fraction -53;7;2;Yes;LWdown;surface_downwelling_longwave_flux_in_air;W/m2;Surface incident longwave radiation;1;Driver;No;Yes;real;3;lon;lat;time;na;Surface incident longwave radiation -54;7;3;Yes;Psurf;air_pressure;Pa;Surface pressure;1;Driver;No;Yes;real;3;lon;lat;time;na;Surface pressure -55;7;4;Yes;Qair;specific_humidity;kg kg-1;Near surface specific humidity;1;Driver;No;Yes;real;3;lon;lat;time;na;Near surface specific humidity -56;7;5;Yes;Rainf;precipitation_flux;kg m-2 s-1;Rainfall rate;1;Driver;No;Yes;real;3;lon;lat;time;na;Rainfall rate -57;7;6;Yes;SWdown;surface_downwelling_shortwave_flux_in_air;W m-2;Surface incident shortwave radiation;1;Driver;No;Yes;real;3;lon;lat;time;na;Surface incident shortwave radiation -58;7;7;Yes;Tair;air_temperature;K;Near surface air temperature;1;Driver;No;Yes;real;3;lon;lat;time;na;Near surface air temperature -59;7;8;Yes;Wind;wind_speed;m s-1;Near surface module of the wind;1;Driver;No;Yes;real;3;lon;lat;time;na;Near surface wind magnitude -60;;;;Tmin;air_temperature_max;K;Daily Maximum Temperature;1;Driver;No;Yes;real;3;lon;lat;time;na;Daily Maximum Temperature -61;;;;Tmax;air_temperature_min;K;Daily Minimum Temperature;1;Driver;No;Yes;real;3;lon;lat;time;na;Daily Minimum Temperature -62;;;;Uwind;northward_wind;m s-1;Northward Component of Wind;1;Driver;No;Yes;real;3;lon;lat;time;na;Northward Component of Wind -63;;;;Vwind;eastward_wind;m s-1;Eastward Component of Wind;1;Driver;No;Yes;real;3;lon;lat;time;na;Eastward Component of Wind -64;;;;RH;relative_humidity;%;Relative Humidity;1;Driver;No;Yes;real;3;lon;lat;time;na;Relative Humidity -65;;;;PAR;surface_downwelling_photosynthetic_photon_flux_in_air;mol m-2 s-1;Photosynthetically Active Radiation;1;Driver;No;Yes;real;3;lon;lat;time;na;Photosynthetically Active Radiation diff --git a/base/utils/data/standard_vars.csv b/base/utils/data/standard_vars.csv index 98ef54c417a..1b08653ca9d 100755 --- a/base/utils/data/standard_vars.csv +++ b/base/utils/data/standard_vars.csv @@ -111,4 +111,6 @@ Fcomp,NA,kgC kgC-1,Aboveground Biomass Fractional Composition,Diversity,real,lon Estab,NA,1 ha-1,New Individuals,Diversity,real,lon,lat,time,pft,New Individuals, Mort,NA,1 ha-1,Mortality,Diversity,real,lon,lat,time,pft,Individuals lost through death, SoilDepth,NA,m,Soil Depth Layer,Deprecated,real,depth,NA,NA,NA,Depth to the bottom of each model-defined soil layer, -assimilation_rate,NA,kg C m-2 s-1,Leaf assimilation rate,Carbon Fluxes,real,lon,lat,time,NA,Rate of leaf photosynthesis / carbon assimilation, \ No newline at end of file +assimilation_rate,NA,kg C m-2 s-1,Leaf assimilation rate,Carbon Fluxes,real,lon,lat,time,NA,Rate of leaf photosynthesis / carbon assimilation, +date_of_budburst,NA,day of year,Date of Budburst,Phenology,real,lon,lat,time,NA,Date of Budburst +date_of_senescence,NA,day of year,Date of Senescence,Phenology,real,lon,lat,time,NA,Date of Senescence diff --git a/base/utils/inst/get_mstmip_vars.R b/base/utils/inst/get_mstmip_vars.R deleted file mode 100644 index 5c1bc89b0ac..00000000000 --- a/base/utils/inst/get_mstmip_vars.R +++ /dev/null @@ -1,20 +0,0 @@ -ncvar_def.pecan <- function(name, units, longname, - dim = list(lon, lat, t), - missval = -999, prec = "float"){ - ans <- ncvar_def(name = name, units = units, dim = dim, - missval = missval, prec = "float") - return(ans) -} - -make.ncdf_vars <- function(vars = c("LAI")){ - library(data.table) - data(mstmip_vars, package = "PEcAn.utils") - mstmip <- data.table(mstmip_vars) - mstmip[Variable.Name %in% vars, - list(name = Variable.Name, units = Units, - longname = Long.name)] - - with(mstmip_variables, - (Variable.Name, function(x) - names(lapply(mstmip_variables$Variable.Name, identity)) -} diff --git a/base/utils/man/PEcAn.Rd b/base/utils/man/PEcAn.Rd index 24615d80419..311bc9b6932 100644 --- a/base/utils/man/PEcAn.Rd +++ b/base/utils/man/PEcAn.Rd @@ -6,7 +6,6 @@ \alias{PECAn,} \alias{pecan,} \alias{package-pecan} -\alias{PEcAn-package} \title{R package to support PEcAn, the Predictive Ecosystem Analyzer} \description{ Instructions for the use of this package are provided in the project documentation \url{https://pecan.gitbooks.io/pecan-documentation/content/}. diff --git a/base/utils/man/bugs.rdist.Rd b/base/utils/man/bugs.rdist.Rd index d202dff41e9..6443e81cc52 100644 --- a/base/utils/man/bugs.rdist.Rd +++ b/base/utils/man/bugs.rdist.Rd @@ -4,15 +4,18 @@ \alias{bugs.rdist} \title{bugs.rdist} \usage{ -bugs.rdist(prior = data.frame(distn = "norm", parama = 0, paramb = 1), - n.iter = 1e+05, n = NULL) +bugs.rdist( + prior = data.frame(distn = "norm", parama = 0, paramb = 1), + n.iter = 1e+05, + n = NULL +) } \arguments{ \item{prior}{dataframe with distribution name and parameters} -\item{n.iter}{number of samples, output will have n.iter/4 samples} +\item{n.iter}{number of MCMC samples. Output will have n.iter/4 samples} -\item{n}{} +\item{n}{number of randomly chosen samples to return.} } \value{ vector of samples diff --git a/base/utils/man/convert.input.Rd b/base/utils/man/convert.input.Rd index 2e05e45479b..7d69d76ac45 100644 --- a/base/utils/man/convert.input.Rd +++ b/base/utils/man/convert.input.Rd @@ -4,12 +4,32 @@ \alias{convert.input} \title{Convert between formats, reusing existing files where possible} \usage{ -convert.input(input.id, outfolder, formatname, mimetype, site.id, - start_date, end_date, pkg, fcn, con = con, host, browndog, - write = TRUE, format.vars, overwrite = FALSE, exact.dates = FALSE, - allow.conflicting.dates = TRUE, insert.new.file = FALSE, - pattern = NULL, forecast = FALSE, ensemble = FALSE, - ensemble_name = NULL, dbparms = NULL, ...) +convert.input( + input.id, + outfolder, + formatname, + mimetype, + site.id, + start_date, + end_date, + pkg, + fcn, + con = con, + host, + browndog, + write = TRUE, + format.vars, + overwrite = FALSE, + exact.dates = FALSE, + allow.conflicting.dates = TRUE, + insert.new.file = FALSE, + pattern = NULL, + forecast = FALSE, + ensemble = FALSE, + ensemble_name = NULL, + dbparms = NULL, + ... +) } \arguments{ \item{input.id}{The database id of the input file of the parent of the file being processed here. The parent will have the same data, but in a different format.} @@ -57,6 +77,8 @@ Currently only \code{host$name} is used by \code{convert.input}, but whole list \item{ensemble_name}{If convert.input is being called iteratively for each ensemble, ensemble_name contains the identifying name/number for that ensemble.} +\item{dbparms}{list of parameters to use for opening a database connection} + \item{...}{Additional arguments, passed unchanged to \code{fcn}} } \value{ diff --git a/base/utils/man/create.base.plot.Rd b/base/utils/man/create.base.plot.Rd deleted file mode 100644 index 429547152f5..00000000000 --- a/base/utils/man/create.base.plot.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plots.R -\name{create.base.plot} -\alias{create.base.plot} -\title{Create Base Plot} -\usage{ -create.base.plot() -} -\value{ -empty ggplot object -} -\description{ -Creates empty ggplot object -} -\details{ -An empty base plot to which layers created by other functions -(\code{\link{plot_data}}, \code{\link{plot.prior.density}}, -\code{\link{plot.posterior.density}}) can be added. -} -\author{ -David LeBauer -} diff --git a/base/utils/man/do_conversions.Rd b/base/utils/man/do_conversions.Rd deleted file mode 100644 index 16226312457..00000000000 --- a/base/utils/man/do_conversions.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/do_conversions.R -\name{do_conversions} -\alias{do_conversions} -\alias{do.conversions} -\title{do_conversions} -\usage{ -do_conversions(settings, overwrite.met = FALSE, overwrite.fia = FALSE, - overwrite.ic = FALSE) -} -\arguments{ -\item{settings}{PEcAn settings list} - -\item{overwrite.met, overwrite.fia, overwrite.ic}{logical} -} -\description{ -Input conversion workflow - -DEPRECATED: This function has been moved to the PEcAn.workflow package and will be removed from PEcAn.utils. -} -\author{ -Ryan Kelly, Rob Kooper, Betsy Cowdery, Istem Fer -} diff --git a/base/utils/man/download.file.Rd b/base/utils/man/download.file.Rd index 265438a7a0a..b740fac65ef 100644 --- a/base/utils/man/download.file.Rd +++ b/base/utils/man/download.file.Rd @@ -11,7 +11,7 @@ download.file(url, filename, method) \item{filename}{destination file name} -\item{method}{Method of file retrieval. Can set this using the options(download.ftp.method=\link{method}) in your Rprofile. +\item{method}{Method of file retrieval. Can set this using the \verb{options(download.ftp.method=[method])} in your Rprofile. example options(download.ftp.method="ncftpget")} } \description{ @@ -22,9 +22,7 @@ home directory \examples{ \dontrun{ download.file("http://lib.stat.cmu.edu/datasets/csb/ch11b.txt","~/test.download.txt") -} -\dontrun{ download.file(" ftp://ftp.cdc.noaa.gov/Datasets/NARR/monolevel/pres.sfc.2000.nc", "~/pres.sfc.2000.nc") diff --git a/base/utils/man/download.url.Rd b/base/utils/man/download.url.Rd index 1cec6c212d9..470b879940e 100644 --- a/base/utils/man/download.url.Rd +++ b/base/utils/man/download.url.Rd @@ -4,8 +4,7 @@ \alias{download.url} \title{Download file from the url.} \usage{ -download.url(url, file, timeout = 600, .opts = list(), - retry404 = TRUE) +download.url(url, file, timeout = 600, .opts = list(), retry404 = TRUE) } \arguments{ \item{url}{the url of the file to download} diff --git a/base/utils/man/ensemble.filename.Rd b/base/utils/man/ensemble.filename.Rd deleted file mode 100644 index 6e37db3fa62..00000000000 --- a/base/utils/man/ensemble.filename.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.analysis.filenames.r -\name{ensemble.filename} -\alias{ensemble.filename} -\title{Generate ensemble filenames} -\usage{ -ensemble.filename(settings, prefix = "ensemble.samples", - suffix = "Rdata", all.var.yr = TRUE, - ensemble.id = settings$ensemble$ensemble.id, - variable = settings$ensemble$variable, - start.year = settings$ensemble$start.year, - end.year = settings$ensemble$end.year) -} -\value{ -a filename -} -\description{ -Generate ensemble filenames -} -\details{ -Generally uses values in settings, but can be overwritten for manual uses -} -\author{ -Ryan Kelly -} diff --git a/base/utils/man/full.path.Rd b/base/utils/man/full.path.Rd index 78df75247d8..413c0f16435 100644 --- a/base/utils/man/full.path.Rd +++ b/base/utils/man/full.path.Rd @@ -6,6 +6,9 @@ \usage{ full.path(folder) } +\arguments{ +\item{folder}{folder for file paths.} +} \value{ absolute path } diff --git a/base/utils/man/get.ensemble.samples.Rd b/base/utils/man/get.ensemble.samples.Rd deleted file mode 100644 index 397e9c11f1c..00000000000 --- a/base/utils/man/get.ensemble.samples.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ensemble.R -\name{get.ensemble.samples} -\alias{get.ensemble.samples} -\title{Get Ensemble Samples} -\usage{ -get.ensemble.samples(ensemble.size, pft.samples, env.samples, - method = "uniform", param.names = NULL, ...) -} -\arguments{ -\item{ensemble.size}{number of runs in model ensemble} - -\item{pft.samples}{random samples from parameter distribution, e.g. from a MCMC chain} - -\item{env.samples}{env samples} - -\item{method}{the method used to generate the ensemble samples. Random generators: uniform, uniform with latin hypercube permutation. Quasi-random generators: halton, sobol, torus. Random generation draws random variates whereas quasi-random generation is deterministic but well equidistributed. Default is uniform. For small ensemble size with relatively large parameter number (e.g ensemble size < 5 and # of traits > 5) use methods other than halton.} - -\item{param.names}{a list of parameter names that were fitted either by MA or PDA, important argument, if NULL parameters will be resampled independently} -} -\value{ -matrix of (quasi-)random samples from trait distributions -} -\description{ -Get parameter values used in ensemble -} -\details{ -DEPRECATED: This function has been moved to the \code{PEcAn.uncertainty} package. -The version in \code{PEcAn.utils} is deprecated, will not be updated to add any new features, -and will be removed in a future release of PEcAn. -Please use \code{PEcAn.uncertainty::get.ensemble.samples} instead. -Returns a matrix of randomly or quasi-randomly sampled trait values -to be assigned to traits over several model runs. -given the number of model runs and a list of sample distributions for traits -The model run is indexed first by model run, then by trait -} -\author{ -David LeBauer, Istem Fer -} diff --git a/base/utils/man/get.model.output.Rd b/base/utils/man/get.model.output.Rd deleted file mode 100644 index 408d2271f81..00000000000 --- a/base/utils/man/get.model.output.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.model.output.R -\name{get.model.output} -\alias{get.model.output} -\title{Retrieve model output} -\usage{ -get.model.output(model, settings) -} -\arguments{ -\item{model}{the ecosystem model run} -} -\description{ -This function retrieves model output for further analyses -} -\examples{ -\dontrun{ -get.model.output(model) -get.model.output('ED2') -} - -} -\author{ -Michael Dietze, Shawn Serbin, David LeBauer -} diff --git a/base/utils/man/get.quantiles.Rd b/base/utils/man/get.quantiles.Rd index d0687f9777f..541e2098b56 100644 --- a/base/utils/man/get.quantiles.Rd +++ b/base/utils/man/get.quantiles.Rd @@ -13,7 +13,7 @@ get.quantiles(quantiles.tag) vector of quantiles } \description{ -Returns a vector of quantiles specified by a given xml tag +Returns a vector of quantiles specified by a given \verb{} xml tag } \author{ David LeBauer diff --git a/base/utils/man/get.results.Rd b/base/utils/man/get.results.Rd deleted file mode 100644 index e8fe1c95b13..00000000000 --- a/base/utils/man/get.results.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.results.R -\name{get.results} -\alias{get.results} -\title{Generate model output for PEcAn analyses} -\usage{ -get.results(settings, sa.ensemble.id = NULL, ens.ensemble.id = NULL, - variable = NULL, start.year = NULL, end.year = NULL) -} -\arguments{ -\item{settings}{list, read from settings file (xml) using \code{\link{read.settings}}} -} -\description{ -Reads model output and runs sensitivity and ensemble analyses -} -\details{ -Output is placed in model output directory (settings$modeloutdir). -} -\author{ -David LeBauer, Shawn Serbin, Mike Dietze, Ryan Kelly -} diff --git a/base/utils/man/get.run.id.Rd b/base/utils/man/get.run.id.Rd index f22d616a4bb..0bbe9eac020 100644 --- a/base/utils/man/get.run.id.Rd +++ b/base/utils/man/get.run.id.Rd @@ -4,8 +4,7 @@ \alias{get.run.id} \title{Get Run ID} \usage{ -get.run.id(run.type, index, trait = NULL, pft.name = NULL, - site.id = NULL) +get.run.id(run.type, index, trait = NULL, pft.name = NULL, site.id = NULL) } \arguments{ \item{run.type}{character, can be any character; currently 'SA' is used for sensitivity analysis, 'ENS' for ensemble run.} diff --git a/base/utils/man/get.sa.sample.list.Rd b/base/utils/man/get.sa.sample.list.Rd index 82f239cca89..7cb0dce163d 100644 --- a/base/utils/man/get.sa.sample.list.Rd +++ b/base/utils/man/get.sa.sample.list.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/write.config.utils.R \name{get.sa.sample.list} \alias{get.sa.sample.list} -\title{get.sa.sample.list} +\title{get sensitivity samples as a list} \usage{ get.sa.sample.list(pft, env, quantiles) } diff --git a/base/utils/man/get.sa.samples.Rd b/base/utils/man/get.sa.samples.Rd index 74aa70f1e81..9f52c6bc321 100644 --- a/base/utils/man/get.sa.samples.Rd +++ b/base/utils/man/get.sa.samples.Rd @@ -2,14 +2,15 @@ % Please edit documentation in R/write.config.utils.R \name{get.sa.samples} \alias{get.sa.samples} -\title{get sensitivity analysis samples} +\title{Get sensitivity analysis samples} \usage{ get.sa.samples(samples, quantiles) } \arguments{ \item{samples}{random samples from trait distribution} -\item{quantiles}{list of quantiles to at which to sample, set in settings file} +\item{quantiles}{list of quantiles to at which to sample, +set in settings file} } \value{ a list of lists representing quantile values of trait distributions @@ -18,9 +19,11 @@ a list of lists representing quantile values of trait distributions Samples parameters for a model run at specified quantiles. } \details{ -Samples from long (>2000) vectors that represent random samples from a trait distribution. -Samples are either the MCMC chains output from the Bayesian meta-analysis or are randomly sampled from -the closed-form distribution of the parameter probability distribution function. +Samples from long (>2000) vectors that represent random samples from a +trait distribution. +Samples are either the MCMC chains output from the Bayesian meta-analysis +or are randomly sampled from the closed-form distribution of the +parameter probability distribution function. The list is indexed first by trait, then by quantile. } \author{ diff --git a/base/utils/man/grid2netcdf.Rd b/base/utils/man/grid2netcdf.Rd index 1501952bee2..5a133c59940 100644 --- a/base/utils/man/grid2netcdf.Rd +++ b/base/utils/man/grid2netcdf.Rd @@ -7,7 +7,11 @@ grid2netcdf(gdata, date = "9999-09-09", outfile = "out.nc") } \arguments{ -\item{grid.data}{} +\item{gdata}{gridded data to write out} + +\item{date}{currently ignored; date(s) from \code{gdata} are used instead} + +\item{outfile}{name for generated netCDF file.} } \value{ writes netCDF file diff --git a/base/utils/man/load_local.Rd b/base/utils/man/load_local.Rd index 5b7361c202b..20292b46b56 100644 --- a/base/utils/man/load_local.Rd +++ b/base/utils/man/load_local.Rd @@ -7,8 +7,8 @@ load_local(file) } \arguments{ -\item{file}{a (readable binary-mode) \link{connection} or a character string - giving the name of the file to load (when \link{tilde expansion} +\item{file}{a (readable binary-mode) \link[base]{connection} or a character string + giving the name of the file to load (when \link[base]{tilde expansion} is done).} } \value{ diff --git a/base/utils/man/logger.debug.Rd b/base/utils/man/logger.debug.Rd deleted file mode 100644 index 7a0fb99009b..00000000000 --- a/base/utils/man/logger.debug.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logger.R -\name{logger.debug} -\alias{logger.debug} -\title{Logger functions (imported temporarily from PEcAn.logger)} -\usage{ -logger.debug(...) -} -\description{ -Logger functions (imported temporarily from PEcAn.logger) -} diff --git a/base/utils/man/met2model.exists.Rd b/base/utils/man/met2model.exists.Rd index 7f9c359ff50..5b1c80ca6a3 100644 --- a/base/utils/man/met2model.exists.Rd +++ b/base/utils/man/met2model.exists.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/write.config.utils.R \name{met2model.exists} \alias{met2model.exists} -\title{met2model.exists} +\title{checks that met2model function exists} \usage{ met2model.exists(model) } @@ -13,9 +13,5 @@ met2model.exists(model) logical } \description{ -checks that met2model function exists -} -\details{ -Checks if met2model. exists for a particular -model +Checks if \verb{met2model.} exists for a particular model } diff --git a/base/utils/man/mstmipvar.Rd b/base/utils/man/mstmipvar.Rd index 56c2b8d20a2..461be026b34 100644 --- a/base/utils/man/mstmipvar.Rd +++ b/base/utils/man/mstmipvar.Rd @@ -4,11 +4,10 @@ \alias{mstmipvar} \title{MstMIP variable} \usage{ -mstmipvar(name, lat = NA, lon = NA, time = NA, nsoil = NA, - silent = FALSE) +mstmipvar(name, lat = NA, lon = NA, time = NA, nsoil = NA, silent = FALSE) } \arguments{ -\item{name}{name of variable} +\item{name}{of variable} \item{lat}{latitude if dimension requests it} @@ -17,6 +16,8 @@ mstmipvar(name, lat = NA, lon = NA, time = NA, nsoil = NA, \item{time}{time if dimension requests it} \item{nsoil}{nsoil if dimension requests it} + +\item{silent}{logical: suppress log messages about missing variables?} } \value{ ncvar based on MstMIP definition diff --git a/base/utils/man/newxtable.Rd b/base/utils/man/newxtable.Rd index a2099408db6..1d480debd1e 100644 --- a/base/utils/man/newxtable.Rd +++ b/base/utils/man/newxtable.Rd @@ -4,9 +4,15 @@ \alias{newxtable} \title{newxtable} \usage{ -newxtable(x, environment = "table", table.placement = "ht", - label = NULL, caption = NULL, caption.placement = NULL, - align = NULL) +newxtable( + x, + environment = "table", + table.placement = "ht", + label = NULL, + caption = NULL, + caption.placement = NULL, + align = NULL +) } \arguments{ \item{x}{data.frame to be converted to latex table} @@ -22,7 +28,7 @@ Latex version of table, with percentages properly formatted New xtable } \details{ -utility to properly escape the '%' sign for latex +utility to properly escape the '\%' sign for latex } \author{ David LeBauer diff --git a/base/utils/man/r2bugs.distributions.Rd b/base/utils/man/r2bugs.distributions.Rd index eec7e4fbc91..77d11fc8616 100644 --- a/base/utils/man/r2bugs.distributions.Rd +++ b/base/utils/man/r2bugs.distributions.Rd @@ -7,7 +7,9 @@ r2bugs.distributions(priors, direction = "r2bugs") } \arguments{ -\item{priors}{data.frame with columns distn = distribution name, parama, paramb using R default parameterizations} +\item{priors}{data.frame with columns distn = distribution name, parama, paramb using R default parameterizations.} + +\item{direction}{One of "r2bugs" or "bugs2r"} } \value{ priors dataframe using JAGS default parameterizations diff --git a/base/utils/man/read.ensemble.output.Rd b/base/utils/man/read.ensemble.output.Rd deleted file mode 100644 index a24fc7f4b45..00000000000 --- a/base/utils/man/read.ensemble.output.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ensemble.R -\name{read.ensemble.output} -\alias{read.ensemble.output} -\title{Read ensemble output} -\usage{ -read.ensemble.output(ensemble.size, pecandir, outdir, start.year, end.year, - variable, ens.run.ids = NULL) -} -\arguments{ -\item{ensemble.size}{the number of ensemble members run} - -\item{pecandir}{specifies where pecan writes its configuration files} - -\item{outdir}{directory with model output to use in ensemble analysis} - -\item{start.year}{first year to include in ensemble analysis} - -\item{end.year}{last year to include in ensemble analysis} - -\item{variables}{target variables for ensemble analysis} -} -\value{ -a list of ensemble model output -} -\description{ -Reads output from model ensemble -} -\details{ -Reads output for an ensemble of length specified by \code{ensemble.size} and bounded by \code{start.year} -and \code{end.year} - -DEPRECATED: This function has been moved to the \code{PEcAn.uncertainty} package. -The version in \code{PEcAn.utils} is deprecated, will not be updated to add any new features, -and will be removed in a future release of PEcAn. -Please use \code{PEcAn.uncertainty::read.ensemble.output} instead. -} -\author{ -Ryan Kelly, David LeBauer, Rob Kooper -} diff --git a/base/utils/man/read.output.Rd b/base/utils/man/read.output.Rd index 37ecf5bf15f..89602be6a63 100644 --- a/base/utils/man/read.output.Rd +++ b/base/utils/man/read.output.Rd @@ -4,9 +4,18 @@ \alias{read.output} \title{Read model output} \usage{ -read.output(runid, outdir, start.year = NA, end.year = NA, - variables = "GPP", dataframe = FALSE, pft.name = NULL, - ncfiles = NULL, verbose = FALSE, print_summary = TRUE) +read.output( + runid, + outdir, + start.year = NA, + end.year = NA, + variables = "GPP", + dataframe = FALSE, + pft.name = NULL, + ncfiles = NULL, + verbose = FALSE, + print_summary = TRUE +) } \arguments{ \item{runid}{the ID distinguishing the model run. Can be omitted @@ -26,7 +35,7 @@ variables in output file..} \item{dataframe}{Logical: if TRUE, will return output in a \code{data.frame} format with a posix column. Useful for -\code{\link[PEcAn.benchmark:align.data]{PEcAn.benchmark::align.data()}} and plotting.} +\code{PEcAn.benchmark::align.data} and plotting.} \item{pft.name}{character string, name of the plant functional type (PFT) to read PFT-specific output. If \code{NULL} no diff --git a/base/utils/man/read_web_config.Rd b/base/utils/man/read_web_config.Rd index fbf3eea87cd..00874bc9e1c 100644 --- a/base/utils/man/read_web_config.Rd +++ b/base/utils/man/read_web_config.Rd @@ -4,8 +4,11 @@ \alias{read_web_config} \title{Read \code{config.php} file into an R list} \usage{ -read_web_config(php.config = "../../web/config.php", parse = TRUE, - expand = TRUE) +read_web_config( + php.config = "../../web/config.php", + parse = TRUE, + expand = TRUE +) } \arguments{ \item{php.config}{Path to \code{config.php} file} @@ -14,7 +17,7 @@ read_web_config(php.config = "../../web/config.php", parse = TRUE, unquote strings.} \item{expand}{Logical. If \code{TRUE} (default), try to perform some -variable substitutions (only done if parse = TRUE).} +variable substitutions.} } \value{ Named list of variable-value pairs set in \code{config.php} @@ -23,9 +26,9 @@ Named list of variable-value pairs set in \code{config.php} Read \code{config.php} file into an R list } \examples{ -# Read Docker configuration and extract the `dbfiles` and output folders \dontrun{ -docker_config <- read_web_config("/home/carya/web/config.php") +# Read Docker configuration and extract the `dbfiles` and output folders. +docker_config <- read_web_config(file.path("..", "..", "docker", "web", "config.docker.php")) docker_config[["dbfiles_folder"]] docker_config[["output_folder"]] } diff --git a/base/utils/man/retry.func.Rd b/base/utils/man/retry.func.Rd index 4bf50ee5511..ad501ab215e 100644 --- a/base/utils/man/retry.func.Rd +++ b/base/utils/man/retry.func.Rd @@ -4,12 +4,20 @@ \alias{retry.func} \title{retry.func} \usage{ -retry.func(expr, isError = function(x) "try-error" \%in\% class(x), - maxErrors = 5, sleep = 0) +retry.func( + expr, + isError = function(x) inherits(x, "try-error"), + maxErrors = 5, + sleep = 0 +) } \arguments{ \item{expr}{The function to try running} +\item{isError}{function to use for checking whether to try again. +Must take one argument that contains the result of evaluating \code{expr} +and return TRUE if another retry is needed} + \item{maxErrors}{The number of times to retry the function} \item{sleep}{How long to wait before retrying the function call} @@ -25,8 +33,11 @@ Retry function X times before stopping in error } \examples{ \dontrun{ + file_url <- paste0("https://thredds.daac.ornl.gov/", + "thredds/dodsC/ornldaac/1220", + "/mstmip_driver_global_hd_climate_lwdown_1999_v1.nc4") dap <- retry.func( - ncdf4::nc_open('https://thredds.daac.ornl.gov/thredds/dodsC/ornldaac/1220/mstmip_driver_global_hd_climate_lwdown_1999_v1.nc4'), + ncdf4::nc_open(file_url) maxErrors=10, sleep=2) } diff --git a/base/utils/man/run.write.configs.Rd b/base/utils/man/run.write.configs.Rd deleted file mode 100644 index 36cb2923204..00000000000 --- a/base/utils/man/run.write.configs.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run.write.configs.R -\name{run.write.configs} -\alias{run.write.configs} -\title{Run model specific write configuration functions} -\usage{ -run.write.configs(settings, write = TRUE, - ens.sample.method = "uniform", posterior.files = rep(NA, - length(settings$pfts)), overwrite = TRUE) -} -\arguments{ -\item{write}{should the runs be written to the database} - -\item{ens.sample.method}{how to sample the ensemble members('halton' sequence or 'uniform' random)} - -\item{posterior.files}{Filenames for posteriors for drawing samples for ensemble and sensitivity -analysis (e.g. post.distns.Rdata, or prior.distns.Rdata). Defaults to NA, in which case the -most recent posterior or prior (in that order) for the workflow is used. Should be a vector, -with one entry for each PFT. File name only; PFT outdirs will be appended (this forces use of only -files within this workflow, to avoid confusion).} - -\item{model}{the ecosystem model to generate the configuration files for} -} -\value{ -an updated settings list, which includes ensemble IDs for SA and ensemble analysis -} -\description{ -Main driver function to call the ecosystem model specific (e.g. ED, SiPNET) -run and configuration file scripts -} -\details{ -DEPRECATED: This function has been moved to the PEcAn.workflow package and will be removed from PEcAn.utils. -} -\author{ -David LeBauer, Shawn Serbin, Ryan Kelly, Mike Dietze -} diff --git a/base/utils/man/seconds_in_year.Rd b/base/utils/man/seconds_in_year.Rd index 663467547f0..720134b31bd 100644 --- a/base/utils/man/seconds_in_year.Rd +++ b/base/utils/man/seconds_in_year.Rd @@ -9,7 +9,9 @@ seconds_in_year(year, leap_year = TRUE, ...) \arguments{ \item{year}{Numeric year (can be a vector)} -\item{leap_year}{Default = TRUE. If set to FALSE will always return 31536000} +\item{leap_year}{Default = TRUE. If set to FALSE will always return 31536000.} + +\item{...}{additional arguments, all currently ignored} } \description{ Number of seconds in a given year diff --git a/base/utils/man/sensitivity.filename.Rd b/base/utils/man/sensitivity.filename.Rd deleted file mode 100644 index 2f7fc694b54..00000000000 --- a/base/utils/man/sensitivity.filename.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.analysis.filenames.r -\name{sensitivity.filename} -\alias{sensitivity.filename} -\title{Generate sensitivity analysis filenames} -\usage{ -sensitivity.filename(settings, prefix = "sensitivity.samples", - suffix = "Rdata", all.var.yr = TRUE, pft = NULL, - ensemble.id = settings$sensitivity.analysis$ensemble.id, - variable = settings$sensitivity.analysis$variable, - start.year = settings$sensitivity.analysis$start.year, - end.year = settings$sensitivity.analysis$end.year) -} -\value{ -a filename -} -\description{ -Generate sensitivity analysis filenames -} -\details{ -Generally uses values in settings, but can be overwritten for manual uses -} -\author{ -Ryan Kelly -} diff --git a/base/utils/man/standard_vars.Rd b/base/utils/man/standard_vars.Rd index 65fe44e88b3..a69bc524c4b 100644 --- a/base/utils/man/standard_vars.Rd +++ b/base/utils/man/standard_vars.Rd @@ -9,7 +9,7 @@ \item{Variable.Name}{Short name suitable for programming with} \item{standard_name}{Name used in the NetCDF \href{http://cfconventions.org/standard-names.html}{CF metadata conventions} } \item{Units}{Standard units for this variable. Do not call variables by these names if they are in different units. -See \code{\link[udunits2]{udunits}} for conversions to and from non-standard units} +See \code{\link[udunits2]{ud.convert}} for conversions to and from non-standard units} \item{Long.Name}{Human-readable variable name, suitable for e.g. axis labels} \item{Category}{What kind of variable is it? (Carbon pool, N flux, dimension, input driver, etc)} \item{var_type}{Storage type (character, integer, etc)} diff --git a/base/utils/man/status.Rd b/base/utils/man/status.Rd new file mode 100644 index 00000000000..b565592d774 --- /dev/null +++ b/base/utils/man/status.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/status.R +\name{status} +\alias{status} +\alias{status.start} +\alias{status.end} +\alias{status.skip} +\alias{status.check} +\title{PEcAn workflow status tracking} +\usage{ +status.start(name, file = NULL) + +status.end(status = "DONE", file = NULL) + +status.skip(name, file = NULL) + +status.check(name, file = NULL) +} +\arguments{ +\item{name}{one-word description of the module being checked or recorded, +e.g. "TRAIT", "MODEL", "ENSEMBLE"} + +\item{file}{path to status file. +If NULL, taken from \code{settings} (see details)} + +\item{status}{one-word summary of the module result, e.g. "DONE", "ERROR"} +} +\value{ +For \code{status.start}, \code{status.end}, and \code{status.skip}: NULL, invisibly + +For \code{status.check}, an integer: +0 if module not run, 1 if done, -1 if error +} +\description{ +Records the progress of a PEcAn workflow by writing statuses and timestamps +to a STATUS file. Use these each time a module starts, finishes, +or is skipped. +} +\details{ +All of these functions write to or read from a STATUS file in your run's +output directory. If the file is not specified in the call, they will look +for a \code{settings} object in the global environment and use +\verb{/STATUS} if possible. + +Since the status functions may be called inside error-handling routines, +it's important that they not produce new errors of their own. Therefore +if the output file doesn't exist or is not writable, rather than complain +the writer functions (\code{status.start}, \code{status.end}, \code{status.skip}) will +print to the console and \code{status.check} will simply return 0. +} +\section{Functions}{ +\itemize{ +\item \code{status.start}: Record module start time + +\item \code{status.end}: Record module completion time and status + +\item \code{status.skip}: Record that module was skipped + +\item \code{status.check}: Look up module status from file +}} + +\author{ +Rob Kooper +} diff --git a/base/utils/man/status.check.Rd b/base/utils/man/status.check.Rd deleted file mode 100644 index 2c89911fed9..00000000000 --- a/base/utils/man/status.check.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/status.R -\name{status.check} -\alias{status.check} -\title{status.check} -\usage{ -status.check(name) -} -\description{ -PEcAn workflow status tracking: check module status -} -\author{ -Rob Kooper -} diff --git a/base/utils/man/status.end.Rd b/base/utils/man/status.end.Rd deleted file mode 100644 index 1cc5ff1ddb1..00000000000 --- a/base/utils/man/status.end.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/status.R -\name{status.end} -\alias{status.end} -\title{status.end} -\usage{ -status.end(status = "DONE") -} -\description{ -PEcAn workflow status tracking: end module -} -\author{ -Rob Kooper -} diff --git a/base/utils/man/status.skip.Rd b/base/utils/man/status.skip.Rd deleted file mode 100644 index cbed7defecc..00000000000 --- a/base/utils/man/status.skip.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/status.R -\name{status.skip} -\alias{status.skip} -\title{status.skip} -\usage{ -status.skip(name) -} -\description{ -PEcAn workflow status tracking: skip module -} -\author{ -Rob Kooper -} diff --git a/base/utils/man/status.start.Rd b/base/utils/man/status.start.Rd deleted file mode 100644 index 8ac1bf113f5..00000000000 --- a/base/utils/man/status.start.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/status.R -\name{status.start} -\alias{status.start} -\title{status.start} -\usage{ -status.start(name) -} -\description{ -PEcAn workflow status tracking: start module -} -\author{ -Rob Kooper -} diff --git a/base/utils/man/transformstats.Rd b/base/utils/man/transformstats.Rd index b0a23a4a2ba..de87f63654e 100644 --- a/base/utils/man/transformstats.Rd +++ b/base/utils/man/transformstats.Rd @@ -2,27 +2,29 @@ % Please edit documentation in R/transformstats.R \name{transformstats} \alias{transformstats} -\title{Transform Stats} +\title{Transform misc. statistics to SE} \usage{ transformstats(data) } \arguments{ -\item{data}{data frame with mean, statistic, n, and statistic name: \code{example data <- data.frame(Y=rep(1,5), stat=rep(1,5), n=rep(4,5), statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD'))}} +\item{data}{data frame with columns for mean, statistic, n, +and statistic name} } \value{ -dataframe with statistics transformed to SE +data frame with statistics transformed to SE } \description{ -Transform misc. statistics to SE -} -\details{ -Automates transformations of SD, MSE, LSD, 95\%CI, HSD, and MSD to conservative estimates of SE. +Automates transformations of SD, MSE, LSD, 95\%CI, HSD, and MSD +to conservative estimates of SE. +Method details and assumptions described in +LeBauer 2020 Transforming ANOVA and Regression statistics for Meta-analysis. +Authorea. DOI: https://doi.org/10.22541/au.158359749.96662550 } \examples{ statdf <- data.frame(Y=rep(1,5), - stat=rep(1,5), - n=rep(4,5), - statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD')) + stat=rep(1,5), + n=rep(4,5), + statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD')) transformstats(statdf) } \author{ diff --git a/base/utils/man/units_are_equivalent.Rd b/base/utils/man/units_are_equivalent.Rd index 4405d76f170..6cffe34f790 100644 --- a/base/utils/man/units_are_equivalent.Rd +++ b/base/utils/man/units_are_equivalent.Rd @@ -16,7 +16,7 @@ units_are_equivalent(x, y) } \description{ This is to allow multiple forms of the same unit to work, such as -\code{m/s} vs. \code{m s-1} or \code{K} and \code{Kelvin}. +\code{m/s} vs. \verb{m s-1} or \code{K} and \code{Kelvin}. } \author{ Alexey Shiklomanov diff --git a/base/utils/man/write.ensemble.configs.Rd b/base/utils/man/write.ensemble.configs.Rd deleted file mode 100644 index 688f690a237..00000000000 --- a/base/utils/man/write.ensemble.configs.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ensemble.R -\name{write.ensemble.configs} -\alias{write.ensemble.configs} -\title{Write ensemble configs} -\usage{ -write.ensemble.configs(defaults, ensemble.samples, settings, model, - clean = FALSE, write.to.db = TRUE) -} -\arguments{ -\item{defaults}{pft} - -\item{ensemble.samples}{list of lists supplied by \link{get.ensemble.samples}} - -\item{settings}{list of PEcAn settings} - -\item{clean}{remove old output first?} - -\item{write.config}{a model-specific function to write config files, e.g. \link{write.config.ED}} -} -\value{ -list, containing $runs = data frame of runids, and $ensemble.id = the ensemble ID for these runs. Also writes sensitivity analysis configuration files as a side effect -} -\description{ -Write ensemble config files -} -\details{ -DEPRECATED: This function has been moved to the \code{PEcAn.uncertainty} package. -The version in \code{PEcAn.utils} is deprecated, will not be updated to add any new features, -and will be removed in a future release of PEcAn. -Please use \code{PEcAn.uncertainty::write.ensemble.configs} instead. - -Writes config files for use in meta-analysis and returns a list of run ids. -Given a pft.xml object, a list of lists as supplied by get.sa.samples, -a name to distinguish the output files, and the directory to place the files. -} -\author{ -David LeBauer, Carl Davidson -} diff --git a/base/utils/man/zero.bounded.density.Rd b/base/utils/man/zero.bounded.density.Rd index 0f32e90edc5..c2b423e2c17 100644 --- a/base/utils/man/zero.bounded.density.Rd +++ b/base/utils/man/zero.bounded.density.Rd @@ -29,5 +29,5 @@ One useful approach is to transform to logs, estimate the density using KDE, and M. P. Wand, J. S. Marron and D. Ruppert, 1991. Transformations in Density Estimation. Journal of the American Statistical Association. 86(414):343-353 \url{http://www.jstor.org/stable/2290569} } \author{ -\href{http://stats.stackexchange.com/q/6588/2750}{Rob Hyndman} +\href{https://stats.stackexchange.com/q/6588/2750}{Rob Hyndman} } diff --git a/base/utils/man/zero.truncate.Rd b/base/utils/man/zero.truncate.Rd index df6b1b4ddcd..fa5d0b34db6 100644 --- a/base/utils/man/zero.truncate.Rd +++ b/base/utils/man/zero.truncate.Rd @@ -16,5 +16,5 @@ numeric vector with all values less than 0 set to 0 Truncates vector at 0 } \author{ - +unknown } diff --git a/base/utils/tests/Rcheck_reference.log b/base/utils/tests/Rcheck_reference.log new file mode 100644 index 00000000000..80690eaefd9 --- /dev/null +++ b/base/utils/tests/Rcheck_reference.log @@ -0,0 +1,88 @@ +* using log directory ‘/tmp/Rtmp6InlXl/PEcAn.utils.Rcheck’ +* using R version 4.0.2 (2020-06-22) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.utils/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.utils’ version ‘1.7.1’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... NOTE +Package suggested but not available for checking: 'PEcAn.DB' +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.utils’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking for future file timestamps ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... OK +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +convert.input: no visible binding for global variable ‘settings’ +convert.input: no visible binding for global variable ‘id’ +convert.input : log_format_df: no visible binding for global variable + ‘.’ +grid2netcdf: no visible binding for global variable ‘years’ +grid2netcdf: no visible binding for global variable ‘yieldarray’ +mcmc.list2init: no visible binding for global variable ‘nr’ +read.sa.output: no visible binding for global variable ‘runs.samples’ + +Undefined global functions or variables: + . nr runs.samples settings years yieldarray +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... WARNING +Undocumented code objects: + ‘trait.dictionary’ +Undocumented data sets: + ‘trait.dictionary’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... OK +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'get.sa.sample.list': + ‘env’ + +* checking for unstated dependencies in examples ... OK +* checking contents of ‘data’ directory ... OK +* checking data for non-ASCII characters ... OK +* checking data for ASCII and uncompressed saves ... OK +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* checking for non-standard things in the check directory ... OK +* checking for detritus in the temp directory ... OK +* DONE + +Status: 2 WARNINGs, 3 NOTEs +See + ‘/tmp/Rtmp6InlXl/PEcAn.utils.Rcheck/00check.log’ +for details. diff --git a/base/utils/tests/testthat/data/config.example.php b/base/utils/tests/testthat/data/config.example.php new file mode 100644 index 00000000000..653cd64fcfb --- /dev/null +++ b/base/utils/tests/testthat/data/config.example.php @@ -0,0 +1,125 @@ + array(), + "geo.bu.edu" => + array("displayname" => "geo", + "qsub" => "qsub -V -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash", + "jobid" => "Your job ([0-9]+) .*", + "qstat" => "qstat -j @JOBID@ || echo DONE", + "prerun" => "module load udunits R/R-3.0.0_gnu-4.4.6", + "postrun" => "sleep 60", + "models" => + array("ED2" => + array("prerun" => "module load hdf5"), + "ED2 (r82)" => + array("prerun" => "module load hdf5") + ) + ) + ); + +# Folder where PEcAn is installed +$R_library_path="/home/carya/R/library"; + +# Location where PEcAn is installed, not really needed anymore +$pecan_home="/home/carya/pecan/"; + +# Folder where the runs are stored +$output_folder="/home/carya/output/"; + +# Folder where the generated files are stored +$dbfiles_folder=$output_folder . "/dbfiles"; + +# location of BETY DB set to empty to not create links, can be both +# relative or absolute paths or full URL's. Should point to the base +# of BETYDB +$betydb="/bety"; + +# ---------------------------------------------------------------------- +# SIMPLE EDITING OF BETY DATABSE +# ---------------------------------------------------------------------- +# Number of items to show on a page +$pagesize = 30; + +# Location where logs should be written +$logfile = "/home/carya/output/betydb.log"; + +# uncomment the following variable to enable the simple interface +#$simpleBETY = TRUE; + +# syncing details + +$server_url="192.168.0.5"; // local test server +$client_sceret=""; +$server_auth_token=""; + +?> diff --git a/base/utils/tests/testthat/helper.R b/base/utils/tests/testthat/helper.R index 875c89a2878..f78f1c36324 100644 --- a/base/utils/tests/testthat/helper.R +++ b/base/utils/tests/testthat/helper.R @@ -38,7 +38,7 @@ example_netcdf <- function(varnames, file_path) { units = "kg", dim = dims, missval = NA) names(vars) <- varnames nc <- ncdf4::nc_create(filename = file_path, vars = vars) - on.exit(ncdf4::nc_close(nc)) + on.exit(ncdf4::nc_close(nc), add = TRUE) ncdf4::ncatt_put(nc, 0, "description", "strictly for testing") for (v in varnames) { ncdf4::ncvar_put(nc, varid = vars[[v]], vals = rnorm(n)) diff --git a/base/utils/tests/testthat/test-status.R b/base/utils/tests/testthat/test-status.R new file mode 100644 index 00000000000..8cb463870d3 --- /dev/null +++ b/base/utils/tests/testthat/test-status.R @@ -0,0 +1,70 @@ +context("status") + +make_testdir <- function() { + td <- tempfile() + dir.create(td) + teardown(unlink(td, recursive = TRUE, force = TRUE)) + + td +} + +test_that("status functions accept explicit filename", { + d <- make_testdir() + f <- file.path(d, "MY_STATUS") + + expect_silent(status.start("TRAITS", f)) + expect_silent(status.end("DONE", f)) + expect_silent(status.skip("MET", f)) + expect_silent(status.start("ENSEMBLE", f)) + expect_silent(status.end("ERROR", f)) + + res <- readLines(f) + expect_length(res, 3) + expect_match(res[[1]], "^TRAITS.*DONE\\s*$") + expect_match(res[[2]], "^MET.*SKIPPED\\s*$") + expect_match(res[[3]], "^ENSEMBLE.*ERROR\\s*$") + expect_equal(status.check("TRAITS", f), 1L) + expect_equal(status.check("MET", f), 0L) + expect_equal(status.check("ENSEMBLE", f), -1L) +}) + +test_that("status handles file = dir/", { + d <- make_testdir() + status.start("NONE", d) + status.end("DONE", d) + expect_equal(status.check("NONE", file.path(d, "STATUS")), 1L) +}) + +test_that("status functions read from local settings", { + settings <- list(outdir = make_testdir()) + expect_silent(status.skip("auto")) + expect_match( + readLines(file.path(settings$outdir, "STATUS"))[[1]], + "^auto.*SKIPPED\\s*$") +}) + +test_that("status finds settings defined outside immediate calling scope", { + settings <- list(outdir = make_testdir()) + f <- function(name) { + status.start(name) + status.end() + } + g <- function(name) { + f(name) + } + expect_silent(g("WRAPPED")) + expect_equal( + status.check("WRAPPED", file.path(settings$outdir, "STATUS")), + 1L) +}) + +test_that("status writes to stdout on bad filename", { + expect_output(status.start("NOFILE"), "NOFILE") + settings <- list(outdir = file.path(make_testdir(), "fake", "path")) + expect_output(status.end(), "\\d{4}-\\d{2}-\\d{2}.*DONE") +}) + +test_that("status.check returns 0 on bad filename", { + expect_equal(status.check("NOFILE"), 0L) + expect_equal(status.check("NOFILE", file.path(make_testdir(), "fake")), 0L) +}) diff --git a/base/utils/tests/testthat/test.read_web_config.R b/base/utils/tests/testthat/test.read_web_config.R index 25d7df32bc9..a45173d92d8 100644 --- a/base/utils/tests/testthat/test.read_web_config.R +++ b/base/utils/tests/testthat/test.read_web_config.R @@ -1,19 +1,27 @@ context("Read web config") -# `here` package needed to correctly set path relative to package -skip_if_not_installed("here") -pecan_root <- normalizePath(here::here("..", "..")) +php_config_example <- file.path("data", "config.example.php") test_that("Read example config file", { - php_config_example <- file.path(pecan_root, "web", "config.example.php") cfg_example <- read_web_config(php_config_example) expect_equal(cfg_example[["output_folder"]], "/home/carya/output/") expect_equal(cfg_example[["dbfiles_folder"]], "/home/carya/output//dbfiles") }) -test_that("Read docker config file", { - php_config_docker <- file.path(pecan_root, "docker", "web", "config.docker.php") - cfg_docker <- read_web_config(php_config_docker) - expect_equal(cfg_docker[["output_folder"]], "/data/workflows") - expect_equal(cfg_docker[["dbfiles_folder"]], "/data/dbfiles") +test_that("parse converts types", { + cfg_example <- read_web_config(php_config_example, parse = FALSE) + expect_type(cfg_example[["pagesize"]], "character") + expect_equal(cfg_example[["pagesize"]], "30") + + cfg_example <- read_web_config(php_config_example, parse = TRUE) + expect_type(cfg_example[["pagesize"]], "double") + expect_equal(cfg_example[["pagesize"]], 30) +}) + +test_that("expand replaces output_folder", { + cfg_example <- read_web_config(php_config_example, expand = FALSE) + expect_equal(cfg_example[["dbfiles_folder"]], "$output_folder . /dbfiles") + + cfg_example <- read_web_config(php_config_example, expand = TRUE) + expect_equal(cfg_example[["dbfiles_folder"]], "/home/carya/output//dbfiles") }) diff --git a/base/utils/tests/testthat/test.utils.R b/base/utils/tests/testthat/test.utils.R index 9d72a72803b..7f01144ffdf 100644 --- a/base/utils/tests/testthat/test.utils.R +++ b/base/utils/tests/testthat/test.utils.R @@ -9,9 +9,9 @@ context("Other utilities") test.stats <- data.frame(Y=rep(1,5), - stat=rep(1,5), - n=rep(4,5), - statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD')) + stat=rep(1,5), + n=rep(4,5), + statname=c('SD', 'MSE', 'LSD', 'HSD', 'MSD')) test_that("transformstats works",{ expect_equal(signif(transformstats(test.stats)$stat, 5), @@ -20,7 +20,7 @@ test_that("transformstats works",{ expect_equal(test.stats$Y, transformstats(test.stats)$Y) expect_equal(test.stats$n, transformstats(test.stats)$n) expect_false(any(as.character(test.stats$statname) == - as.character(transformstats(test.stats)$statname))) + as.character(transformstats(test.stats)$statname))) }) @@ -33,7 +33,7 @@ test_that('arrhenius scaling works', { test_that("vecpaste works",{ - + ## vecpaste() expect_that(vecpaste(c('a','b')), equals("'a','b'")) @@ -69,12 +69,31 @@ test_that("summarize.result works appropriately", { specie_id = 1, n = 1, mean = sqrt(1:10), - stat = 'none', - statname = 'none' - ) + stat = NA, + statname = NA, + name = NA, + treatment_id = NA + ) + # check that individual means produced for distinct sites + expect_that(summarize.result(testresult)$mean, equals(testresult$mean)) + + # check that four means are produced for a single site testresult2 <- transform(testresult, site_id= 1) - expect_that(summarize.result(testresult)$mean, equals(testresult$mean)) - expect_that(nrow(summarize.result(testresult2)), equals(4)) + expect_that(nrow(summarize.result(testresult2)), equals(4)) + + # check that if stat == NA, SE will be computed + testresult3 <- summarize.result(testresult2) + expect_true(all(!is.na(testresult3$stat))) + expect_equal(testresult3$n, c(3L, 2L, 2L, 3L)) + expect_equal(round(testresult3$stat, 3), c(0.359, 0.177, 0.293, 0.206)) + expect_equal(round(testresult3$mean, 3), c(1.656, 2.823, 1.707, 2.813)) + + # check that site groups correctly for length(site) > 1 + testresult4 <- rbind.data.frame(testresult2, transform(testresult2, site_id= 2)) + testresult5 <- summarize.result(testresult4) + expect_true(all(!is.na(testresult5$stat))) + expect_equal(nrow(testresult5), 8) + }) diff --git a/base/visualization/DESCRIPTION b/base/visualization/DESCRIPTION index b4491217f98..5eb0b1dcff1 100644 --- a/base/visualization/DESCRIPTION +++ b/base/visualization/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAn.visualization Type: Package Title: PEcAn visualization functions -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c( person("Mike", "Dietze", role = "aut"), person("David", "LeBauer", @@ -22,12 +22,9 @@ Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific efficacy of scientific investigation. This module is used to create more complex visualizations from the data generated by PEcAn code, specifically the models. -Depends: +Imports: data.table, ggplot2, - raster, - sp -Imports: maps, ncdf4 (>= 1.15), PEcAn.DB, @@ -36,14 +33,18 @@ Imports: plyr (>= 1.8.4), RCurl, reshape2, + rlang, stringr(>= 1.1.0) Suggests: grid, png, + raster, + sp, testthat (>= 1.0.2) -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 +Roxygen: list(markdown = TRUE) diff --git a/base/visualization/NAMESPACE b/base/visualization/NAMESPACE index d984107a7b6..4ae1df406d6 100644 --- a/base/visualization/NAMESPACE +++ b/base/visualization/NAMESPACE @@ -2,7 +2,8 @@ export(add_icon) export(ciEnvelope) -export(create_status_page) export(map.output) -export(plot.netcdf) +export(plot_data) +export(plot_netcdf) export(vwReg) +importFrom(rlang,.data) diff --git a/base/visualization/R/add_icon.R b/base/visualization/R/add_icon.R index aebc92c333a..d01947bf2bb 100644 --- a/base/visualization/R/add_icon.R +++ b/base/visualization/R/add_icon.R @@ -7,19 +7,27 @@ ##' @author Mike Dietze ##' add_icon <- function(id = NULL, x = 0, y = 0) { - library(png) - library(grid) - icon <- readPNG(system.file("favicon.png", package = "PEcAn.visualization")) + + # png and grid are both in Suggests; need to check if available before using + if (!requireNamespace("png", quietly = TRUE) + || !requireNamespace("grid", quietly = TRUE)) { + PEcAn.logger::logger.error( + "PEcAn.visualization::add_icon needs packages 'png' and 'grid'") + return(NULL) + } + + icon <- png::readPNG( + system.file("favicon.png", package = "PEcAn.visualization")) dims <- dim(icon) - logo <- rasterGrob(icon, unit(x, "npc"), - unit(y, "npc"), - unit(dims[1], "points"), - unit(dims[2], "points"), + logo <- grid::rasterGrob(icon, grid::unit(x, "npc"), + grid::unit(y, "npc"), + grid::unit(dims[1], "points"), + grid::unit(dims[2], "points"), just = c("left", "bottom")) - grid.draw(logo) - - lab <- textGrob(label = paste("PEcAn", id), - x = unit(x, "npc") + unit(dims[1], "points"), - y = unit(y, "npc"), just = c("left", "bottom")) - grid.draw(lab) + grid::grid.draw(logo) + + lab <- grid::textGrob(label = paste("PEcAn", id), + x = grid::unit(x, "npc") + grid::unit(dims[1], "points"), + y = grid::unit(y, "npc"), just = c("left", "bottom")) + grid::grid.draw(lab) } # add_icon diff --git a/base/visualization/R/ciEnvelope.R b/base/visualization/R/ciEnvelope.R index e19c60140c1..78e3932c1ac 100644 --- a/base/visualization/R/ciEnvelope.R +++ b/base/visualization/R/ciEnvelope.R @@ -3,7 +3,9 @@ #' @param x Vector defining CI center #' @param ylo Vector defining bottom of CI envelope #' @param yhi Vector defining top of CI envelope -#' @export +#' @param ... further arguments passed on to `graphics::polygon` +#' +#' @export #' @author Michael Dietze, David LeBauer ciEnvelope <- function(x, ylo, yhi, ...) { m <- rbind(x, ylo, yhi) @@ -30,6 +32,7 @@ ciEnvelope <- function(x, ylo, yhi, ...) { x <- sub.m[[i]]["x", ] ylo <- sub.m[[i]]["ylo", ] yhi <- sub.m[[i]]["yhi", ] - polygon(cbind(c(x, rev(x), x[1]), c(ylo, rev(yhi), ylo[1])), border = NA, ...) + graphics::polygon( + cbind(c(x, rev(x), x[1]), c(ylo, rev(yhi), ylo[1])), border = NA, ...) } } # ciEnvelope diff --git a/base/visualization/R/create_status_page.R b/base/visualization/R/create_status_page.R deleted file mode 100644 index 9e4dd2fbfe3..00000000000 --- a/base/visualization/R/create_status_page.R +++ /dev/null @@ -1,247 +0,0 @@ -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - -##' Create PEcAn Network status page. -##' -##' This will create a webpage (file_prefix.html) as well as an image -##' (file_prefix.png) that shows the PEcAn Network satus. This will -##' save the geo location of each site as well as some additional -##' information in a cache file (file_prefix.RData). If an update to -##' the BETY schema is detected it will be logged in a file -##' (file_prefix.log). -##' -##' @param config_file Path to `config.php` -##' @param file_prefix prefix used for all files saved -##' @param delta number of seconds before -##' -##' @author Michael Dietze -##' @author Rob Kooper -##' -##' @export -##' -##' @examples -##' \dontrun{ -##' create_status_page('/home/carya/pecan/web/config.php') -##' } -create_status_page <- function(config_file, file_prefix='status', delta=3600) { - ## Read PHP config file for webserver - config <- PEcAn.utils::read_web_config(config_file) - - ## Database connection - bety <- list(user = config$db_bety_username, - password = config$db_bety_password, - host = config$db_bety_hostname, - dbname = config$db_bety_database) - - ## load previous state or initialize - if(file.exists(paste0(file_prefix, ".RData"))){ - load(paste0(file_prefix, ".RData")) - } else { - geoinfo <- list() - schema_versions <- list() - nodes <- list() - } - - ## get nodes from database - con <- PEcAn.DB::db.open(bety) - pecan_nodes <- PEcAn.DB::db.query("select * from machines where sync_host_id >= 0 and sync_url != '' order by sync_host_id",con) - PEcAn.DB::db.close(con) - - ## make sure we have information for all nodes - for(i in seq_len(nrow(pecan_nodes))) { - x <- pecan_nodes[i,] - - # small fix for missing http:// - if (!startsWith(x$sync_url, 'http')) { - x$sync_url <- paste0('http://', x$sync_url) - } - - # find hostname - hostname <- sub("https://","", x[['sync_url']]) - hostname <- sub("http://","", hostname) - hostname <- strsplit(hostname, split = "/")[[1]][1] - hostname <- strsplit(hostname, split=":")[[1]][1] - - # get geoinfo (need to use cache) - if (!(hostname %in% names(geoinfo))) { - print(paste("Getting geoinfo for", hostname)) - result <- RCurl::getURL(paste0("ip-api.com/csv/",hostname)) - geoinfo[[hostname]] <- strsplit(result,",")[[1]] - - # shift illinois sites into triangle to make them visible - if (hostname == 'ebi-forecast.igb.illinois.edu') { - geoinfo[[hostname]][[8]] <- as.numeric(geoinfo[[hostname]][[8]])+0.5 - } - if (hostname == 'terraref.ncsa.illinois.edu') { - geoinfo[[hostname]][[8]] <- as.numeric(geoinfo[[hostname]][[8]])-0.5 - geoinfo[[hostname]][[9]] <- as.numeric(geoinfo[[hostname]][[9]])+1 - } - if (hostname == 'terra-mepp.igb.illinois.edu') { - geoinfo[[hostname]][[8]] <- as.numeric(geoinfo[[hostname]][[8]])-0.5 - geoinfo[[hostname]][[9]] <- as.numeric(geoinfo[[hostname]][[9]])-1 - } - } - - # get version info - version_url <- sub("bety.tar.gz", "version.txt", x$sync_url) - state <- 2 # DOWN is the default - schema <- '' # no schema found - lastdump <- 0 # never dumped - if(RCurl::url.exists(version_url)) { - temporaryFile <- tempfile() - download.file(version_url, destfile = temporaryFile, quiet = TRUE) - version <- scan(temporaryFile,what = "character", sep = "\t", quiet = TRUE) - unlink(temporaryFile) - - # make sure there are 4 elements (old version no longer supported) - if (length(version) == 4) { - state <- 0 - schema <- version[2] - lastdump <- strptime(version[4], '%FT%TZ', tz='UTC') - - # make sure we know about this schema - if (!(schema %in% schema_versions)) { - schema_versions <- c(schema_versions, schema) - } - - # check if the schema has been updated, if so log the event - if ((hostname %in% nodes) && (nodes[[hostname]]['schema'] != schema)) { - msg <- paste(Sys.time(), "SCHEMA UPDATE DETECTED ON NODE", x$sync_host_id, hostname, - "FROM", nodeinfo[[hostname]]['schema'], "TO", schema) - write(msg, file=paste0(file_prefix, ".log"), append=TRUE) - } - } - } - - # get sync.log - log_url <- sub("bety.tar.gz","sync.log", x$sync_url) - sync <- list() - if (RCurl::url.exists(log_url)) { - temporaryFile <- tempfile() - download.file(log_url, destfile = temporaryFile, quiet = TRUE) - log <- scan(temporaryFile,what = "character", sep = "\n", quiet = TRUE) - unlink(temporaryFile) - - # collect last time synced and status - for(row in log) { - sync.time <- sub("UTC ","",substr(row, 1, 28)) - sync.time <- strptime(sync.time,"%a %b %d %T %Y", tz="UTC") - sync.cols <- strsplit(row," ")[[1]] - if (!is.na(sync.cols[7])) { - sync[[as.character(sync.cols[7])]] <- list(id = sync.cols[7], - when = as.numeric(sync.time), - status = as.numeric(sync.cols[8])) - } - } - } - - # save all information - nodes[[as.character(x$sync_host_id)]] <- list(sync_host_id=x$sync_host_id, - sync_url=x$sync_url, - hostname=hostname, - lat=as.numeric(geoinfo[[hostname]][8]), - lon=as.numeric(geoinfo[[hostname]][9]), - schema=schema, - state=state, - lastdump=as.numeric(lastdump), - sync=sync) - } - - ## check all nodes: - ## - schema check, is schema for node latests - ## - sync check, has node synced with known nodes - latest_schema <- schema_versions[length(schema_versions)] - for(x in nodes) { - # have latest schema - if (x$state != 2) { - if (x$schema != latest_schema) { - nodes[[as.character(x$sync_host_id)]][['state']] <- 1 # behind - } - } - # did this node sync with all other nodes - for(y in x$sync) { - if (y$status == 0 && (nodes[[y$id]][['lastdump']] - y$when) > delta) { - nodes[[as.character(x$sync_host_id)]][['sync']][[y$id]][['status']] <- 2 - } - } - } - - ## save some variables - save(geoinfo, schema_versions, nodes, file=paste0(file_prefix, ".RData")) - - ## create image - png(filename=paste0(file_prefix, ".png"), width=1200) - xlim <- extendrange(sapply(nodes, function(x) { x$lon }), f=1) - ylim <- extendrange(sapply(nodes, function(x) { x$lat }), f=1) - maps::map("world", xlim=xlim, ylim=ylim) - maps::map("state",add=TRUE) - - # show all edges - edgecolors <- c("green","red", "yellow") - x <- lapply(nodes, function(x) { - lapply(x$sync, function(y) { - segments((x$lon+nodes[[y$id]]$lon)/2, ( x$lat+nodes[[y$id]]$lat)/2, x$lon, x$lat, col=edgecolors[y$status+1], lwd=2) - }) - }) - - # show all pecan sites - nodecolors <- c("green","yellow", "red") - x <- lapply(nodes, function(x) { - points(x$lon, x$lat, col=nodecolors[x$state+1], pch=19, cex=3) - text(x$lon, x$lat, labels=x$sync_host_id) - }) - - # graph done - text(xlim[1], ylim[1], labels = Sys.time(), pos=4) - dev.off() - - ## create html file - htmltable <- '' - htmltable <- paste(htmltable, '', sep='\n') - htmltable <- paste(htmltable, '', sep='\n') - htmltable <- paste(htmltable, '', sep='\n') - htmltable <- paste(htmltable, 'PEcAn Network Status', sep='\n') - htmltable <- paste(htmltable, '', sep='\n') - htmltable <- paste(htmltable, '', sep='\n') - htmltable <- paste(htmltable, paste0(''), sep='\n') - - htmltable <- paste(htmltable, '', sep='\n') - row <- '' - for(n in names(nodes)) { - row <- paste0(row, '') - } - row <- paste0(row, '') - htmltable <- paste(htmltable, row, sep='\n') - - status <- c("UP", "BEHIND", "DOWN") - now <- Sys.time() - x <- sapply(nodes, function(x) { - row <- '' - row <- paste0(row, '') - row <- paste0(row, '') - row <- paste0(row, '') - row <- paste0(row, '') - for(n in names(nodes)) { - if (n == x$sync_host_id) { - row <- paste0(row, '') - } else if (n %in% names(x$sync)) { - when <- as.POSIXct(x$sync[[n]]$when, origin = "1970-01-01", tz = "UTC") - row <- paste0(row, '') - } else { - row <- paste0(row, '') - } - } - row <- paste0(row, '') - htmltable <<- paste(htmltable, row, sep='\n') - }) - htmltable <- paste(htmltable, '
Sync IDHostnameStatusLast', n, '
', x$sync_host_id, '', x$hostname, '', status[x$state+1], '', as.POSIXct(x$lastdump, origin = "1970-01-01", tz = "UTC"), '-', paste(format(now - when), 'ago'), '
', sep='\n') - htmltable <- paste(htmltable, '', sep='\n') - htmltable <- paste(htmltable, '', sep='\n') - write(htmltable, file=paste0(file_prefix, ".html"), append=FALSE) -} diff --git a/base/visualization/R/map.output.R b/base/visualization/R/map.output.R index 432ac59e0bc..53acfb44ad9 100644 --- a/base/visualization/R/map.output.R +++ b/base/visualization/R/map.output.R @@ -7,16 +7,24 @@ #' @author David LeBauer map.output <- function(table, variable) { if (any(table$lat < 0) | any(table$lon > 0)) { - world <- data.table(map_data("world")) + world <- data.table::data.table(ggplot2::map_data("world")) } else { - world <- data.table(map_data("usa")) + world <- data.table::data.table(ggplot2::map_data("usa")) } - map <- ggplot() + - geom_polygon(data = world, aes(x = long, y = lat, group = group), fill = "white", color = "darkgrey") + - geom_point(data = table, aes(x = lon, y = lat, color = table[, variable]), size = 5) + - scale_color_gradientn(colours = c("red", "orange", "yellow", "green", "blue", "violet")) + - theme_bw() + - xlim(range(pretty(table$lon))) + - ylim(range(pretty(table$lat))) + map <- ggplot2::ggplot() + + ggplot2::geom_polygon( + data = world, + ggplot2::aes(x = long, y = lat, group = group), + fill = "white", + color = "darkgrey") + + ggplot2::geom_point( + data = table, + ggplot2::aes(x = lon, y = lat, color = table[, variable]), + size = 5) + + ggplot2::scale_color_gradientn( + colours = c("red", "orange", "yellow", "green", "blue", "violet")) + + ggplot2::theme_bw() + + ggplot2::xlim(range(pretty(table$lon))) + + ggplot2::ylim(range(pretty(table$lat))) return(map) } # map.output diff --git a/base/visualization/R/plot.netcdf.R b/base/visualization/R/plot_netcdf.R similarity index 70% rename from base/visualization/R/plot.netcdf.R rename to base/visualization/R/plot_netcdf.R index 135831fff23..827f3748549 100644 --- a/base/visualization/R/plot.netcdf.R +++ b/base/visualization/R/plot_netcdf.R @@ -33,7 +33,7 @@ data.fetch <- function(var, nc, fun = mean) { # aggregate the data data <- ncdf4::ncvar_get(nc, var) - val <- aggregate(data[indices], by = aggrlist, FUN = fun)$x + val <- stats::aggregate(data[indices], by = aggrlist, FUN = fun)$x # get the label title <- nc$var[[var]]$longname @@ -59,24 +59,25 @@ data.fetch <- function(var, nc, fun = mean) { ##' Load the tower dataset and create a plot. ##' -##' \code{plot.hdf5} loads the tower data from an HDF5 file generated by +##' Loads the tower data from an HDF5 file generated by ##' ED and will plot the values against one another. The default is for ##' the given variable to be plotted against time. ##' -##' @name plot.hdf5 ##' @param datafile the specific datafile to use. ##' @param yvar the variable to plot along the y-axis. ##' @param xvar the variable to plot along the x-axis, by default time is ##' used. -##' @param the width of the image generated, default is 800 pixels. -##' @param the height of the image generated, default is 600 pixels. +##' @param width the width of the image generated, default is 800 pixels. +##' @param height the height of the image generated, default is 600 pixels. ##' @param filename is the name of the file name that is geneated, this ##' can be null to use existing device, otherwise it will try and -# @' create an image based on filename, or display if x11. +##' create an image based on filename, or display if x11. ##' @param year the year this data is for (only used in the title). +##' +##' @aliases plot.netcdf ##' @export ##' @author Rob Kooper -plot.netcdf <- function(datafile, yvar, xvar = "time", width = 800, height = 600, +plot_netcdf <- function(datafile, yvar, xvar = "time", width = 800, height = 600, filename = NULL, year = NULL) { # open netcdf file nc <- ncdf4::nc_open(datafile) @@ -90,33 +91,33 @@ plot.netcdf <- function(datafile, yvar, xvar = "time", width = 800, height = 600 # setup output if (!is.null(filename)) { if (tolower(filename) == "x11") { - x11(width = width / 96, height = height / 96) + grDevices::x11(width = width / 96, height = height / 96) } else if (tolower(stringr::str_sub(filename, -4)) == ".png") { - png(filename = filename, width = width, height = height) + grDevices::png(filename = filename, width = width, height = height) } else if (tolower(stringr::str_sub(filename, -4)) == ".pdf") { - pdf(filename = filename, width = width, height = height) + grDevices::pdf(file = filename, width = width, height = height) } else if (tolower(stringr::str_sub(filename, -4)) == ".jpg") { - jpg(filename = filename, width = width, height = height) + grDevices::jpeg(filename = filename, width = width, height = height) } else if (tolower(stringr::str_sub(filename, -5)) == ".tiff") { - tiff(filename = filename, width = width, height = height) + grDevices::tiff(filename = filename, width = width, height = height) } } # setup plot (needs to be done before removing of NA since that removes attr as well). - plot.new() - title(xlab = attr(xval_mean, "lbl")) - title(ylab = attr(yval_mean, "lbl")) + graphics::plot.new() + graphics::title(xlab = attr(xval_mean, "lbl")) + graphics::title(ylab = attr(yval_mean, "lbl")) if (xvar == "time") { if (is.null(year)) { - title(main = nc$var[[yvar]]$longname) + graphics::title(main = nc$var[[yvar]]$longname) } else { - title(main = paste(nc$var[[yvar]]$longname, "for", year)) + graphics::title(main = paste(nc$var[[yvar]]$longname, "for", year)) } } else { if (is.null(year)) { - title(main = paste(xvar, "VS", yvar)) + graphics::title(main = paste(xvar, "VS", yvar)) } else { - title(main = paste(xvar, "VS", yvar, "for", year)) + graphics::title(main = paste(xvar, "VS", yvar, "for", year)) } } # done with netcdf file @@ -139,29 +140,35 @@ plot.netcdf <- function(datafile, yvar, xvar = "time", width = 800, height = 600 o <- order(xval_mean, yval_mean) # plot actual data - plot.window(xlim = c(min(xval_mean), max(xval_mean)), + graphics::plot.window(xlim = c(min(xval_mean), max(xval_mean)), ylim = c(min(yvals), max(yvals))) - polygon(c(xval_mean[o], rev(xval_mean[o])), - c(yval_max[o], rev(yval_min[o])), - col = "gray", - border = "black") - lines(x = xval_mean[o], y = yval_mean[o], col = "red") - points(x = xval_mean[o], y = yval_mean[o], col = "black", pch = ".", cex = 5) - + graphics::polygon( + c(xval_mean[o], rev(xval_mean[o])), + c(yval_max[o], rev(yval_min[o])), + col = "gray", + border = "black") + graphics::lines(x = xval_mean[o], y = yval_mean[o], col = "red") + graphics::points( + x = xval_mean[o], + y = yval_mean[o], + col = "black", + pch = ".", + cex = 5) + # legend - legend("bottomright", col = c(1, "gray"), lwd = c(3, 6), - legend = c("mean", "min/max"), + graphics::legend("bottomright", col = c(1, "gray"), lwd = c(3, 6), + legend = c("mean", "min/max"), cex = 1.5) - + # draw axis and box - axis(1) - axis(2) - box() - + graphics::axis(1) + graphics::axis(2) + graphics::box() + ## add PEcAn icon add_icon() - + if (!is.null(filename) && (tolower(filename) != "x11")) { - dev.off() + grDevices::dev.off() } -} # plot.netcdf +} # plot_netcdf diff --git a/base/utils/R/plots.R b/base/visualization/R/plots.R similarity index 87% rename from base/utils/R/plots.R rename to base/visualization/R/plots.R index d70cffd2db3..bf6aa9a8b89 100644 --- a/base/utils/R/plots.R +++ b/base/visualization/R/plots.R @@ -23,7 +23,7 @@ ##' @param eps used to set artificial bound on min width / max height of bins as described in Denby and Mallows (2009) on page 24. ##' @param xlab is label for the x axis ##' @param plot = TRUE produces the plot, FALSE returns the heights, breaks and counts -##' @param lab.spikes = TRUE labels the \% of data in the spikes +##' @param lab.spikes = TRUE labels the % of data in the spikes ##' @return list with two elements, heights of length n and breaks of length n+1 indicating the heights and break points of the histogram bars. ##' @author Lorraine Denby, Colin Mallows ##' @references Lorraine Denby, Colin Mallows. Journal of Computational and Graphical Statistics. March 1, 2009, 18(1): 21-31. doi:10.1198/jcgs.2009.0002. @@ -181,47 +181,30 @@ iqr <- function(x) { } # iqr -##' Creates empty ggplot object -##' -##' An empty base plot to which layers created by other functions -##' (\code{\link{plot_data}}, \code{\link{plot.prior.density}}, -##' \code{\link{plot.posterior.density}}) can be added. -##' @name create.base.plot -##' @title Create Base Plot -##' @return empty ggplot object -##' @export -##' @author David LeBauer -create.base.plot <- function() { - need_packages("ggplot2") - base.plot <- ggplot2::ggplot() - return(base.plot) -} # create.base.plot - ##--------------------------------------------------------------------------------------------------# -##' Add data to an existing plot or create a new one from \code{\link{create.base.plot}} +##' Add data to an existing plot or create a new one ##' ##' Used to add raw data or summary statistics to the plot of a distribution. ##' The height of Y is arbitrary, and can be set to optimize visualization. -##' If SE estimates are available, tehse wil be plotted +##' If SE estimates are available, the se wil be plotted ##' @name plot_data ##' @aliases plot.data ##' @title Add data to plot ##' @param trait.data data to be plotted ##' @param base.plot a ggplot object (grob), -##' created by \code{\link{create.base.plot}} if none provided +##' created if none provided ##' @param ymax maximum height of y -##' @seealso \code{\link{create.base.plot}} ##' @return updated plot object ##' @author David LeBauer -##' @export plot_data +##' @export +##' @importFrom rlang .data ##' @examples ##' \dontrun{plot_data(data.frame(Y = c(1, 2), se = c(1,2)), base.plot = NULL, ymax = 10)} -plot_data <- function(trait.data, base.plot = NULL, ymax, color = "black") { - need_packages("ggplot2") +plot_data <- function(trait.data, base.plot = NULL, ymax) { if (is.null(base.plot)) { - base.plot <- create.base.plot() + base.plot <- ggplot2::ggplot() } n.pts <- nrow(trait.data) @@ -243,9 +226,15 @@ plot_data <- function(trait.data, base.plot = NULL, ymax, color = "black") { se = trait.data$se, control = !trait.data$trt == 1 & trait.data$ghs == 1) new.plot <- base.plot + - ggplot2::geom_point(data = plot.data, ggplot2::aes(x = x, y = y, color = control)) + - ggplot2::geom_segment(data = plot.data, - ggplot2::aes(x = x - se, y = y, xend = x + se, yend = y, color = control)) + + ggplot2::geom_point( + data = plot.data, + ggplot2::aes(x = .data$x, y = .data$y, color = .data$control)) + + ggplot2::geom_segment( + data = plot.data, + ggplot2::aes( + x = .data$x - .data$se, y = .data$y, + xend = .data$x + .data$se, yend = .data$y, + color = .data$control)) + ggplot2::scale_color_manual(values = c("black", "grey")) + ggplot2::theme(legend.position = "none") return(new.plot) @@ -256,15 +245,18 @@ plot_data <- function(trait.data, base.plot = NULL, ymax, color = "black") { ##' Add borders to plot ##' ##' Has ggplot2 display only specified borders, e.g. ('L'-shaped) borders, -##' rather than a rectangle or no border. Note that the order can be significant; -##' for example, if you specify the L border option and then a theme, the theme settings -##' will override the border option, so you need to specify the theme (if any) before the border option, as above. +##' rather than a rectangle or no border. +##' Note that the order can be significant; +##' for example, if you specify the L border option and then a theme, +##' the theme settings will override the border option, +##' so you need to specify the theme (if any) before the border option, +##' as above. ##' @name theme_border ##' @title Theme border for plot -##' @param type -##' @param colour -##' @param size -##' @param linetype +##' @param type border(s) to display +##' @param colour what colo(u)r should the border be +##' @param size relative line thickness +##' @param linetype "solid", "dashed", etc ##' @return adds borders to ggplot as a side effect ##' @author Rudolf Cardinal ##' @author \url{ggplot2 google group}{https://groups.google.com/forum/?fromgroups#!topic/ggplot2/-ZjRE2OL8lE} diff --git a/base/visualization/R/visually.weighted.watercolor.plots.R b/base/visualization/R/visually.weighted.watercolor.plots.R index ee68d7f0260..d224e8b2ab5 100644 --- a/base/visualization/R/visually.weighted.watercolor.plots.R +++ b/base/visualization/R/visually.weighted.watercolor.plots.R @@ -42,6 +42,10 @@ ##' \url{http://www.nicebread.de/visually-weighted-watercolor-plots-new-variants-please-vote/} ##' ##' @title PEcAn worldmap +##' +##' @param formula variables to plot. See examples +##' @param data data frame containing all variables used in formula +##' @param title passed on to ggplot ##' @param B = number bootstrapped smoothers ##' @param shade plot the shaded confidence region? ##' @param shade.alpha should the CI shading fade out at the edges? (by reducing alpha; 0 = no alpha decrease, 0.1 = medium alpha decrease, 0.5 = strong alpha decrease) @@ -49,7 +53,7 @@ ##' @param spag.color color of spaghetti lines ##' @param mweight should the median smoother be visually weighted? ##' @param show.lm should the linear regresison line be plotted? -##' @param show.CI should the 95\% CI limits be plotted? +##' @param show.CI should the 95% CI limits be plotted? ##' @param show.median should the median smoother be plotted? ##' @param median.col color of the median smoother ##' @param shape shape of points @@ -84,15 +88,15 @@ vwReg <- function(formula, data, title = "", B = 1000, shade = TRUE, shade.alpha = 0.1, spag = FALSE, spag.color = "darkblue", mweight = TRUE, show.lm = FALSE, show.median = TRUE, median.col = "white", shape = 21, show.CI = FALSE, - method = loess, bw = FALSE, slices = 200, - palette = colorRampPalette(c("#FFEDA0", "#DD0000"), bias = 2)(20), + method = stats::loess, bw = FALSE, slices = 200, + palette = grDevices::colorRampPalette(c("#FFEDA0", "#DD0000"), bias = 2)(20), ylim = NULL, quantize = "continuous", add = FALSE, ...) { IV <- all.vars(formula)[2] DV <- all.vars(formula)[1] - data <- na.omit(data[order(data[, IV]), c(IV, DV)]) + data <- stats::na.omit(data[order(data[, IV]), c(IV, DV)]) if (bw) { - palette <- colorRampPalette(c("#EEEEEE", "#999999", "#333333"), bias = 2)(20) + palette <- grDevices::colorRampPalette(c("#EEEEEE", "#999999", "#333333"), bias = 2)(20) } print("Computing boostrapped smoothers ...") @@ -104,21 +108,28 @@ vwReg <- function(formula, data, title = "", B = 1000, shade = TRUE, shade.alpha for (i in seq_len(B)) { data2 <- data[sample(nrow(data), replace = TRUE), ] data2 <- data2[order(data2[, IV]), ] - if (class(l0) == "loess") { - m1 <- method(formula, data2, control = loess.control(surface = "i", - statistics = "a", - trace.hat = "a"), ...) + if (inherits(l0, "loess")) { + m1 <- method( + formula, + data2, + control = stats::loess.control( + surface = "i", + statistics = "a", + trace.hat = "a"), + ...) } else { m1 <- method(formula, data2, ...) } - l0.boot[, i] <- predict(m1, newdata = newx) + l0.boot[, i] <- stats::predict(m1, newdata = newx) } # compute median and CI limits of bootstrap CI.boot <- plyr::adply(l0.boot, 1, function(x) { - quantile(x, prob = c(0.025, 0.5, 0.975, - pnorm(c(-3, -2, -1, 0, 1, 2, 3))), - na.rm = TRUE) + stats::quantile( + x, + prob = c(0.025, 0.5, 0.975, + stats::pnorm(c(-3, -2, -1, 0, 1, 2, 3))), + na.rm = TRUE) })[, -1] colnames(CI.boot)[1:10] <- c("LL", "M", "UL", paste0("SD", 1:7)) CI.boot$x <- newx[, 1] @@ -137,7 +148,7 @@ vwReg <- function(formula, data, title = "", B = 1000, shade = TRUE, shade.alpha # an existing ggplot # if add == FALSE: provide the basic ggplot object - p0 <- ggplot(data, aes_string(x = IV, y = DV)) + theme_bw() + p0 <- ggplot2::ggplot(data, ggplot2::aes_string(x = IV, y = DV)) + ggplot2::theme_bw() # initialize elements with NULL (if they are defined, they are overwritten with something # meaningful) @@ -147,8 +158,8 @@ vwReg <- function(formula, data, title = "", B = 1000, shade = TRUE, shade.alpha quantize <- match.arg(quantize, c("continuous", "SD")) if (quantize == "continuous") { print("Computing density estimates for each vertical cut ...") - flush.console() - + utils::flush.console() + if (is.null(ylim)) { min_value <- min(min(l0.boot, na.rm = TRUE), min(data[, DV], na.rm = TRUE)) max_value <- max(max(l0.boot, na.rm = TRUE), max(data[, DV], na.rm = TRUE)) @@ -157,12 +168,12 @@ vwReg <- function(formula, data, title = "", B = 1000, shade = TRUE, shade.alpha # vertical cross-sectional density estimate d2 <- plyr::ddply(b2[, c("x", "value")], "x", function(df) { - res <- data.frame(density(df$value, + res <- data.frame(stats::density(df$value, na.rm = TRUE, n = slices, from = ylim[1], to = ylim[2])[c("x", "y")]) - # res <- data.frame(density(df$value, na.rm=TRUE, n=slices)[c('x', 'y')]) + # res <- data.frame(stats::density(df$value, na.rm=TRUE, n=slices)[c('x', 'y')]) colnames(res) <- c("y", "dens") return(res) }, .progress = "text") @@ -173,9 +184,12 @@ vwReg <- function(formula, data, title = "", B = 1000, shade = TRUE, shade.alpha ## Tile approach d2$alpha.factor <- d2$dens.scaled^shade.alpha - gg.tiles <- list(geom_tile(data = d2, aes(x = x, y = y, fill = dens.scaled, alpha = alpha.factor)), - scale_fill_gradientn("dens.scaled", colours = palette), - scale_alpha_continuous(range = c(0.001, 1))) + gg.tiles <- list( + ggplot2::geom_tile( + data = d2, + ggplot2::aes(x = x, y = y, fill = dens.scaled, alpha = alpha.factor)), + ggplot2::scale_fill_gradientn("dens.scaled", colours = palette), + ggplot2::scale_alpha_continuous(range = c(0.001, 1))) } if (quantize == "SD") { ## Polygon approach @@ -194,63 +208,67 @@ vwReg <- function(formula, data, title = "", B = 1000, shade = TRUE, shade.alpha d3 <- rbind(d3, seg) } - gg.poly <- list(geom_polygon(data = d3, - aes(x = x, y = value, color = NULL, fill = col, group = group)), - scale_fill_gradientn("dens.scaled", colours = palette, values = seq(-1, 3, 1))) + gg.poly <- list( + ggplot2::geom_polygon(data = d3, ggplot2::aes(x = x, y = value, color = NULL, fill = col, group = group)), + ggplot2::scale_fill_gradientn("dens.scaled", colours = palette, values = seq(-1, 3, 1))) } } print("Build ggplot figure ...") - flush.console() + utils::flush.console() if (spag) { - gg.spag <- geom_path(data = b2, - aes(x = x, y = value, group = B), - size = 0.7, - alpha = 10 / B, - color = spag.color) + gg.spag <- ggplot2::geom_path( + data = b2, + ggplot2::aes(x = x, y = value, group = B), + size = 0.7, + alpha = 10 / B, + color = spag.color) } if (show.median) { if (mweight) { - gg.median <- geom_path(data = CI.boot, - aes(x = x, y = M, alpha = w3 ^ 3), - size = 0.6, - linejoin = "mitre", - color = median.col) + gg.median <- ggplot2::geom_path( + data = CI.boot, + ggplot2::aes(x = x, y = M, alpha = w3 ^ 3), + size = 0.6, + linejoin = "mitre", + color = median.col) } else { - gg.median <- geom_path(data = CI.boot, - aes(x = x, y = M), - size = 0.6, - linejoin = "mitre", - color = median.col) + gg.median <- ggplot2::geom_path( + data = CI.boot, + ggplot2::aes(x = x, y = M), + size = 0.6, + linejoin = "mitre", + color = median.col) } } # Confidence limits if (show.CI) { - gg.CI1 <- geom_path(data = CI.boot, aes(x = x, y = UL), size = 1, color = "red") - gg.CI2 <- geom_path(data = CI.boot, aes(x = x, y = LL), size = 1, color = "red") + gg.CI1 <- ggplot2::geom_path(data = CI.boot, ggplot2::aes(x = x, y = UL), size = 1, color = "red") + gg.CI2 <- ggplot2::geom_path(data = CI.boot, ggplot2::aes(x = x, y = LL), size = 1, color = "red") } # plain linear regression line if (show.lm) { - gg.lm <- geom_smooth(method = "lm", color = "darkgreen", se = FALSE) + gg.lm <- ggplot2::geom_smooth(method = "lm", color = "darkgreen", se = FALSE) } - gg.points <- geom_point(data = data, - aes_string(x = IV, y = DV), - size = 1, - shape = shape, - fill = "white", - color = "black") + gg.points <- ggplot2::geom_point( + data = data, + ggplot2::aes_string(x = IV, y = DV), + size = 1, + shape = shape, + fill = "white", + color = "black") if (title != "") { - gg.title <- theme(title = title) + gg.title <- ggplot2::theme(title = title) } - gg.elements <- list(gg.tiles, gg.poly, gg.spag, gg.median, gg.CI1, gg.CI2, - gg.lm, gg.points, gg.title, theme(legend.position = "none")) + gg.elements <- list(gg.tiles, gg.poly, gg.spag, gg.median, gg.CI1, gg.CI2, + gg.lm, gg.points, gg.title, ggplot2::theme(legend.position = "none")) if (!add) { return(p0 + gg.elements) diff --git a/base/visualization/man/ciEnvelope.Rd b/base/visualization/man/ciEnvelope.Rd index 69f6aa0bc6a..fd227771b2c 100644 --- a/base/visualization/man/ciEnvelope.Rd +++ b/base/visualization/man/ciEnvelope.Rd @@ -12,6 +12,8 @@ ciEnvelope(x, ylo, yhi, ...) \item{ylo}{Vector defining bottom of CI envelope} \item{yhi}{Vector defining top of CI envelope} + +\item{...}{further arguments passed on to \code{graphics::polygon}} } \description{ plots a confidence interval around an x-y plot (e.g. a timeseries) diff --git a/base/visualization/man/create_status_page.Rd b/base/visualization/man/create_status_page.Rd deleted file mode 100644 index b329c960897..00000000000 --- a/base/visualization/man/create_status_page.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_status_page.R -\name{create_status_page} -\alias{create_status_page} -\title{Create PEcAn Network status page.} -\usage{ -create_status_page(config_file, file_prefix = "status", delta = 3600) -} -\arguments{ -\item{config_file}{Path to `config.php`} - -\item{file_prefix}{prefix used for all files saved} - -\item{delta}{number of seconds before} -} -\description{ -This will create a webpage (file_prefix.html) as well as an image -(file_prefix.png) that shows the PEcAn Network satus. This will -save the geo location of each site as well as some additional -information in a cache file (file_prefix.RData). If an update to -the BETY schema is detected it will be logged in a file -(file_prefix.log). -} -\examples{ -\dontrun{ - create_status_page('/home/carya/pecan/web/config.php') -} -} -\author{ -Michael Dietze - -Rob Kooper -} diff --git a/base/utils/man/dhist.Rd b/base/visualization/man/dhist.Rd similarity index 91% rename from base/utils/man/dhist.Rd rename to base/visualization/man/dhist.Rd index e3131f4981e..f591adcee32 100644 --- a/base/utils/man/dhist.Rd +++ b/base/visualization/man/dhist.Rd @@ -4,9 +4,16 @@ \alias{dhist} \title{Diagonally Cut Histogram} \usage{ -dhist(x, a = 5 * iqr(x), nbins = grDevices::nclass.Sturges(x), - rx = range(x, na.rm = TRUE), eps = 0.15, xlab = "x", plot = TRUE, - lab.spikes = TRUE) +dhist( + x, + a = 5 * iqr(x), + nbins = grDevices::nclass.Sturges(x), + rx = range(x, na.rm = TRUE), + eps = 0.15, + xlab = "x", + plot = TRUE, + lab.spikes = TRUE +) } \arguments{ \item{x}{is a numeric vector (the data)} diff --git a/base/utils/man/iqr.Rd b/base/visualization/man/iqr.Rd similarity index 100% rename from base/utils/man/iqr.Rd rename to base/visualization/man/iqr.Rd diff --git a/base/utils/man/plot_data.Rd b/base/visualization/man/plot_data.Rd similarity index 67% rename from base/utils/man/plot_data.Rd rename to base/visualization/man/plot_data.Rd index 77244f9e858..6738c18b789 100644 --- a/base/utils/man/plot_data.Rd +++ b/base/visualization/man/plot_data.Rd @@ -5,13 +5,13 @@ \alias{plot.data} \title{Add data to plot} \usage{ -plot_data(trait.data, base.plot = NULL, ymax, color = "black") +plot_data(trait.data, base.plot = NULL, ymax) } \arguments{ \item{trait.data}{data to be plotted} \item{base.plot}{a ggplot object (grob), -created by \code{\link{create.base.plot}} if none provided} +created if none provided} \item{ymax}{maximum height of y} } @@ -19,19 +19,16 @@ created by \code{\link{create.base.plot}} if none provided} updated plot object } \description{ -Add data to an existing plot or create a new one from \code{\link{create.base.plot}} +Add data to an existing plot or create a new one } \details{ Used to add raw data or summary statistics to the plot of a distribution. The height of Y is arbitrary, and can be set to optimize visualization. -If SE estimates are available, tehse wil be plotted +If SE estimates are available, the se wil be plotted } \examples{ \dontrun{plot_data(data.frame(Y = c(1, 2), se = c(1,2)), base.plot = NULL, ymax = 10)} } -\seealso{ -\code{\link{create.base.plot}} -} \author{ David LeBauer } diff --git a/base/visualization/man/plot.hdf5.Rd b/base/visualization/man/plot_netcdf.Rd similarity index 54% rename from base/visualization/man/plot.hdf5.Rd rename to base/visualization/man/plot_netcdf.Rd index 8d0dbea22d1..391e5a34b68 100644 --- a/base/visualization/man/plot.hdf5.Rd +++ b/base/visualization/man/plot_netcdf.Rd @@ -1,12 +1,19 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot.netcdf.R -\name{plot.hdf5} -\alias{plot.hdf5} +% Please edit documentation in R/plot_netcdf.R +\name{plot_netcdf} +\alias{plot_netcdf} \alias{plot.netcdf} \title{Load the tower dataset and create a plot.} \usage{ -plot.netcdf(datafile, yvar, xvar = "time", width = 800, height = 600, - filename = NULL, year = NULL) +plot_netcdf( + datafile, + yvar, + xvar = "time", + width = 800, + height = 600, + filename = NULL, + year = NULL +) } \arguments{ \item{datafile}{the specific datafile to use.} @@ -16,17 +23,18 @@ plot.netcdf(datafile, yvar, xvar = "time", width = 800, height = 600, \item{xvar}{the variable to plot along the x-axis, by default time is used.} -\item{filename}{is the name of the file name that is geneated, this -can be null to use existing device, otherwise it will try and} +\item{width}{the width of the image generated, default is 800 pixels.} -\item{year}{the year this data is for (only used in the title).} +\item{height}{the height of the image generated, default is 600 pixels.} -\item{the}{width of the image generated, default is 800 pixels.} +\item{filename}{is the name of the file name that is geneated, this +can be null to use existing device, otherwise it will try and +create an image based on filename, or display if x11.} -\item{the}{height of the image generated, default is 600 pixels.} +\item{year}{the year this data is for (only used in the title).} } \description{ -\code{plot.hdf5} loads the tower data from an HDF5 file generated by +Loads the tower data from an HDF5 file generated by ED and will plot the values against one another. The default is for the given variable to be plotted against time. } diff --git a/base/utils/man/theme_border.Rd b/base/visualization/man/theme_border.Rd similarity index 63% rename from base/utils/man/theme_border.Rd rename to base/visualization/man/theme_border.Rd index cd8d23a63f2..39027f06022 100644 --- a/base/utils/man/theme_border.Rd +++ b/base/visualization/man/theme_border.Rd @@ -4,17 +4,21 @@ \alias{theme_border} \title{Theme border for plot} \usage{ -theme_border(type = c("left", "right", "bottom", "top", "none"), - colour = "black", size = 1, linetype = 1) +theme_border( + type = c("left", "right", "bottom", "top", "none"), + colour = "black", + size = 1, + linetype = 1 +) } \arguments{ -\item{type}{} +\item{type}{border(s) to display} -\item{colour}{} +\item{colour}{what colo(u)r should the border be} -\item{size}{} +\item{size}{relative line thickness} -\item{linetype}{} +\item{linetype}{"solid", "dashed", etc} } \value{ adds borders to ggplot as a side effect @@ -24,9 +28,12 @@ Add borders to plot } \details{ Has ggplot2 display only specified borders, e.g. ('L'-shaped) borders, -rather than a rectangle or no border. Note that the order can be significant; -for example, if you specify the L border option and then a theme, the theme settings -will override the border option, so you need to specify the theme (if any) before the border option, as above. +rather than a rectangle or no border. +Note that the order can be significant; +for example, if you specify the L border option and then a theme, +the theme settings will override the border option, +so you need to specify the theme (if any) before the border option, +as above. } \examples{ \dontrun{ diff --git a/base/visualization/man/vwReg.Rd b/base/visualization/man/vwReg.Rd index df80557e600..c7d9649899a 100644 --- a/base/visualization/man/vwReg.Rd +++ b/base/visualization/man/vwReg.Rd @@ -4,15 +4,38 @@ \alias{vwReg} \title{PEcAn worldmap} \usage{ -vwReg(formula, data, title = "", B = 1000, shade = TRUE, - shade.alpha = 0.1, spag = FALSE, spag.color = "darkblue", - mweight = TRUE, show.lm = FALSE, show.median = TRUE, - median.col = "white", shape = 21, show.CI = FALSE, - method = loess, bw = FALSE, slices = 200, - palette = colorRampPalette(c("#FFEDA0", "#DD0000"), bias = 2)(20), - ylim = NULL, quantize = "continuous", add = FALSE, ...) +vwReg( + formula, + data, + title = "", + B = 1000, + shade = TRUE, + shade.alpha = 0.1, + spag = FALSE, + spag.color = "darkblue", + mweight = TRUE, + show.lm = FALSE, + show.median = TRUE, + median.col = "white", + shape = 21, + show.CI = FALSE, + method = stats::loess, + bw = FALSE, + slices = 200, + palette = (grDevices::colorRampPalette(c("#FFEDA0", "#DD0000"), bias = 2))(20), + ylim = NULL, + quantize = "continuous", + add = FALSE, + ... +) } \arguments{ +\item{formula}{variables to plot. See examples} + +\item{data}{data frame containing all variables used in formula} + +\item{title}{passed on to ggplot} + \item{B}{= number bootstrapped smoothers} \item{shade}{plot the shaded confidence region?} diff --git a/base/visualization/tests/Rcheck_reference.log b/base/visualization/tests/Rcheck_reference.log new file mode 100644 index 00000000000..4dd9386fe95 --- /dev/null +++ b/base/visualization/tests/Rcheck_reference.log @@ -0,0 +1,84 @@ +* using log directory ‘/tmp/RtmpP8kDnH/PEcAn.visualization.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.visualization/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.visualization’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.visualization’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... OK +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... OK +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +map.output: no visible binding for global variable ‘long’ +map.output: no visible binding for global variable ‘lat’ +map.output: no visible binding for global variable ‘group’ +map.output: no visible binding for global variable ‘lon’ +vwReg: no visible binding for global variable ‘x’ +vwReg: no visible binding for global variable ‘y’ +vwReg: no visible binding for global variable ‘dens.scaled’ +vwReg: no visible binding for global variable ‘alpha.factor’ +vwReg: no visible binding for global variable ‘value’ +vwReg: no visible binding for global variable ‘group’ +vwReg: no visible binding for global variable ‘M’ +vwReg: no visible binding for global variable ‘w3’ +vwReg: no visible binding for global variable ‘UL’ +vwReg: no visible binding for global variable ‘LL’ +Undefined global functions or variables: + alpha.factor dens.scaled group lat LL lon long M UL value w3 x y +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... WARNING +Undocumented data sets: + ‘counties’ ‘yielddf’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... OK +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking contents of ‘data’ directory ... OK +* checking data for non-ASCII characters ... OK +* checking data for ASCII and uncompressed saves ... OK +* checking files in ‘vignettes’ ... WARNING +Files in the 'vignettes' directory but no files in 'inst/doc': + ‘usmap.Rmd’ +Package has no Sweave vignette sources and no VignetteBuilder field. +* checking examples ... OK +Examples with CPU or elapsed time > 5s + user system elapsed +vwReg 11.31 0.1 11.486 +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 2 WARNINGs, 1 NOTE diff --git a/base/workflow/DESCRIPTION b/base/workflow/DESCRIPTION index efc4ada01a1..ce65d898eb4 100644 --- a/base/workflow/DESCRIPTION +++ b/base/workflow/DESCRIPTION @@ -2,8 +2,8 @@ Package: PEcAn.workflow Type: Package Title: PEcAn functions used for ecological forecasts and reanalysis -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("David","LeBauer"), person("Xiaohui", "Feng"), @@ -22,8 +22,9 @@ Description: The Predictive Ecosystem Carbon Analyzer models, and to improve the efficacy of scientific investigation. This package provides workhorse functions that can be used to run the major steps of a PEcAn analysis. -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Imports: + dplyr, PEcAn.data.atmosphere, PEcAn.data.land, PEcAn.DB, @@ -32,10 +33,11 @@ Imports: PEcAn.settings, PEcAn.uncertainty, PEcAn.utils, + purrr (>= 0.2.3), XML Suggests: testthat, mockery Copyright: Authors Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/base/workflow/NAMESPACE b/base/workflow/NAMESPACE index 90f6c8fcbb0..fd5e0cc56a7 100644 --- a/base/workflow/NAMESPACE +++ b/base/workflow/NAMESPACE @@ -1,6 +1,10 @@ # Generated by roxygen2: do not edit by hand +export(create_execute_test_xml) export(do_conversions) +export(model_specific_tags) export(run.write.configs) export(runModule.get.trait.data) export(runModule.run.write.configs) +importFrom(dplyr,"%>%") +importFrom(dplyr,.data) diff --git a/base/workflow/R/create_execute_test_xml.R b/base/workflow/R/create_execute_test_xml.R new file mode 100644 index 00000000000..aacb05d8b08 --- /dev/null +++ b/base/workflow/R/create_execute_test_xml.R @@ -0,0 +1,193 @@ +#' Create a PEcAn XML file and use it to run a PEcAn workflow +#' +#' @param model_id (numeric) Model ID (from `models` table) +#' @param met (character) Name of meteorology input source (e.g. `"CRUNCEP"`) +#' @param site_id (numeric) Site ID (from `sites` table) +#' @param start_date (character or date) Run start date +#' @param end_date (character or date) Run end date +#' @param dbfiles_folder (character) Path to `dbfiles` directory +#' @param user_id (numeric) User ID to associate with the workflow +#' @param output_folder (character) Path to root directory for storing outputs. +#' Default = `"batch_test_output"` +#' @param pecan_path (character) Path to PEcAn source code. Default is current +#' working directory. +#' @param pft (character) Name of PFT to run. If `NULL` (default), use the first +#' PFT in BETY associated with the model. +#' @param ensemble_size (numeric) Number of ensembles to run. Default = 1. +#' @param sensitivity_variable (character) Variable for performing sensitivity +#' analysis. Default = `"NPP"` +#' @param sensitivity (logical) Whether or not to perform a sensitivity analysis +#' (default = `FALSE`) +#' @param db_bety_username,db_bety_password,db_bety_hostname,db_bety_port +#' (character) BETY database connection options. Default values for all of +#' these are pulled from `/web/config.php`. +#' @param db_bety_driver (character) BETY database connection driver (default = `"Postgres"`) +#' @return A list with two entries: +#' * `sys`: Exit value returned by the workflow (0 for sucess). +#' * `outdir`: Path where the workflow results are saved +#' @author Alexey Shiklomanov, Tony Gardella +#' @importFrom dplyr %>% .data +#' @export +create_execute_test_xml <- function(model_id, + met, + site_id, + start_date, + end_date, + dbfiles_folder, + user_id, + output_folder = "batch_test_output", + pecan_path = getwd(), + pft = NULL, + ensemble_size = 1, + sensitivity_variable = "NPP", + sensitivity = FALSE, + db_bety_username = NULL, + db_bety_password = NULL, + db_bety_hostname = NULL, + db_bety_port = NULL, + db_bety_driver = "Postgres") { + + php_file <- file.path(pecan_path, "web", "config.php") + config.list <- PEcAn.utils::read_web_config(php_file) + if (is.null(db_bety_username)) db_bety_username <- config.list$db_bety_username + if (is.null(db_bety_password)) db_bety_password <- config.list$db_bety_password + if (is.null(db_bety_hostname)) db_bety_hostname <- config.list$db_bety_hostname + if (is.null(db_bety_port)) db_bety_port <- config.list$db_bety_port + + #opening a connection to bety + con <- PEcAn.DB::db.open(list( + user = db_bety_username, + password = db_bety_password, + host = db_bety_hostname, + port = db_bety_port, + driver = db_bety_driver + )) + on.exit(PEcAn.DB::db.close(con), add = TRUE) + + settings <- list( + info = list(notes = "Test_Run", + userid = user_id, + username = "None", + dates = Sys.Date()) + ) + + #Outdir + model.new <- dplyr::tbl(con, "models") %>% + dplyr::filter(.data$id == !!model_id) %>% + dplyr::collect() + + outdir_pre <- paste( + model.new[["model_name"]], + format(as.Date(start_date), "%Y-%m"), + format(as.Date(end_date), "%Y-%m"), + met, site_id, "test_runs", + sep = "_" + ) + outdir <- file.path(output_folder, outdir_pre) + dir.create(outdir, showWarnings = FALSE, recursive = TRUE) + # Convert to absolute path so I don't end up with unnecessary nested + # directories + outdir <- normalizePath(outdir) + settings$outdir <- outdir + + #Database BETY + settings$database <- list( + bety = list(user = db_bety_username, + password = db_bety_password, + host = db_bety_hostname, + dbname = "bety", + driver = db_bety_driver, + write = FALSE), + dbfiles = dbfiles_folder + ) + + #PFT + if (is.null(pft)){ + # Select the first PFT in the model list. + pft <- dplyr::tbl(con, "pfts") %>% + dplyr::filter(.data$modeltype_id == !!model.new$modeltype_id) %>% + dplyr::collect() + + pft <- pft$name[[1]] + message("PFT is `NULL`. Defaulting to the following PFT: ", + pft) + } + + ## Putting multiple PFTs separated by semicolon + settings$pfts <- strsplit(pft, ";")[[1]] %>% + purrr::map( ~ list(name = .x, + constants = list(num = 1) + ) + ) %>% + stats::setNames(rep("pft", length(.data))) + + #Meta Analysis + settings$meta.analysis <- list(iter = 3000, random.effects = FALSE) + + #Ensemble + settings$ensemble <- list( + size = ensemble_size, + variable = sensitivity_variable, + samplingspace = list(met = list(method = "sampling"), + parameters = list(method = "uniform")) + ) + + #Sensitivity + if (sensitivity) { + settings$sensitivity.analysis <- list( + quantiles = list(sigma1 = -2, sigma2 = -1, sigma3 = 1, sigma4 = 2) + ) + } + + #Model + settings$model$id <- model.new[["id"]] + + #Workflow + settings$workflow$id + settings$workflow$id <- paste0("Test_run_","_",model.new$model_name) + settings$run <- list( + site = list(id = site_id, met.start = start_date, met.end = end_date), + inputs = list(met = list(source = met, output = model.new[["model_name"]], + username = "pecan")), + start.date = start_date, end.date = end_date + ) + settings$host$name <- "localhost" + + + # Add model specific options + settings<-model_specific_tags(settings, model.new) + #create file and Run + XML::saveXML(PEcAn.settings::listToXml(settings, "pecan"), + file = file.path(outdir, "pecan.xml")) + file.copy(file.path(pecan_path, "web", "workflow.R"), outdir) + cwd <- getwd() + setwd(outdir) + on.exit(setwd(cwd), add = TRUE) + + sys_out <- system("Rscript workflow.R 2>&1 | tee workflow.Rout") + + list( + sys = sys_out, + outdir = outdir + ) +} + +#' model_specific_tags +#' +#' @param settings pecan xml settings +#' @param model.info model info extracted from bety +#' +#' @return updated settings list +#' @export +#' +model_specific_tags <- function(settings, model.info){ + + #some extra settings for LPJ-GUESS + if(model.info$model_name=="LPJ-GUESS"){ + settings$run$inputs <- c(settings$run$inputs , + list(soil=list(id=1000000903)) + ) + } + + return(settings) +} diff --git a/base/workflow/R/run.write.configs.R b/base/workflow/R/run.write.configs.R index 7b02ba600d0..795a45fab77 100644 --- a/base/workflow/R/run.write.configs.R +++ b/base/workflow/R/run.write.configs.R @@ -26,15 +26,22 @@ run.write.configs <- function(settings, write = TRUE, ens.sample.method = "unifo posterior.files = rep(NA, length(settings$pfts)), overwrite = TRUE) { - con <- PEcAn.DB::db.open(settings$database$bety) - on.exit(PEcAn.DB::db.close(con)) - ## Which posterior to use? for (i in seq_along(settings$pfts)) { ## if posterior.files is specified us that if (is.na(posterior.files[i])) { ## otherwise, check to see if posteriorid exists if (!is.null(settings$pfts[[i]]$posteriorid)) { + + tryCatch({ + con <- PEcAn.DB::db.open(settings$database$bety) + on.exit(PEcAn.DB::db.close(con), add = TRUE) + }, error = function(e) { + PEcAn.logger::logger.severe( + "Connection requested, but failed to open with the following error: ", + conditionMessage(e)) + }) + files <- PEcAn.DB::dbfile.check("Posterior", settings$pfts[[i]]$posteriorid, con, settings$host$name, return.all = TRUE) @@ -54,6 +61,7 @@ run.write.configs <- function(settings, write = TRUE, ens.sample.method = "unifo model <- settings$model$type scipen <- getOption("scipen") options(scipen = 12) + PEcAn.uncertainty::get.parameter.samples(settings, posterior.files, ens.sample.method) load(file.path(settings$outdir, "samples.Rdata")) @@ -93,7 +101,7 @@ run.write.configs <- function(settings, write = TRUE, ens.sample.method = "unifo ### Write out SA config files PEcAn.logger::logger.info("\n ----- Writing model run config files ----") - sa.runs <- PEcAn.utils::write.sa.configs(defaults = settings$pfts, + sa.runs <- PEcAn.uncertainty::write.sa.configs(defaults = settings$pfts, quantile.samples = sa.samples, settings = settings, model = model, @@ -104,7 +112,7 @@ run.write.configs <- function(settings, write = TRUE, ens.sample.method = "unifo settings$sensitivity.analysis$ensemble.id <- sa.ensemble.id <- sa.runs$ensemble.id # Save sensitivity analysis info - fname <- PEcAn.utils::sensitivity.filename(settings, "sensitivity.samples", "Rdata", + fname <- PEcAn.uncertainty::sensitivity.filename(settings, "sensitivity.samples", "Rdata", all.var.yr = TRUE, pft = NULL) save(sa.run.ids, sa.ensemble.id, sa.samples, pft.names, trait.names, file = fname) @@ -124,7 +132,7 @@ run.write.configs <- function(settings, write = TRUE, ens.sample.method = "unifo ens.samples <- ensemble.samples # rename just for consistency # Save ensemble analysis info - fname <- PEcAn.utils::ensemble.filename(settings, "ensemble.samples", "Rdata", all.var.yr = TRUE) + fname <- PEcAn.uncertainty::ensemble.filename(settings, "ensemble.samples", "Rdata", all.var.yr = TRUE) save(ens.run.ids, ens.ensemble.id, ens.samples, pft.names, trait.names, file = fname) } else { PEcAn.logger::logger.info("not writing config files for ensemble, settings are NULL") diff --git a/base/workflow/R/runModule.run.write.configs.R b/base/workflow/R/runModule.run.write.configs.R index 1e06def102c..fd168d6082b 100644 --- a/base/workflow/R/runModule.run.write.configs.R +++ b/base/workflow/R/runModule.run.write.configs.R @@ -17,7 +17,17 @@ runModule.run.write.configs <- function(settings, overwrite = TRUE) { # double check making sure we have method for parameter sampling if (is.null(settings$ensemble$samplingspace$parameters$method)) settings$ensemble$samplingspace$parameters$method <- "uniform" ens.sample.method <- settings$ensemble$samplingspace$parameters$method - return(PEcAn.workflow::run.write.configs(settings, write, ens.sample.method, overwrite = overwrite)) + + + #check to see if there are posterior.files tags under pft + posterior.files.vec<-settings$pfts %>% + purrr::map(purrr::possibly('posterior.files', NA_character_)) %>% + purrr::modify_depth(1, function(x) { + ifelse(is.null(x), NA_character_, x) + }) %>% + unlist() + + return(PEcAn.workflow::run.write.configs(settings, write, ens.sample.method, posterior.files = posterior.files.vec, overwrite = overwrite)) } else { stop("runModule.run.write.configs only works with Settings or MultiSettings") } diff --git a/base/workflow/inst/batch_run.R b/base/workflow/inst/batch_run.R new file mode 100755 index 00000000000..8dbed53ddb6 --- /dev/null +++ b/base/workflow/inst/batch_run.R @@ -0,0 +1,220 @@ +#!/usr/bin/env Rscript +library(dplyr) +library(purrr) +library(PEcAn.workflow) +library(furrr) +library(PEcAn.DB) +library(PEcAn.utils) +plan(multiprocess) +################################################## +# Parse arguments +argv <- commandArgs(trailingOnly = TRUE) +if ("--help" %in% argv) { + message( + "This script supports the following options:\n", + "--help Print this help message.\n", + "--dbfiles= Path to dbfiles folder", + "--table= Path to table listing tests to run", + "--userid= User ID for registering workflow.", + "--outdir= Path to output directory.", + "--pecandir= Path to PEcAn root directory.", + "--outfile= Path to output table" + ) + quit(save = "no", status = 0) +} + +get_arg <- function(argv, pattern, default_value) { + if (any(grepl(pattern, argv))) { + result <- argv[grep(pattern, argv)] %>% + gsub(pattern = paste0(pattern, "="), replacement = "") + } else { + result <- default_value + } + return(result) +} + +dbfiles_folder <- normalizePath(get_arg(argv, "--dbfiles", "~/output/dbfiles")) +input_table_file <- get_arg(argv, "--table",system.file("default_tests.csv", package = "PEcAn.workflow")) +user_id <- as.numeric(get_arg(argv, "--userid", 99000000002)) +pecan_path <- get_arg(argv, "--pecandir", getwd()) +output_folder <- get_arg(argv, "--outdir", "batch_test_output") +outfile <- get_arg(argv, "--outfile", "test_result_table.csv") +################################################## +# Establish database connection based on config.php +php_file <- file.path(pecan_path, "web", "config.php") +stopifnot(file.exists(php_file)) +config.list <- PEcAn.utils::read_web_config(php_file) +bety <- PEcAn.DB::betyConnect(php_file) + +# Create outfile directory if it doesn't exist +dir.create(dirname(outfile), recursive = TRUE, showWarnings = FALSE) +input_table <- read.csv(input_table_file, stringsAsFactors = FALSE) %>% + tidyr::replace_na(list(revision = "")) %>% + mutate( + folder= paste(model, + format(as.Date(start_date), "%Y-%m"), + format(as.Date(end_date), "%Y-%m"), + met, site_id, "test_runs", sep = "_") + outdir = NA_character_, + workflow_complete = NA, + has_jobsh = NA, + model_output_raw = NA, + model_output_processed = NA + ) + +for (i in seq_len(nrow(input_table))) { + table_row <- input_table[i, ] + + # Get model ID + model <- table_row$model + revision <- table_row$revision + message("Model: ", shQuote(model)) + message("Revision: ", shQuote(revision)) + model_df <- tbl(bety, "models") %>% + filter(model_name == !!model, + revision == !!revision) %>% + collect() + if (nrow(model_df) == 0) { + message("No models found with name ", model, + " and revision ", revision, ".\n", + "Moving on to next row.") + next + } else if (nrow(model_df) > 1) { + print(model_df) + message("Multiple models found with name ", model, + " and revision ", revision, ".\n", + "Moving on to next row.") + next + } else { + model_id <- model_df$id + } + + pft <- table_row$pft + if (is.na(pft)) pft <- NULL + + # Run test + raw_result <- create_execute_test_xml( + model_id = model_id, + met = table_row$met, + site_id = table_row$site_id, + pft = pft, + start_date = table_row$start_date, + end_date = table_row$end_date, + dbfiles_folder = dbfiles_folder, + pecan_path = pecan_path, + user_id = user_id, + ensemble_size = table_row$ensemble_size, + sensitivity = table_row$sensitivity + ) +#----------------------- Parallel Distribution of jobs +seq_len(nrow(input_table)) %>% + furrr::future_map(function(i){ + # Each job needs to have its own connection + # Establish database connection based on config.php + php_file <- file.path(pecan_path, "web", "config.php") + stopifnot(file.exists(php_file)) + config.list <- PEcAn.utils::read_web_config(php_file) + bety <- PEcAn.DB::betyConnect(php_file) + con <- bety$con + + # Get model ID + table_row <- input_table[i, ] + model <- table_row$model + revision <- table_row$revision + message("Model: ", shQuote(model)) + message("Revision: ", shQuote(revision)) + + + + model_df <- tbl(con, "models") %>% + filter(model_name == !!model, + revision == !!revision) %>% + collect() + + if (nrow(model_df) == 0) { + message("No models found with name ", model, + " and revision ", revision, ".\n", + "Moving on to next row.") + next + } else if (nrow(model_df) > 1) { + print(model_df) + message("Multiple models found with name ", model, + " and revision ", revision, ".\n", + "Moving on to next row.") + next + } else { + model_id <- model_df$id + } + + pft <- table_row$pft + if (is.na(pft)) pft <- NULL + + # Run test + raw_result <- create_execute_test_xml( + model_id = model_id, + met = table_row$met, + site_id = table_row$site_id, + pft = pft, + start_date = table_row$start_date, + end_date = table_row$end_date, + dbfiles_folder = dbfiles_folder, + pecan_path = pecan_path, + user_id = user_id, + ensemble_size = table_row$ensemble_size, + sensitivity = table_row$sensitivity, + output_folder=output_folder + ) + + }) + + + +#----------- Checking the results of the runs +checks_df<-file.path(output_folder, input_table$folder)%>% + purrr::map_dfr(function(outdir){ + + result_table <-NULL + ################################################## + # Did the workflow finish? + ################################################## + if (file.exists(file.path(outdir, "workflow.Rout"))) { + raw_output <- readLines(file.path(outdir, "workflow.Rout")) + result_table$workflow_complete <- any(grepl( + "PEcAn Workflow Complete", + raw_output + )) + }else{ + result_table$workflow_complete <- FALSE + } + ################################################## + # Did we write a job.sh file? + ################################################## + out <- file.path(outdir, "out") + run <- file.path(outdir, "run") + jobsh <- list.files(run, "job\\.sh", recursive = TRUE) + ## pft <- file.path(outdir, "pft") + result_table$has_jobsh <-ifelse(length(jobsh) > 0, TRUE, FALSE) + ################################################## + # Did the model produce any output? + ################################################## + raw_out <- list.files(out, recursive = TRUE) + result_table$model_output_raw <-ifelse(length(raw_out) > 0, TRUE, FALSE) + ################################################## + # Did PEcAn post-process the output? + ################################################## + # Files should have name `YYYY.nc` + proc_out <- list.files(out, "[[:digit:]]{4}\\.nc", recursive = TRUE) + result_table$model_output_processed <-ifelse(length(proc_out) > 0, TRUE, FALSE) + + return(result_table %>% + as.data.frame() %>% + mutate(folder=basename(outdir)) + ) + + }) + +#-- Writing down the results +input_table %>% + left_join(checks_df, + by="folder") %>% + write.csv(outfile, row.names = FALSE) diff --git a/base/workflow/inst/default_tests.csv b/base/workflow/inst/default_tests.csv new file mode 100644 index 00000000000..aae9d6e59b4 --- /dev/null +++ b/base/workflow/inst/default_tests.csv @@ -0,0 +1,4 @@ +model,revision,met,site_id,pft,start_date,end_date,sensitivity,ensemble_size,comment +"SIPNET","git","AmerifluxLBL",772,"temperate.coniferous","2003-01-01","2006-12-31",FALSE,1,"Demo 1" +"SIPNET","git","AmerifluxLBL",772,"temperate.coniferous","2003-01-01","2006-12-31",TRUE,100,"Demo 2" +"ED2","git","CRUNCEP",758,"temperate.Early_Hardwood","2001-06-01","2001-08-31",FALSE,1, "ED2 git Harvard Forest summer" diff --git a/base/workflow/inst/permutation_tests.R b/base/workflow/inst/permutation_tests.R new file mode 100755 index 00000000000..5821ea28980 --- /dev/null +++ b/base/workflow/inst/permutation_tests.R @@ -0,0 +1,141 @@ +#!/usr/bin/env Rscript + +# This script can be used to quickly generate a permuted list of models, +# met-products, and sites for comprehensive PEcAn integration testing. It +# produces as output a CSV file that can be used by `batch_run.R`. + +# It can take the following command line arguments: +# +# - --machine-id= -- Machine ID. If not provided, try to determine +# the machine ID from the hostname. +# (TODO: More command line arguments; for now, just modify the variables at the +# top) + +library(PEcAn.workflow) +library(tidyverse) + +argv <- commandArgs(trailingOnly = TRUE) + +met_name <- c("CRUNCEP", "AmerifluxLBL") +startdate <- "2004-01-01" +enddate <- "2004-12-31" +out.var <- "NPP" +ens_size <- 1 +sensitivity <- FALSE +outfile <- "permuted_table.csv" + +## Insert your path to base pecan +## pecan_path <- "/fs/data3/tonygard/work/pecan" +pecan_path <- file.path("..", "..") +php_file <- file.path(pecan_path, "web", "config.php") +stopifnot(file.exists(php_file)) +config.list <- PEcAn.utils::read_web_config(php_file) +bety <- PEcAn.DB::betyConnect(php_file) + +# Create path for outfile +dir.create(dirname(outfile), showWarnings = FALSE, recursive = TRUE) + +## Find name of Machine R is running on +machid_rxp <- "^--machine_id=" +if (any(grepl(machid_rxp, argv))) { + machid_raw <- grep(machid_rxp, argv, value = TRUE) + mach_id <- as.numeric(gsub(machid_rxp, "", machid_raw)) + message("Using specified machine ID: ", mach_id) +} else { + mach_name <- Sys.info()[[4]] + message("Auto-detected machine name: ", mach_name) + ## mach_name <- "docker" + mach_id <- tbl(bety, "machines") %>% + filter(hostname == !!mach_name) %>% + pull(id) +} + +## Find all models available on the current machine +model_df <- tbl(bety, "dbfiles") %>% + filter(machine_id == !!mach_id) %>% + filter(container_type == "Model") %>% + left_join(tbl(bety, "models"), c("container_id" = "id")) %>% + select(model_id = container_id, model_name, revision, + file_name, file_path, dbfile_id = id, ) %>% + collect() %>% + mutate(exists = file.exists(file.path(file_path, file_name))) + +message("Found the following models on the machine:") +print(model_df) + +if (!all(model_df$exists)) { + message("WARNING: The following models are registered on the machine ", + "but their files do not exist:") + model_df %>% + filter(!exists) %>% + print() + + model_df <- model_df %>% + filter(exists) +} + +## Find Sites +## Site with no inputs from any machines that is part of Ameriflux site group and Fluxnet Site group +site_id_noinput <- tbl(bety, "sites") %>% + anti_join(tbl(bety, "inputs")) %>% + inner_join(tbl(bety, "sitegroups_sites") %>% + filter(sitegroup_id == 1), + by = c("id" = "site_id")) %>% + dplyr::select("id.x", "notes", "sitename") %>% + dplyr::filter(grepl("TOWER_BEGAN", notes)) %>% + collect() %>% + dplyr::mutate( + # Grab years from string within the notes + start_year = substring(stringr::str_extract(notes,pattern = ("(?<=TOWER_BEGAN = ).*(?= TOWER_END)")),1,4), + #Empty tower end in the notes means that it goes until present day so if empty enter curent year. + end_year = dplyr::if_else( + substring(stringr::str_extract(notes,pattern = ("(?<=TOWER_END = ).*(?=)")),1,4) == "", + as.character(lubridate::year(Sys.Date())), + substring(stringr::str_extract(notes,pattern = ("(?<=TOWER_END = ).*(?=)")),1,4) + ), + #Check if startdate year is within the inerval of that is given + in_date = data.table::between(as.numeric(lubridate::year(startdate)),as.numeric(start_year),as.numeric(end_year)) + ) %>% + dplyr::filter( + in_date, + as.numeric(end_year) - as.numeric(start_year) > 1 + ) %>% + mutate(sitename = gsub(" ", "_", sitename)) %>% + rename(site_id = id.x) + +site_id_noinput %>% + select(site_id, sitename) %>% + print(n = Inf) + +message("Running tests at ", nrow(site_id_noinput), " sites:") +print(site_id_noinput) + +site_id <- site_id_noinput$site_id +site_name <- gsub(" ", "_", site_id_noinput$sitename) + +# Create permutations of all arguments +options(scipen = 999) +run_table <- tidyr::crossing( + # Keep model name and revision together -- don't cross them + tidyr::nesting( + model = model_df[["model_name"]], + revision = model_df[["revision"]] + # Eventually, PFT will go here... + ), + # Permute everything else + met = met_name, + site_id = site_id, + pft = NA, + start_date = startdate, + end_date = enddate, + # Possibly, nest these as well, e.g. + ## tidyr::nesting( + ## sensitivity = c(FALSE, TRUE), + ## ensemble_size = c(1, 100) + ## ), + sensitivity = sensitivity, + ensemble_size = ensemble_size, + comment = "" +) + +write.csv(run_table, outfile, row.names = FALSE) diff --git a/base/workflow/man/create_execute_test_xml.Rd b/base/workflow/man/create_execute_test_xml.Rd new file mode 100644 index 00000000000..d8ab927cdea --- /dev/null +++ b/base/workflow/man/create_execute_test_xml.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_execute_test_xml.R +\name{create_execute_test_xml} +\alias{create_execute_test_xml} +\title{Create a PEcAn XML file and use it to run a PEcAn workflow} +\usage{ +create_execute_test_xml( + model_id, + met, + site_id, + start_date, + end_date, + dbfiles_folder, + user_id, + output_folder = "batch_test_output", + pecan_path = getwd(), + pft = NULL, + ensemble_size = 1, + sensitivity_variable = "NPP", + sensitivity = FALSE, + db_bety_username = NULL, + db_bety_password = NULL, + db_bety_hostname = NULL, + db_bety_port = NULL, + db_bety_driver = "Postgres" +) +} +\arguments{ +\item{model_id}{(numeric) Model ID (from `models` table)} + +\item{met}{(character) Name of meteorology input source (e.g. `"CRUNCEP"`)} + +\item{site_id}{(numeric) Site ID (from `sites` table)} + +\item{start_date}{(character or date) Run start date} + +\item{end_date}{(character or date) Run end date} + +\item{dbfiles_folder}{(character) Path to `dbfiles` directory} + +\item{user_id}{(numeric) User ID to associate with the workflow} + +\item{output_folder}{(character) Path to root directory for storing outputs. +Default = `"batch_test_output"`} + +\item{pecan_path}{(character) Path to PEcAn source code. Default is current +working directory.} + +\item{pft}{(character) Name of PFT to run. If `NULL` (default), use the first +PFT in BETY associated with the model.} + +\item{ensemble_size}{(numeric) Number of ensembles to run. Default = 1.} + +\item{sensitivity_variable}{(character) Variable for performing sensitivity +analysis. Default = `"NPP"`} + +\item{sensitivity}{(logical) Whether or not to perform a sensitivity analysis +(default = `FALSE`)} + +\item{db_bety_username, db_bety_password, db_bety_hostname, db_bety_port}{(character) BETY database connection options. Default values for all of +these are pulled from `/web/config.php`.} + +\item{db_bety_driver}{(character) BETY database connection driver (default = `"Postgres"`)} +} +\value{ +A list with two entries: + * `sys`: Exit value returned by the workflow (0 for sucess). + * `outdir`: Path where the workflow results are saved +} +\description{ +Create a PEcAn XML file and use it to run a PEcAn workflow +} +\author{ +Alexey Shiklomanov, Tony Gardella +} diff --git a/base/workflow/man/do_conversions.Rd b/base/workflow/man/do_conversions.Rd index ee42a47225a..1f8738bc0ea 100644 --- a/base/workflow/man/do_conversions.Rd +++ b/base/workflow/man/do_conversions.Rd @@ -5,8 +5,12 @@ \alias{do.conversions} \title{do_conversions} \usage{ -do_conversions(settings, overwrite.met = FALSE, overwrite.fia = FALSE, - overwrite.ic = FALSE) +do_conversions( + settings, + overwrite.met = FALSE, + overwrite.fia = FALSE, + overwrite.ic = FALSE +) } \arguments{ \item{settings}{PEcAn settings list} diff --git a/base/workflow/man/model_specific_tags.Rd b/base/workflow/man/model_specific_tags.Rd new file mode 100644 index 00000000000..db22e556966 --- /dev/null +++ b/base/workflow/man/model_specific_tags.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_execute_test_xml.R +\name{model_specific_tags} +\alias{model_specific_tags} +\title{model_specific_tags} +\usage{ +model_specific_tags(settings, model.info) +} +\arguments{ +\item{settings}{pecan xml settings} + +\item{model.info}{model info extracted from bety} +} +\value{ +updated settings list +} +\description{ +model_specific_tags +} diff --git a/base/workflow/man/run.write.configs.Rd b/base/workflow/man/run.write.configs.Rd index c6e21b1261d..b5be69a3287 100644 --- a/base/workflow/man/run.write.configs.Rd +++ b/base/workflow/man/run.write.configs.Rd @@ -4,9 +4,13 @@ \alias{run.write.configs} \title{Write model-specific run scripts and configuration files} \usage{ -run.write.configs(settings, write = TRUE, - ens.sample.method = "uniform", posterior.files = rep(NA, - length(settings$pfts)), overwrite = TRUE) +run.write.configs( + settings, + write = TRUE, + ens.sample.method = "uniform", + posterior.files = rep(NA, length(settings$pfts)), + overwrite = TRUE +) } \arguments{ \item{settings}{a PEcAn settings list} diff --git a/base/workflow/tests/Rcheck_reference.log b/base/workflow/tests/Rcheck_reference.log new file mode 100644 index 00000000000..31d9ed9a27c --- /dev/null +++ b/base/workflow/tests/Rcheck_reference.log @@ -0,0 +1,64 @@ +* using log directory ‘/tmp/RtmpiqxPPg/PEcAn.workflow.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-manual --as-cran’ +* checking for file ‘PEcAn.workflow/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.workflow’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.workflow’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... OK +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +run.write.configs: no visible binding for global variable + ‘trait.samples’ +run.write.configs: no visible binding for global variable ‘sa.samples’ +run.write.configs: no visible binding for global variable + ‘ensemble.samples’ +Undefined global functions or variables: + ensemble.samples sa.samples trait.samples +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... OK +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking examples ... NONE +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... + OK +* DONE +Status: 2 NOTEs diff --git a/book_source/01_introduction/01_project_overview.Rmd b/book_source/01_introduction/01_project_overview.Rmd index 8d1ed138bc6..810399de1d1 100644 --- a/book_source/01_introduction/01_project_overview.Rmd +++ b/book_source/01_introduction/01_project_overview.Rmd @@ -2,13 +2,10 @@ The Predictive Ecosystem Analyzer (PEcAn) is an integrated informatics toolbox for ecosystem modeling (Dietze et al. 2013, LeBauer et al. 2013). PEcAn consists of: -1) An application program interface (API) that encapsulates an ecosystem model, providing a common interface, inputs, and output. - -2) Core utilities for handling and tracking model runs and the flows of information and uncertainties into and out of models and analyses - -3) An accessible web-based user interface and visualization tools - -4) An extensible collection of modules to handle specific types of analyses (sensitivity, uncertainty, ensemble), model-data syntheses (benchmarking, parameter data assimilation, state data assimilation), and data processing (model inputs and data constraints) +1. An application program interface (API) that encapsulates an ecosystem model, providing a common interface, inputs, and output. +2. Core utilities for handling and tracking model runs and the flows of information and uncertainties into and out of models and analyses +3. An accessible web-based user interface and visualization tools +4. An extensible collection of modules to handle specific types of analyses (sensitivity, uncertainty, ensemble), model-data syntheses (benchmarking, parameter data assimilation, state data assimilation), and data processing (model inputs and data constraints) ```{r, echo=FALSE, fig.align='center'} knitr::include_graphics(rep("figures/PEcAn_Components.jpeg")) @@ -20,8 +17,6 @@ The workflow system allows ecosystem modeling to be more reproducible, automated PEcAn is not itself an ecosystem model, and it can be used to with a variety of different ecosystem models; integrating a model involves writing a wrapper to convert inputs and outputs to and from the standards used by PEcAn. Currently, PEcAn supports multiple models listed [PEcAn Models]. - - **Acknowledgements** The PEcAn project is supported financially by the following: @@ -41,12 +36,13 @@ The PEcAn project is supported financially by the following: - NNX14AH65G - NNX16AO13H - 80NSSC17K0711 +- Advanced Research Projects Agency-Energy (ARPA-E) [DE-AR0000594](https://arpa-e.energy.gov/technologies/projects/reference-phenotyping-system-energy-sorghum) - Department of Defense, Strategic Environmental Research and Development Program (DOD-SERDP), grant [RC2636](https://www.serdp-estcp.org/Program-Areas/Resource-Conservation-and-Resiliency/Infrastructure-Resiliency/Vulnerability-and-Impact-Assessment/RC-2636/RC-2636) - Energy Biosciences Institute, University of Illinois - Amazon Web Services (AWS) - [Google Summer of Code](https://summerofcode.withgoogle.com/organizations/4612291316678656/) -BETY-db is a product of the Energy Biosciences Institute at the University of Illinois at Urbana-Champaign. We gratefully acknowledge the great effort of other researchers who generously made their own data available for further study. +BETYdb is a product of the Energy Biosciences Institute at the University of Illinois at Urbana-Champaign. We gratefully acknowledge the great effort of other researchers who generously made their own data available for further study. PEcAn is a collaboration among research groups at the Department of Earth And Environment at Boston University, the Energy Biosciences Institute at the University of Illinois, the Image Spatial Data Analysis group at NCSA, the Department of Atmospheric & Oceanic Sciences at the University Wisconsin-Madison, the Terrestrial Ecosystem Science & Technology (TEST) Group at Brookhaven National Laboratory, and the Joint Global Change Research Institute (JGCRI) at the Pacific Northwest National Laboratory. @@ -63,9 +59,10 @@ Any opinions, findings, and conclusions or recommendations expressed in this mat * Rogers A, BE Medlyn, J Dukes, G Bonan, S von Caemmerer, MC Dietze, J Kattge, ADB Leakey, LM Mercado, U Niinemets, IC Prentice, SP Serbin, S Sitch, DA Way, S Zaehle. 2017. "A Roadmap for Improving the Representation of Photosynthesis in Earth System Models" New Phytologist 213(1):22-42 DOI: 10.1111/nph.14283 * Shiklomanov. A, MC Dietze, T Viskari, PA Townsend, SP Serbin. 2016 "Quantifying the influences of spectral resolution on uncertainty in leaf trait estimates through a Bayesian approach to RTM inversion" Remote Sensing of the Environment 183: 226-238 * Viskari et al. 2015 Model-data assimilation of multiple phenological observations to constrain and forecast leaf area index. Ecological Applications 25(2): 546-558 -* Dietze, M. C., S. P. Serbin, C. Davidson, A. R. Desai, X. Feng, R. Kelly, R. Kooper, D. LeBauer, J. Mantooth, K. McHenry, and D. Wang (2014) A quantitative assessment of a terrestrial biosphere model's data needs across North American biomes. Journal of Geophysical Research-Biogeosciences [doi:10.1002/2013jg002392](http://dx.doi.org/10.1002/2013jg002392) -* LeBauer, D.S., D. Wang, K. Richter, C. Davidson, & M.C. Dietze. (2013). Facilitating feedbacks between field measurements and ecosystem models. Ecological Monographs. [doi:10.1890/12-0137.1](http://dx.doi.org/10.1890/12-0137.1) -* Wang, D, D.S. LeBauer, and M.C. Dietze(2013) Predicting yields of short-rotation hybrid poplar (Populus spp.) for the contiguous US through model-data synthesis. Ecological Applications [doi:10.1890/12-0854.1](http://dx.doi.org/10.1890/12-0854.1) -* Dietze, M.C., D.S LeBauer, R. Kooper (2013) On improving the communication between models and data. Plant, Cell, & Environment [doi:10.1111/pce.12043](http://dx.doi.org/10.1111/pce.12043) +* Dietze, M. C., S. P. Serbin, C. Davidson, A. R. Desai, X. Feng, R. Kelly, R. Kooper, D. LeBauer, J. Mantooth, K. McHenry, and D. Wang (2014) A quantitative assessment of a terrestrial biosphere model's data needs across North American biomes. Journal of Geophysical Research-Biogeosciences [doi:10.1002/2013jg002392](https://doi.org/10.1002/2013jg002392) +* LeBauer, D.S., D. Wang, K. Richter, C. Davidson, & M.C. Dietze. (2013). Facilitating feedbacks between field measurements and ecosystem models. Ecological Monographs. [doi:10.1890/12-0137.1](https://doi.org/10.1890/12-0137.1) +* Wang, D, D.S. LeBauer, and M.C. Dietze(2013) Predicting yields of short-rotation hybrid poplar (Populus spp.) for the contiguous US through model-data synthesis. Ecological Applications [doi:10.1890/12-0854.1](https://doi.org/10.1890/12-0854.1) +* Dietze, M.C., D.S LeBauer, R. Kooper (2013) On improving the communication between models and data. Plant, Cell, & Environment [doi:10.1111/pce.12043](https://doi.org/10.1111/pce.12043) - [Longer / auto-updated list of publications that mention PEcAn's full name in Google Scholar](https://scholar.google.com/scholar?start=0&q="predictive+ecosystem+analyzer+PEcAn") +* [PEcAn Project Google Scholar page](https://scholar.google.com/citations?hl=en&user=HWhxBY4AAAAJ) +* [Longer / auto-updated list of publications that mention PEcAn's full name in Google Scholar](https://scholar.google.com/scholar?start=0&q="predictive+ecosystem+analyzer+PEcAn") diff --git a/book_source/02_demos_tutorials_workflows/01_install_pecan.Rmd b/book_source/02_demos_tutorials_workflows/01_install_pecan.Rmd index fcc3f4cb37d..9c8801408da 100644 --- a/book_source/02_demos_tutorials_workflows/01_install_pecan.Rmd +++ b/book_source/02_demos_tutorials_workflows/01_install_pecan.Rmd @@ -80,7 +80,7 @@ This will not go into much detail about about how to use Docker -- for more deta This should print the current version of docker-compose. We have tested the instruction below with versions of docker-compose 1.22 and above. -3. **Download the PEcAn docker-compose file**. It is located in the root directory of the [PEcAn source code](https://github.com/pecanproject/pecan). For reference, here are direct links to the [latest stable version](https://raw.githubusercontent.com/PecanProject/pecan/master/docker-compose.yml) and the [bleeding edge development version](https://raw.githubusercontent.com/PecanProject/pecan/master/docker-compose.yml). (To download the files, you should be able to right click the link and select "Save link as".) Make sure the file is saved as `docker-compose.yml` in a directory called `pecan`. +3. **Download the PEcAn docker-compose file**. It is located in the root directory of the [PEcAn source code](https://github.com/pecanproject/pecan). For reference, here are direct links to the [latest stable version](https://raw.githubusercontent.com/PecanProject/pecan/master/docker-compose.yml) and the [bleeding edge development version](https://raw.githubusercontent.com/PecanProject/pecan/develop/docker-compose.yml). (To download the files, you should be able to right click the link and select "Save link as".) Make sure the file is saved as `docker-compose.yml` in a directory called `pecan`. 4. **Initialize the PEcAn database and data images**. The following `docker-compose` commands are used to download all the data PEcAn needs to start working. For more on how they work, see our [Docker topical pages](#pecan-docker-quickstart-init). @@ -99,22 +99,25 @@ This will not go into much detail about about how to use Docker -- for more deta b. "Initialize" the data for the PEcAn database. ```bash - docker-compose run --rm bety initialize + docker run --rm --network pecan_pecan pecan/db ``` This should produce a lot of output describing the database operations happening under the hood. - Some of these will look like errors (including starting with `ERROR`), but _this is normal_. - This command succeeded if the output ends with the following: + Some of these will look like errors, but _this is normal_. + This command succeeded if the output ends with the following (the syntax for creating a new user for accessing BetyDB): ``` - Added carya41 with access_level=4 and page_access_level=1 with id=323 - Added carya42 with access_level=4 and page_access_level=2 with id=325 - Added carya43 with access_level=4 and page_access_level=3 with id=327 - Added carya44 with access_level=4 and page_access_level=4 with id=329 - Added guestuser with access_level=4 and page_access_level=4 with id=331 + docker-compose run bety user 'login' 'password' 'full name' 'email' 1 1 ``` - - c. Download and configure the core PEcAn database files. + c. Add a user to BetyDB using the example syntax provided as the last line of the output of the previous step: + ```bash + # guest user + docker-compose run --rm bety user guestuser guestuser "Guest User" guestuser@example.com 4 4 + + # example user + docker-compose run --rm bety user carya illinois "Carya Demo User" carya@example.com 1 1 + ``` + d. Download and configure the core PEcAn database files. ```bash docker run -ti --rm --network pecan_pecan --volume pecan_pecan:/data --env FQDN=docker pecan/data:develop @@ -128,7 +131,16 @@ This will not go into much detail about about how to use Docker -- for more deta Done! ###################################################################### ``` + e. Download the [`pecan/docker/env.example`](https://raw.githubusercontent.com/PecanProject/pecan/develop/docker/env.example) & save it as `.env` file. + Now, open the `.env` file & uncomment the lines mentioned below: + ```{r, echo=FALSE, fig.align='center'} + knitr::include_graphics(rep("figures/env-file.PNG")) + ``` + + Setting `PECAN_VERSION=develop` indicates that you want to run the bleeding-edge `develop` branch, meaning it may have bugs. To go ahead with the stable version you may set `PECAN_VERSION=latest` or `PECAN_VERSION=` (For example `1.7.0`). You can look at the list of all the [releases](https://github.com/pecanproject/pecan/releases) of PEcAn to see what options are availble. + + 5. **Start the PEcAn stack**. Assuming all of the steps above completed successfully, start the full stack by running the following shell command: ```bash diff --git a/book_source/02_demos_tutorials_workflows/02_user_demos/01_introductions_user.Rmd b/book_source/02_demos_tutorials_workflows/02_user_demos/01_introductions_user.Rmd index 1490be56a5c..498a51bd323 100644 --- a/book_source/02_demos_tutorials_workflows/02_user_demos/01_introductions_user.Rmd +++ b/book_source/02_demos_tutorials_workflows/02_user_demos/01_introductions_user.Rmd @@ -1,11 +1,6 @@ -# User Tutorial Section {#user-section} +# Tutorials {#user-section} -The user Section contains the following sections: -[Basic Web Workflow Usage](#basic-web-wrokflow) -[PEcAn Web Interface](#intermediate User Guide) -[PEcAn from the Command Line](#advanced-user) - -## How PEcAn Works in a nutshell +## How PEcAn Works in a nutshell {#pecan-in-a-nutshell} PEcAn provides an interface to a variety of ecosystem models and attempts to standardize and automate the processes of model parameterization, execution, and analysis. First, you choose an ecosystem model, then the time and location of interest (a site), the plant community (or crop) that you are interested in simulating, and a source of atmospheric data from the BETY database (LeBauer et al, 2010). These are set in a "settings" file, commonly named `pecan.xml` which can be edited manually if desired. From here, PEcAn will take over and set up and execute the selected model using your settings. The key is that PEcAn uses models as-is, and all of the translation steps are done within PEcAn so no modifications are required of the model itself. Once the model is finished it will allow you to create graphs with the results of the simulation as well as download the results. It is also possible to see all past experiments and simulations. @@ -31,4 +26,3 @@ The following Tutorials assume you have installed PEcAn. If you have not, please |Vignette|Photosynthetic Response Curves|html|[Rmd](https://github.com/PecanProject/pecan/blob/master/modules/photosynthesis/vignettes/ResponseCurves.Rmd)| |Vignette|Priors|html|[Rmd](https://github.com/PecanProject/pecan/blob/master/modules/priors/vignettes/priors_demo.Rmd)| |Vignette|Leaf Spectra:PROSPECT inversion|html|[Rmd](https://github.com/PecanProject/pecan/blob/master/modules/rtm/vignettes/pecanrtm.vignette.Rmd)| - diff --git a/book_source/02_demos_tutorials_workflows/03_web_workflow.Rmd b/book_source/02_demos_tutorials_workflows/03_web_workflow.Rmd index afb84079529..997c4d5faa0 100644 --- a/book_source/02_demos_tutorials_workflows/03_web_workflow.Rmd +++ b/book_source/02_demos_tutorials_workflows/03_web_workflow.Rmd @@ -1,4 +1,4 @@ -# Basic Web workflow {#basic-web-wrokflow} +# Basic Web workflow {#basic-web-workflow} This chapter describes the major steps of the PEcAn web-based workflow, which are as follows: diff --git a/book_source/02_demos_tutorials_workflows/04_more_web_interface/02_hidden_analyses.Rmd b/book_source/02_demos_tutorials_workflows/04_more_web_interface/02_hidden_analyses.Rmd index 16f6e97d777..0fa96db4c8b 100644 --- a/book_source/02_demos_tutorials_workflows/04_more_web_interface/02_hidden_analyses.Rmd +++ b/book_source/02_demos_tutorials_workflows/04_more_web_interface/02_hidden_analyses.Rmd @@ -15,6 +15,8 @@ All functions pertaining to Parameter Data Assimilation are housed within: **pec For a detailed usage of the module, please see the vignette under **pecan/modules/assim.batch/vignettes**. +Hierarchical version of the PDA is also implemented, for more details, see the `MultiSitePDAVignette` [package vignette](https://github.com/PecanProject/pecan/blob/develop/modules/assim.batch/vignettes/MultiSitePDAVignette.Rmd) and function-level documentation. + #### **pda.mcmc.R** This is the main PDA code. It performs Bayesian MCMC on model parameters by proposing parameter values, running the model, calculating a likelihood (between model output and supplied observations), and accepting or rejecting the proposed parameters (Metropolis algorithm). Additional notes: diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/01_update_pecan_code.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/01_update_pecan_code.Rmd index 7553e9a63dd..742b5cea022 100644 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/01_update_pecan_code.Rmd +++ b/book_source/02_demos_tutorials_workflows/05_developer_workflows/01_update_pecan_code.Rmd @@ -40,7 +40,7 @@ The following are some additional `make` tricks that may be useful: * Force `make` to run, even if package has not changed -- `make -B ` -* Run `make` commands in parallel -- `make -j`; e.g. `make -j4 install` to install packages using four parallel processes. +* Run `make` commands in parallel -- `make -j`; e.g. `make -j4 install` to install packages using four parallel processes. Note that packages containing compiled code (e.g. PEcAn.RTM, PEcAn.BASGRA) might fail when `j` is greater than 1, because of limitations in the way R calls `make` internally while compiling them. See [GitHub issue 1976](https://github.com/PecanProject/pecan/issues/1976) for more details. All instructions for the `make` build system are contained in the `Makefile` in the PEcAn root directory. For full documentation on `make`, see the man pages by running `man make` from a terminal. diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/01_using-git.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/01_using-git.Rmd index d1df68a482a..3a25be86f07 100644 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/01_using-git.Rmd +++ b/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/01_using-git.Rmd @@ -31,6 +31,10 @@ it. The git protocol is read-only. This document describes the steps required to download PEcAn, make changes to code, and submit your changes. +If during above process you want to work on something else, commit all +your code, create a new branch, and work on new branch. + + #### PEcAn Project and Github * Organization Repository: https://github.com/organizations/PecanProject * PEcAn source code: https://github.com/PecanProject/pecan.git @@ -62,131 +66,188 @@ The Milestones, issues, and tasks can be used to organize specific features or r ---------------------------------- -#### Quick and Easy +#### Editing files on GitHub The **easiest** approach is to use GitHub's browser based workflow. This is useful when your change is a few lines, if you are editing a wiki, or if the edit is trivial (and won't break the code). The [GitHub documentation is here](https://help.github.com/articles/github-flow-in-the-browser) but it is simple: finding the page or file you want to edit, click "edit" and then the GitHub web application will automatically forking and branch, then allow you to submit a pull request. However, it should be noted that unless you are a member of the PEcAn project that the "edit" button will not be active and you'll want to follow the workflow described below for forking and then submitting a pull request. -#### Recommended Git Workflow +### Recommended Git Workflow +Summary: development should occur on a fork of the main repository. + +1. Fork +2. Create Branch +3. Develop +4. Push changes to your fork +5. Create pull request from branch on your fork to develop branch on pecanproject/pecan **Each feature should be in its own branch** (for example each issue is a branch, names of branches are often the issue in a bug tracking system). -**Commit and Push Frequency** On your branch, commit **_at minimum once a day before you push changes:_** even better: every time you reach a stopping point and move to a new issue. best: any time that you have done work that you do not want to re-do. Remember, pushing changes to your branch is like saving a draft. Submit a pull request when you are done. +**Commit and Push Frequency** On your branch, commit any time that you have done work that you do not want to re-do. Remember, pushing changes to your branch is like saving a draft. Submit a pull request when you are done. #### Before any work is done -The first step below only needs to be done once when you first start working on the PEcAn code. The steps below that need to be done to set up PEcAn on your computer, and would need to be repeated if you move to a new computer. If you are working from the PEcAn VM, you can skip the "git clone" since the PEcAn code is already installed. +The first step below only needs to be done once when you first start working on the PEcAn code. The steps below that need to be done to set up PEcAn on your computer, and would need to be repeated if you move to a new computer. -Most people will not be able to work in the PEcAn repository directly and will need to create a fork of the PEcAn source code in their own folder. To fork PEcAn into your own github space ([github help: "fork a repo"](https://help.github.com/articles/fork-a-repo)). This forked repository will allow you to create branches and commit changes back to GitHub and create pull requests to the develop branch of PEcAn. +All contributors should create a fork of the PEcAn source code in their own folder see [github help: "fork a repo"](https://help.github.com/articles/fork-a-repo)). This forked repository will allow you to create branches and submit these changes back to GitHub using pull requests to the develop branch of PEcAn. -The forked repository is the only way for external people to commit code back to PEcAn and BETY. The pull request will start a review process that will eventually result in the code being merged into the main copy of the codebase. See https://help.github.com/articles/fork-a-repo for more information, especially on how to keep your fork up to date with respect to the original. (Rstudio users should also see [Git + Rstudio](Using-Git.md#git--rstudio), below) +The pull request will start a review process that will eventually result in the code being merged into the main copy of the codebase. See https://help.github.com/articles/fork-a-repo for more information, especially on how to keep your fork up to date with respect to the original. (Rstudio users should also see [Git + Rstudio](Using-Git.md#git--rstudio), below). You can setup SSH keys to make it easier to commit cod back to GitHub. This might especially be true if you are working from a cluster, see [set up ssh keys](https://help.github.com/articles/generating-ssh-keys) +There is a script in the scripts folder called `scripts/syncgit.sh` that will keep your fork in sync with the main pecanproject repository. + 1. Introduce yourself to GIT -`git config --global user.name "FULLNAME"` -`git config --global user.email you@yourdomain.example.com` +```sh +git config --global user.name "FULLNAME" +git config --global user.email you@yourdomain.example.com +``` 2. Fork PEcAn on GitHub. Go to the PEcAn source code and click on the Fork button in the upper right. This will create a copy of PEcAn in your personal space. 3. Clone to your local machine via command line -`git clone git@github.com:/pecan.git` - -If this does not work, try the https method - -`git clone https://github.com/PecanProject/pecan.git` +```sh +git clone git@github.com:/pecan.git +``` -4. Define upstream repository +4. Define `PEcAnProject/pecan` as upstream repository -``` +```sh cd pecan git remote add upstream git@github.com:PecanProject/pecan.git ``` -#### During development: - -* commit often; -* each commit can address 0 or 1 issue; many commits can reference an issue -* ensure that all tests are passing before anything is pushed into develop. - -#### Basic Workflow +##### Hint: Keeping your fork in sync -This workflow is for educational purposes only. Please use the Recommended Workflow if you plan on contributing to PEcAn. This workflow does not include creating branches, a feature we would like you to use. -1. Get the latest code from the main repository +If you have used the instructions above, you can use the helper script called [`scripts/syncgit.sh`](https://github.com/PecanProject/pecan/blob/master/scripts/syncgit.sh) to keep the master and develop branches of your own fork in sync with the PEcAnProject/pecan repository. -`git pull upstream develop` +After following the above, your .git/config file will include the following: -2. Do some coding - -3. Commit after each chunk of code (multiple times a day) - -`git commit -m ""` - -4. Push to YOUR Github (when a feature is working, a set of bugs are fixed, or you need to share progress with others) - -`git push origin develop` - -5. Before submitting code back to the main repository, make sure that code compiles from the main directory. +``` +... +[remote "origin"] + url = git@github.com:/pecan.git + fetch = +refs/heads/*:refs/remotes/origin/* +[branch "develop"] + remote = origin + merge = refs/heads/develop +[remote "upstream"] + url = git@github.com:PecanProject/pecan.git + fetch = +refs/heads/*:refs/remotes/upstream/* +``` -`make` +Then, you can run: +```sh +./scripts/syncgit.sh +``` -6. submit pull request with a reference to related issue; -* also see [github documentation](https://help.github.com/articles/using-pull-requests) +Now the master and develop branches on your fork will be up to date. +#### Using Branching -#### Recommended Workflow: A new branch for each change +Ideally, a developer should create a new branch for each feature or bug fix -1. Make sure you start in develop +1. Make sure you start in the develop branch -`git checkout develop` +```sh +git checkout develop +``` 2. Make sure develop is up to date -`git pull upstream develop` +```sh +git pull upstream develop +``` 3. Run the PEcAn MAKEFILE to compile code from the main directory. -`make` +```sh +make +``` -4. Create a branch and switch to it +4. Create a new branch and switch to it -`git checkout -b ` +```sh +git checkout -b +``` 5. Work/commit/etc -`git add ` - -`git commit -m ""` +```sh +git add +git commit -m "" +``` 6. Make sure that code compiles and documentation updated. The make document command will run roxygenise. -`make document` -`make` +```sh +make document +make +``` 7. Push this branch to your github space -`git push origin ` +```sh +git push origin +``` 8. submit pull request with [[link commits to issues|Using-Git#link-commits-to-issuess]]; -* also see [explanation in this PecanProject/bety issue](https://github.com/PecanProject/bety/issues/57) and [github documentation](https://help.github.com/articles/using-pull-requests) +* also see [github documentation](https://help.github.com/articles/using-pull-requests) #### After pull request is merged 1. Make sure you start in master -`git checkout develop` +```sh +git checkout develop` +``` 2. delete branch remotely -`git push origin --delete ` +```sh +git push origin --delete ` +``` 3. delete branch locally -`git branch -D ` +```sh +git branch -D ` +``` + +#### Link commits to issues + +You can reference and close issues from comments, pull requests, and commit messages. This should be done when you commit code that is related to or will close/fix an existing issue. + +There are two ways to do this. One easy way is to include the following text in your commit message: + +* [**Github**](https://github.com/blog/1386-closing-issues-via-commit-messages) +* to close: "closes gh-xxx" (or syn. close, closed, fixes, fix, fixed) +* to reference: just the issue number (e.g. "gh-xxx") + +### Useful Git tools + +#### GitHub Desktop + +The easiest way to get working with GitHub is by installing the GitHub +client. For instructions for your specific OS and download of the +GitHub client, see https://help.github.com/articles/set-up-git. +This will help you set up an SSH key to push code back to GitHub. To +check out a project you do not need to have an ssh key and you can use +the https or git url to check out the code. + +#### Git + Rstudio + +Rstudio is nicely integrated with many development tools, including git and GitHub. +It is quite easy to check out source code from within the Rstudio program or browser. +The Rstudio documentation includes useful overviews of [version control](http://www.rstudio.com/ide/docs/version_control/overview) +and [R package development](http://www.rstudio.com/ide/docs/packages/overview). + +Once you have git installed on your computer (see the [Rstudio version control](http://www.rstudio.com/ide/docs/version_control/overview) documentation for instructions), you can use the following steps to install the PEcAn source code in Rstudio. + +### Advanced #### Fixing a release Branch @@ -219,42 +280,6 @@ If you would like to make changes to a release branch, you must follow a differe 8. Make a pull request. It is essential that you compare your pull request to the remote release branch, NOT the develop branch. -#### Link commits to issues - -You can reference and close issues from comments, pull requests, and commit messages. This should be done when you commit code that is related to or will close/fix an existing issue. - -There are two ways to do this. One easy way is to include the following text in your commit message: - -* [**Github**](https://github.com/blog/1386-closing-issues-via-commit-messages) -* to close: "closes gh-xxx" (or syn. close, closed, fixes, fix, fixed) -* to reference: just the issue number (e.g. "gh-xxx") - - -#### Other Useful Git Commands: - -* GIT encourages branching "early and often" -* First pull from develop -* Branch before working on feature -* One branch per feature -* You can switch easily between branches -* Merge feature into main line when branch done - -If during above process you want to work on something else, commit all -your code, create a new branch, and work on new branch. - - -* Delete a branch: `git branch -d ` -* To push a branch git: `push -u origin `` -* To check out a branch: - -``` -git fetch origin -git checkout --track origin/ -``` - -* Show graph of commits: - -`git log --graph --oneline --all` #### Tags @@ -278,52 +303,7 @@ To tag an earlier commit, just append the commit SHA to the command, e.g. `git tag -a v0.99 -m "last version before 1.0" 9fceb02` -**Using GitHub** The easiest way to get working with GitHub is by installing the GitHub -client. For instructions for your specific OS and download of the -GitHub client, see https://help.github.com/articles/set-up-git. -This will help you set up an SSH key to push code back to GitHub. To -check out a project you do not need to have an ssh key and you can use -the https or git url to check out the code. - -#### Git + Rstudio - - -Rstudio is nicely integrated with many development tools, including git and GitHub. -It is quite easy to check out source code from within the Rstudio program or browser. -The Rstudio documentation includes useful overviews of [version control](http://www.rstudio.com/ide/docs/version_control/overview) and [R package development](http://www.rstudio.com/ide/docs/packages/overview). - -Once you have git installed on your computer (see the [Rstudio version control](http://www.rstudio.com/ide/docs/version_control/overview) documentation for instructions), you can use the following steps to install the PEcAn source code in Rstudio. - -#### Creating a Read-only version: - -This is a fast way to clone the repository that does not support contributing new changes (this can be done with further modification). - -1. install Rstudio (www.rstudio.com) -2. click (upper right) project -* create project -* version control -* Git - clone a project from a Git Repository -* paste https://www.github.com/PecanProject/pecan -* choose working dir. for repo - -#### For development: - -1. create account on github -2. create a fork of the PEcAn repository to your own account https://www.github.com/pecanproject/pecan -3. install Rstudio (www.rstudio.com) -4. generate an ssh key -* in Rstudio: - * `Tools -> Options -> Git/SVN -> "create RSA key"` -* `View public key -> ctrl+C to copy` -* in GitHub -* go to [ssh settings](https://github.com/settings/ssh) -* `-> 'add ssh key' -> ctrl+V to paste -> 'add key'` -2. Create project in Rstudio -* `project (upper right) -> create project -> version control -> Git - clone a project from a Git Repository` -* paste repository url `git@github.com:/pecan.git>` -* choose working dir. for repository - -#### References +### References #### Git Documentation diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/02_Github-issues.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/02_Github-issues.Rmd index 060bb8cc090..de307e3f32e 100755 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/02_Github-issues.Rmd +++ b/book_source/02_demos_tutorials_workflows/05_developer_workflows/02_git/02_Github-issues.Rmd @@ -78,6 +78,6 @@ through UI libraries, hardcopy on David’s bookshelf)\ **Ideally, non-trivial code changes will be linked to an issue and a commit.** -This requires creating issues for each task, making small commits, and referencing the issue within your commit message. Issues can be created [on GitHub](https://github.com/PecanProject/pecan/issues/new). These issues can be linked to commits by adding text such as `fixes gh-5`). +This requires creating issues for each task, making small commits, and referencing the issue within your commit message. Issues can be created [on GitHub](http://pecanproject.github.io/Report_an_issue.html). These issues can be linked to commits by adding text such as `fixes gh-5`). Rationale: This workflow is a small upfront investment that reduces error and time spent re-creating and debugging errors. Associating issues and commits, makes it easier to identify why a change was made, and potential bugs that could arise when the code is changed. In addition, knowing which issue you are working on clarifies the scope and objectives of your current task. diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/01-coding-style.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/01-coding-style.Rmd new file mode 100644 index 00000000000..c6a2534db27 --- /dev/null +++ b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/01-coding-style.Rmd @@ -0,0 +1,36 @@ +### Coding Style {#developer-codestyle} + +Consistent coding style improves readability and reduces errors in +shared code. + +Unless otherwise noted, PEcAn follows the [Tidyverse style guide](https://style.tidyverse.org/), so please familiarize yourself with it before contributing. +In addition, note the following: + +- **Document all functions using `roxygen2`**. +See [Roxygen2](#developer-roxygen) for more details. +- **Put your name on things**. +Any function that you create or make a meaningful contribution to should have your name listed after the author tag in the function documentation. +It is also often a good idea to add your name to extended comments describing particularly complex or strange code. +- **Write unit tests with `testthat`**. +Tests are a complement to documentation - they define what a function is (and is not) expected to do. +Not all functions necessarily need unit tests, but the more tests we have, the more confident we can be that changes don't break existing code. +Whenever you discover and fix a bug, it is a good idea to write a unit test that makes sure the same bug won't happen again. +See [Unit_Testing](#developer-testing) for instructions, and [Advanced R: Tests](http://r-pkgs.had.co.nz/tests.html). +- **Do not use abbreviations**. +Always write out `TRUE` and `FALSE` (i.e. _do not_ use `T` or `F`). +Do not rely on partial argument matching -- write out all arguments in full. +- **Avoid dots in function names**. +R's S3 methods system uses dots to denote object methods (e.g. `print.matrix` is the `print` method for objects of class `matrix`), which can cause confusion. +Use underscores instead (e.g. `do_analysis` instead of `do.analysis`). +(NOTE that many old PEcAn functions violate this convention. The plan is to deprecate those in PEcAn 2.0. See GitHub issue [#392](https://github.com/PecanProject/pecan/issues/392)). +- **Use informative file names with consistent extensions**. +Standard file extensions are `.R` for R scripts, `.rds` for individual objects (via `saveRDS` function), and `.RData` (note: capital D!) for multiple objects (via the `save` function). +For function source code, prefer multiple files with fewer functions in each to large files with lots of files (though it may be a good idea to group closely related functions in a single file). +File names should match, or at least closely reflect, their files (e.g. function `do_analysis` should be defined in a file called `do_analysis.R`). +_Do not use spaces in file names_ -- use dashes (`-`) or underscores (`_`). +- **For using external packages, add the package to `Imports:` and call the corresponding function with `package::function`**. +_Do not_ use `@importFrom package function` or, worse yet, `@import package`. +(The exception is infix operators like `magrittr::%>%` or `ggplot2::%+%`, which can be imported via roxygen2 documentation like `@importFrom magrittr %>%`). +_Do not_ add packages to `Depends`. +In general, try to avoid adding new dependencies (especially ones that depend on system libraries) unless they are necessary or already widely used in PEcAn (e.g. GDAL, NetCDF, XML, JAGS, `dplyr`). +For a more thorough and nuanced discussion, see the [package dependencies appendix](#package-dependencies). diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/01_Coding_style.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/01_Coding_style.Rmd deleted file mode 100644 index a8ad5ec4557..00000000000 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/01_Coding_style.Rmd +++ /dev/null @@ -1,105 +0,0 @@ -### Coding Style {#developer-codestyle} - -Consistent coding style improves readability and reduces errors in -shared code. - -R does not have an official style guide, but Hadley Wickham provides one that is well -thought out and widely adopted. [Advanced R: Coding Style](http://r-pkgs.had.co.nz/style.html). - -Both the Wickham text and this page are derived from [Google's R Style Guide](https://google.github.io/styleguide/Rguide.xml). - -#### Use Roxygen2 documentation - -This is the standard method of documentation used in PEcAn development, -it provides inline documentation similar to doxygen. Even trivial -functions should be documented. - -See [Roxygen2](#developer-roxygen). - -#### Write your name at the top - -Any function that you create or make a meaningful contribution to should -have your name listed after the author tag in the function documentation. - -#### Use testthat testing package - -See [Unit_Testing](#developer-testing) for instructions, and [Advanced R: Tests](http://r-pkgs.had.co.nz/tests.html). - -* tests provide support for documentation - they define what a function is (and is not) expected to do -* all functions need tests to ensure basic functionality is maintained during development. -* all bugs should have a test that reproduces the bug, and the test should pass before bug is closed - - -#### Don't use shortcuts - -R provides many shortcuts that are useful when coding interactively, or for writing scripts. However, these can make code more difficult to read and can cause problems when written into packages. - -#### Function Names (`verb.noun`) - -Following convention established in PEcAn 0.1, we use the all lowercase with periods to separate words. They should generally have a `verb.noun` format, such as `query.traits`, `get.samples`, etc. - -#### File Names - -File names should end in `.R`, `.Rdata`, or `.rds` (as appropriate) and should be meaningful, e.g. named after the primary functions that they contain. There should be a separate file for each major high-level function to aid in identifying the contents of files in a directory. - -#### Use "<-" as an assignment operator - -Because most R code uses <- (except where = is required), we will use <- -`=` is reserved for function arguments - -#### Use Spaces - -* around all binary operators (=, +, -, <-, etc.). -* after but not before a comma - -#### Use curly braces - -The option to omit curly braces is another shortcut that makes code easier to write but harder to read and more prone to error. - -#### Package Dependencies - -In the source code for PEcAn functions, all functions that are not from base R or the current package must be called with explicit namespacing; i.e. `package::function` (e.g. `ncdf4::nc_open(...)`, `dplyr::select()`, `PEcAn.logger::logger.warn()`). -This is intended to maximize clarity for current and future developers (including yourself), and to make it easier to quickly identify (and possibly remove) external dependencies. - -In addition, it may be a good idea to call some base R functions with known, common namespace conflicts this way as well. -For instance, if you want to use base R's `filter` function, it's a good idea to write it as `stats::filter` to avoid unintentional conflicts with `dplyr::filter`. - -The one exception to this rule is infix operators (e.g. `magrittr::"%>%"`) which cannot be conveniently namespaced. -These functions should be imported using the Roxygen `@importFrom` tag. -For example: - -```r -#' My function -#' -#' @param a First param -#' @param b Second param -#' @returns Something -#' @importFrom magrittr %>% -#' @export -f <- myfunction(a, b) { - something(a) %>% something_else(b) -} -``` - -**Never use `library` or `require` inside package functions**. - -Any package dependencies added in this way should be added to the `Imports:` list in the package `DESCRIPTION` file. -**Do not use `Depends:` unless you have a _very_ good reason.** -The `Imports` list should be sorted alphabetically, with each package on its own line. -It is also a good idea to include version requirements in the `Imports` list (e.g. `dplyr (>=0.7)`). - -External packages that do not provide essential functionality can be relegated to `Suggests` instead of `Imports`. -In particular, consider this for packages that are large, difficult to install, and/or bring in a large number of their own dependencies. -Functions using these kinds of dependencies should check for their availability with `requireNamespace` and fail informatively in their absence. -For example: - -```r -g <- myfunction() { - if (!requireNamespace("BayesianTools", quietly = TRUE) { - PEcAn.logger::logger.severe( - "`BayesianTools` package required but not found.", - "Please make sure it is installed before using `g`.") - }) - BayesianTools::do_stuff(...) -} -``` diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/02-logging.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/02-logging.Rmd new file mode 100755 index 00000000000..2a73a6bb1c6 --- /dev/null +++ b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/02-logging.Rmd @@ -0,0 +1,16 @@ +### Logging {#developer-logging} + +During development we often add many print statements to check to see how the code is doing, what is happening, what intermediate results there are etc. When done with the development it would be nice to turn this additional code off, but have the ability to quickly turn it back on if we discover a problem. This is where logging comes into play. Logging allows us to use "rules" to say what information should be shown. For example when I am working on the code to create graphs, I do not have to see any debugging information about the SQL command being sent, however trying to figure out what goes wrong during a SQL statement it would be nice to show the SQL statements without adding any additional code. + +PEcAn provides a set of `logger.*` functions that should be used in place of base R's `stop`, `warn`, `print`, and similar functions. The `logger` functions make it easier to print to a system log file, and to control the level of output produced by PEcAn. + +* The file [test.logger.R](https://github.com/PecanProject/pecan/blob/develop/base/logger/tests/testthat/test.logger.R) provides descriptive examples +* This query provides an current overview of [functions that use logging](https://github.com/PecanProject/pecan/search?q=logger&ref=cmdform) +* Logger functions and their corresponding levels (in order of increasing level): + * `logger.debug` (`"DEBUG"`) -- Low-level diagnostic messages that are hidden by default. Good examples of this are expanded file paths and raw results from database queries or other analyses. + * `logger.info` (`"INFO"`) -- Informational messages that regular users may want to see, but which do not indicate anything unexpected. Good examples of this are progress updates updates for long-running processes, or brief summaries of queries or analyses. + * `logger.warn` (`"WARN"`) -- Warning messages about issues that may lead to unexpected but valid results. Good examples of this are interactions between arguments that lead to some arguments being ignored or removal of missing or extreme values. + * `logger.error` (`"ERROR"`) -- Error messages from which PEcAn has some capacity to recover. Unless you have a very good reason, we recommend avoiding this in favor of either `logger.severe` to actually stop execution or `logger.warn` to more explicitly indicate that the problem is not fatal. + * `logger.severe` -- Catastrophic errors that warrant immediate termination of the workflow. This is the only function that actually stops R's execution (via `stop`). +* The `logger.setLevel` function sets the level at which a message will be printed. For instance, `logger.setLevel("WARN")` will suppress `logger.info` and `logger.debug` messages, but will print `logger.warn` and `logger.error` messages. `logger.setLevel("OFF")` suppresses all logger messages. +* To print all messages to console, use `logger.setUseConsole(TRUE)` diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/02_Logging.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/02_Logging.Rmd deleted file mode 100755 index bb8f2799c77..00000000000 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/02_Logging.Rmd +++ /dev/null @@ -1,80 +0,0 @@ -### Logging {#developer-logging} - -During development we often add many print statements to check to see how the code is doing, what is happening, what intermediate results there are etc. When done with the development it would be nice to turn this additional code off, but have the ability to quickly turn it back on if we discover a problem. This is where logging comes into play. Logging allows us to use "rules" to say what information should be shown. For example when I am working on the code to create graphs, I do not have to see any debugging information about the SQL command being sent, however trying to figure out what goes wrong during a SQL statement it would be nice to show the SQL statements without adding any additional code. - -#### PEcAn logging functions - -These `logger` family of functions are more sophisticated, and can be used in place of `stop`, `warn`, `print`, and similar functions. The `logger` functions make it easier to print to a system log file. - -* The file [test.logger.R](../blob/master/utils/inst/tests/test.logger.R) provides descriptive examples -* This query provides an current overview of [functions that use logging](https://github.com/PecanProject/pecan/search?q=logger&ref=cmdform) -* logger functions (in order of increasing level): - * `logger.debug` - * `logger.info` - * `logger.warn` - * `logger.error` -* the `logger.setLevel` function sets the level at which a message will be printed - * `logger.setLevel("DEBUG")` will print messages from all logger functions - * `logger.setLevel("ERROR")` will only print messages from `logger.error` - * `logger.setLevel("INFO")` and `logger.setLevel("WARN")` shows messages from `logger.` and higher functions, e.g. `logger.setLevel("WARN")` shows messages from `logger.warn` and `logger.error` - * `logger.setLevel("OFF")` suppresses all logger messages -* To print all messages to console, use `logger.setUseConsole(TRUE)` - -#### Other R logging packages - -* **This section is for reference - these functions should not be used in PEcAn, as they are redundant with the `logger.*` functions described above** - -R does provide a basic logging capability using stop, warning and message. These allow to print message (and stop execution in case of stop). However there is not an easy method to redirect the logging information to a file, or turn the logging information on and off. This is where one of the following packages comes into play. The packages themselves are very similar since they try to emulate log4j. - -Both of the following packages use a hierarchic loggers, meaning that if you change the level of displayed level of logging at one level all levels below it will update their logging. - -##### `logging` - -The logging development is done at http://logging.r-forge.r-project.org/ and more information is located at http://cran.r-project.org/web/packages/logging/index.html . To install use the following command: - -```r -install.packages("logging", repos="http://R-Forge.R-project.org") -``` - -This has my preference pure based on documentation. - -#### `futile.logger` - -The second logging package is http://cran.r-project.org/web/packages/futile.logger/ and is eerily similar to logging (as a matter of fact logging is based on futile). - -##### Example Usage - -To be able to use the loggers there needs to be some initialization done. Neither package allows to read it from a configuration file, so we might want to use the pecan.xml file to set it up. The setup will always be somewhat the same: - -```{r loggingexample1, echo=TRUE, eval = FALSE} -# load library -library(logging) -logReset() - -# add handlers, responsible for actually printing/saving the messages -addHandler(writeToConsole) -addHandler(writeToFile, file="file.log") - -# setup root logger with INFO -setLevel('INFO') - -# make all of PEcAn print debug messages -setLevel('DEBUG', getLogger('PEcAn')) - -# only print info and above for the SQL part of PEcAn -setLevel('INFO', getLogger('PEcAn.SQL')) -``` - -To now use logging in the code you can use the following code: -```{r loggingexample2, echo=TRUE,eval = FALSE} -pl <- getLogger('PEcAn.MetaAnalysis.function1') -pl$info("This is an INFO message.") -pl$debug("The value for x=%d", x) -pl$error("Something bad happened and I am scared now.") -``` -or -```{r loggingexample3, echo=TRUE, eval = FALSE} -loginfo("This is an INFO message.", logger="PEcAn.MetaAnalysis.function1") -logdebug("The value for x=%d", x, logger="PEcAn.MetaAnalysis.function1") -logerror("Something bad happened and I am scared now.", logger="PEcAn.MetaAnalysis.function1") -``` diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/03_Package-data.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/03-package-data.Rmd similarity index 100% rename from book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/03_Package-data.Rmd rename to book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/03-package-data.Rmd diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/04-roxygen.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/04-roxygen.Rmd new file mode 100644 index 00000000000..2638bd8c0c7 --- /dev/null +++ b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/04-roxygen.Rmd @@ -0,0 +1,72 @@ +### Documenting functions using `roxygen2` {#developer-roxygen} + +This is the standard method for documenting R functions in PEcAn. +For detailed instructions, see one of the following resources: + +* `roxygen2` [pacakge documentation](https://roxygen2.r-lib.org/) + - [Formatting overview](https://roxygen2.r-lib.org/articles/rd.html) + - [Markdown formatting](https://blog.rstudio.com/2017/02/01/roxygen2-6-0-0/) + - [Namespaces](https://roxygen2.r-lib.org/articles/namespace.html) (e.g. when to use `@export`) +* From "R packages" by Hadley Wickham: + - [Object Documentation](http://r-pkgs.had.co.nz/man.html) + - [Package Metadata](http://r-pkgs.had.co.nz/description.html) + +Below is a complete template for a Roxygen documentation block. +Note that roxygen lines start with `#'`: + +```r +#' Function title, in a few words +#' +#' Function description, in 2-3 sentences. +#' +#' (Optional) Package details. +#' +#' @param argument_1 A description of the argument +#' @param argument_2 Another argument to the function +#' @return A description of what the function returns. +#' +#' @author Your name +#' @examples +#' \dontrun{ +#' # This example will NOT be run by R CMD check. +#' # Useful for long-running functions, or functions that +#' # depend on files or values that may not be accessible to R CMD check. +#' my_function("~/user/my_file") +#'} +# # This example WILL be run by R CMD check +#' my_function(1:10, argument_2 = 5) +## ^^ A few examples of the function's usage +#' @export +# ^^ Whether or not the function will be "exported" (made available) to the user. +# If omitted, the function can only be used inside the package. +my_function <- function(argument_1, argument_2) {...} +``` + +Here is a complete example from the `PEcAn.utils::days_in_year()` function: + +```r +#' Number of days in a year +#' +#' Calculate number of days in a year based on whether it is a leap year or not. +#' +#' @param year Numeric year (can be a vector) +#' @param leap_year Default = TRUE. If set to FALSE will always return 365 +#' +#' @author Alexey Shiklomanov +#' @return integer vector, all either 365 or 366 +#' @export +#' @examples +#' days_in_year(2010) # Not a leap year -- returns 365 +#' days_in_year(2012) # Leap year -- returns 366 +#' days_in_year(2000:2008) # Function is vectorized over years +days_in_year <- function(year, leap_year = TRUE) {...} +``` + +To update documentation throughout PEcAn, run `make document` in the PEcAn root directory. +_Make sure you do this before opening a pull request_ -- +PEcAn's automated testing (Travis) will check if any documentation is out of date and will throw an error like the following if it is: + +``` +These files were changed by the build process: +{...} +``` diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/04_Roxygen2.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/04_Roxygen2.Rmd deleted file mode 100644 index a0a2eb4cfe8..00000000000 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/04_Roxygen2.Rmd +++ /dev/null @@ -1,113 +0,0 @@ -### Roxygen2 {#developer-roxygen} - -This is the standard method of documentation used in PEcAn development, it provides inline documentation similar to doxygen. - -#### Canonical references: - -* Must Read: R package development by Hadley Wickham: - * [**Object Documentation**](http://r-pkgs.had.co.nz/man.html) - * [Package Metadata](http://r-pkgs.had.co.nz/description.html) -* Roxygen2 Documentation - * [Roxygen2 Package Documentation](http://cran.r-project.org/web/packages/roxygen2/roxygen2.pdf) - * [GitHub](https://github.com/klutometis/roxygen) - -#### Basic Roxygen2 instructions: - -Section headers link to "Writing R extensions" which provides in-depth documentation. This is provided as an overview and quick reference. - -#### [Tags](http://cran.r-project.org/doc/manuals/R-exts.html#Documenting-functions) - -* tags are preceeded by `##'` -* tags required by R: -** `title` tag is required, along with actual title -** `param` one for each parameter, should be defined -** `return` must state what function returns (or nothing, if something occurs as a side effect -* tags strongly suggested for most functions: -** `author` -** `examples` can be similar to test cases. -* optional tags: -** `export` required if function is used by another package -** `import` can import a required function from another package (if package is not loaded or other function is not exported) -** `seealso` suggests related functions. These can be linked using `\code{link{}}` - -#### Text markup - -##### [Formatting](http://cran.r-project.org/doc/manuals/R-exts.html#Marking-text) - -* `\bold{}` -* `\emph{}` italics - - -##### [Links](http://cran.r-project.org/doc/manuals/R-exts.html#Marking-text) - -* `\url{www.url.com}` or `\href{url}{text}` for links -* `\code{\link{thisfn}}` links to function "thisfn" in the same package -* `\code{\link{foo::thatfn}}` links to function "thatfn" in package "foo" -* `\pkg{package_name}` - -##### [Math](http://cran.r-project.org/doc/manuals/R-exts.html#Mathematics) - -* `\eqn{a+b=c}` uses LaTex to format an inline equation -* `\deqn{a+b=c}` uses LaTex to format displayed equation -* `\deqn{latex}{ascii}` and `\eqn{latex}{ascii}` can be used to provide different versions in latex and ascii. - -##### [Lists](http://cran.r-project.org/doc/manuals/R-exts.html#Lists-and-tables) - -``` -\enumerate{ -\item A database consists of one or more records, each with one or -more named fields. -\item Regular lines start with a non-whitespace character. -\item Records are separated by one or more empty lines. -} -\itemize and \enumerate commands may be nested. -``` - -##### "Tables":http://cran.r-project.org/doc/manuals/R-exts.html#Lists-and-tables - -``` -\tabular{rlll}{ -[,1] \tab Ozone \tab numeric \tab Ozone (ppb)\cr -[,2] \tab Solar.R \tab numeric \tab Solar R (lang)\cr -[,3] \tab Wind \tab numeric \tab Wind (mph)\cr -[,4] \tab Temp \tab numeric \tab Temperature (degrees F)\cr -[,5] \tab Month \tab numeric \tab Month (1--12)\cr -[,6] \tab Day \tab numeric \tab Day of month (1--31) -} -``` - -#### Example - -Here is an example documented function, myfun - -``` -##' My function adds three numbers -##' -##' A great function for demonstrating Roxygen documentation -##' @param a numeric -##' @param b numeric -##' @param c numeric -##' @return d, numeric sum of a + b + c -##' @export -##' @author David LeBauer -##' @examples -##' myfun(1,2,3) -##' \dontrun{myfun(NULL)} -myfun <- function(a, b, c){ - d <- a + b + c - return(d) -} -``` - -In emacs, with the cursor inside the function, the keybinding C-x O will generate an outline or update the Roxygen2 documentation. - - -#### Updating documentation - -* After adding documentation run the following command (replacing common with the name of the folder you want to update): -** In R using devtools to call roxygenize: - -```r -require(devtools) -document("common") -``` diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/05_Testing.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/05_Testing.Rmd deleted file mode 100755 index a1d5d0f572b..00000000000 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/05_Testing.Rmd +++ /dev/null @@ -1,361 +0,0 @@ -### Testing {#developer-testing} - -PEcAn uses the testthat package developed by Hadley Wickham. Hadley has -written instructions for using this package in his -[Testing](http://adv-r.had.co.nz/Testing.html) chapter. - -#### Rationale - -* makes development easier -* provides working documentation of expected functionality -* saves time by allowing computer to take over error checking once a - test has been made -* improves code quality -* Further reading: [Aruliah et al 2012 Best Practices for Scientific Computing](http://arxiv.org/pdf/1210.0530v3.pdf) - -#### Tests makes development easier and less error prone - -Testing makes it easier to develop by organizing everything you are -already doing anyway - but integrating it into the testing and -documentation. With a codebase like PEcAn, it is often difficult to get -started. You have to figure out - -* what was I doing yesterday? -* what do I want to do today? -* what existing functions do I need to edit? -* what are the arguments to these functions (and what are examples of - valid arguments) -* what packages are affected -* where is a logical place to put files used in testing - -#### Quick Start: - -* decide what you want to do today -* identify the issue in github (if none exists, create one) -* to work on issue 99, create a new branch called “github99” or some descriptive name… Today we will enable an -existing function, `make.cheas` to make `goat.cheddar`. We will know -that we are done by the color and taste. - ``` - git branch goat-cheddar - git checkout goat-cheddar - ``` -* open existing (or create new) file in `inst/tests/`. If working on code in "myfunction" or a set of functions in "R/myfile.R", the file should be named accordingly, e.g. "inst/tests/test.myfile.R" -* if you are lucky, the function has already been tested and has some examples. -* if not, you may need to create a minimal example, often requiring a settings file. The default settings file can be obtained in this way: - ```r - settings <- read.settings(system.file("extdata/test.settings.xml", package = "PEcAn.utils")) - ``` -* write what you want to do - ``` - test_that("make.cheas can make cheese",{ - goat.cheddar <- make.cheas(source = 'goat', style = 'cheddar') - expect_equal(color(goat.cheddar), "orange") - expect_is(object = goat.cheddar, class = "cheese") - expect_true(all(c("sharp", "creamy") %in% taste(goat.cheddar))) - } - ``` -* now edit the goat.cheddar function until it makes savory, creamy, orange cheese. -* commit often -* update documentation and test - ```{r, eval = FALSE} - library(devtools) - document("mypkg") - test("mypkg") - ``` -* commit again -* when complete, merge, and push - ```{bash, eval = FALSE} - git commit -m "make.cheas makes goat.cheddar now" - git checkout master - git merge goat-cheddar - git push - ``` - -#### Test files - - -Many of PEcAn’s functions require inputs that are provided as data. -These can be in the `/data` or the `/inst/extdata` folders of a package. -Data that are not package specific should be placed in the PEcAn.all or -PEcAn.utils files. - -Some useful conventions: - -#### Settings - -* A generic settings can be found in the PEcAn.all package -```r -settings.xml <- system.file("pecan.biocro.xml", package = "PEcAn.BIOCRO") -settings <- read.settings(settings.xml) -``` - -* database settings can be specified, and tests run only if a connection is available - -We currently use the following database to run tests against; tests that require access to a database should check `db.exists()` and be skipped if it returns FALSE to avoid failed tests on systems that do not have the database installed. - -```r -settings$database <- list(userid = "bety", - passwd = "bety", - name = "bety", # database name - host = "localhost" # server name) -test_that(..., { - skip_if_not(db.exists(settings$database)) - ## write tests here -}) -``` - -* instructions for installing this are available on the [VM creation - wiki](VM-Creation.md) -* examples can be found in the PEcAn.DB package (`base/db/tests/testthat/`). - -* Model specific settings can go in the model-specific module, for -example: - -```r -settings.xml <- system.file("extdata/pecan.biocro.xml", package = "PEcAn.BIOCRO") -settings <- read.settings(settings.xml) -``` -* test-specific settings: - - settings text can be specified inline: - ``` - settings.text <- " - - nope ## allows bypass of checks in the read.settings functions - - - ebifarm.pavi - test/ - - - test/ - - bety - bety - localhost - bety - - " - settings <- read.settings(settings.text) - ``` - - values in settings can be updated: - ```r - settings <- read.settings(settings.text) - settings$outdir <- "/tmp" ## or any other settings - ``` - -#### Helper functions created to make testing easier - -* **tryl** returns FALSE if function gives error -* **temp.settings** creates temporary settings file -* **test.remote** returns TRUE if remote connection is available -* **db.exists** returns TRUE if connection to database is available - -#### When should I test? - -A test *should* be written for each of the following situations: - -1. Each bug should get a regression test. - * The first step in handling a bug is to write code that reproduces the error - * This code becomes the test - * most important when error could re-appear - * essential when error silently produces invalid results - -2. Every time a (non-trivial) function is created or edited - * Write tests that indicate how the function should perform - * example: `expect_equal(sum(1,1), 2)` indicates that the sum - function should take the sum of its arguments - - * Write tests for cases under which the function should throw an - error - * example: `expect_error(sum("foo"))` - * better : `expect_error(sum("foo"), "invalid 'type' (character)")` - -#### What types of testing are important to understand? - - -#### Unit Testing / Test Driven Development - -Tests are only as good as the test - -1. write test -2. write code - -#### Regression Testing - -When a bug is found, - -1. write a test that finds the bug (the minimum test required to make - the test fail) -2. fix the bug -3. bug is fixed when test passes - -#### How should I test in R? The testthat package. - - -tests are found in `~/pecan//inst/tests`, for example -`utils/inst/tests/` - -See attached file and -[http://r-pkgs.had.co.nz/tests.html](http://r-pkgs.had.co.nz/tests.html) -for details on how to use the testthat package. - -##### List of Expectations - -|Full |Abbreviation| -|---|----| -|expect_that(x, is_true()) |expect_true(x)| -|expect_that(x, is_false()) |expect_false(x)| -|expect_that(x, is_a(y)) |expect_is(x, y)| -|expect_that(x, equals(y)) |expect_equal(x, y)| -|expect_that(x, is_equivalent_to(y)) |expect_equivalent(x, y)| -|expect_that(x, is_identical_to(y)) |expect_identical(x, y)| -|expect_that(x, matches(y)) |expect_matches(x, y)| -|expect_that(x, prints_text(y)) |expect_output(x, y)| -|expect_that(x, shows_message(y)) |expect_message(x, y)| -|expect_that(x, gives_warning(y)) |expect_warning(x, y)| -|expect_that(x, throws_error(y)) |expect_error(x, y)| - -##### How to run tests - -add the following to “pecan/tests/testthat.R” - -```r -library(testthat) -library(mypackage) - -test_check("mypackage") -``` - -#### basic use of the testthat package - -Here is an example of tests (these should be placed in -`/tests/testthat/test-.R`: - -```r -test_that("mathematical operators plus and minus work as expected",{ - expect_equal(sum(1,1), 2) - expect_equal(sum(-1,-1), -2) - expect_equal(sum(1,NA), NA) - expect_error(sum("cat")) - set.seed(0) - expect_equal(sum(matrix(1:100)), sum(data.frame(1:100))) -}) - -test_that("different testing functions work, giving excuse to demonstrate",{ - expect_identical(1, 1) - expect_identical(numeric(1), integer(1)) - expect_equivalent(numeric(1), integer(1)) - expect_warning(mean('1')) - expect_that(mean('1'), gives_warning("argument is not numeric or logical: returning NA")) - expect_warning(mean('1'), "argument is not numeric or logical: returning NA") - expect_message(message("a"), "a") -}) -``` - - -##### Script testing - -It is useful to add tests to a script during development. This allows -you to test that the code is doing what you expect it to do. - -```r -* here is a fake script using the iris data set - -test_that("the iris data set has the same basic features as before",{ - expect_equal(dim(iris), c(150,5)) - expect_that(iris$Sepal.Length, is_a("numeric")) - expect_is(iris$Sepal.Length, "numeric")#equivalent to prev. line - expect_is(iris$Species, "factor") -}) - -iris.color <- data.frame(Species = c("setosa", "versicolor", "virginica"), - color = c("pink", "blue", "orange")) - -newiris <- merge(iris, iris.color) -iris.model <- lm(Petal.Length ~ color, data = newiris) - -test_that("changes to Iris code occurred as expected",{ - expect_that(dim(newiris), equals(c(150, 6))) - expect_that(unique(newiris$color), - is_identical_to(unique(iris.color$color))) - expect_equivalent(iris.model$coefficients["(Intercept)"], 4.26) -}) -``` - - -##### Function testing - -Testing of a new function, `as.sequence`. The function and documentation -are in source:R/utils.R and the tests are in source:tests/test.utils.R. - -Recently, I made the function `as.sequence` to turn any vector into a -sequence, with custom handling of NA’s: - - -```r -function(x, na.rm = TRUE){ - x2 <- as.integer(factor(x, unique(x))) - if(all(is.na(x2))){ - x2 <- rep(1, length(x2)) - } - if(na.rm == TRUE){ - x2[is.na(x2)] <- max(x2, na.rm = TRUE) + 1 - } - return(x2) -} - -``` - - -The next step was to add documentation and test. Many people find it -more efficient to write tests before writing the function. This is true, -but it also requires more discipline. I wrote these tests to handle the -variety of cases that I had observed. - -As currently used, the function is exposed to a fairly restricted set of -options - results of downloads from the database and transformations. - -```r -test_that(“as.sequence works”;{ - expect_identical(as.sequence(c(“a”, “b”)), 1:2) - expect_identical(as.sequence(c(“a”, NA)), 1:2) - expect_equal(as.sequence(c(“a”, NA), na.rm = FALSE), c(1,NA)) - expect_equal(as.sequence(c(NA,NA)), c(1,1)) -}) -``` - -#### Testing the Shiny Server - -Shiny can be difficult to debug because, when run as a web service, the R output is hidden in system log files that are hard to find and read. -One useful approach to debugging is to use port forwarding, as follows. - -First, on the remote machine (including the VM), make sure R's working directory is set to the directory of the Shiny app (e.g., `setwd(/path/to/pecan/shiny/WorkflowPlots)`, or just open the app as an RStudio project). -Then, in the R console, run the app as: - -``` -shiny::runApp(port = XXXX) -# E.g. shiny::runApp(port = 5638) -``` - -Then, on your local machine, open a terminal and run the following command, matching `XXXX` to the port above and `YYYY` to any unused port on your local machine (any 4-digit number should work). - -``` -ssh -L YYYY:localhost:XXXX -# E.g., for the PEcAn VM, given the above port: -# ssh -L 5639:localhost:5638 carya@localhost -p 6422 -``` - -Now, in a web browser on your local machine, browse to `localhost:YYYY` (e.g., `localhost:5639`) to run whatever app you started with `shiny::runApp` in the previous step. -All of the output should display in the R console where the `shiny::runApp` command was executed. -Note that this includes any `print`, `message`, `logger.*`, etc. statements in your Shiny app. - -If the Shiny app hits an R error, the backtrace should include a line like `Hit error at of server.R#LXX` -- that `XX` being a line number that you can use to track down the error. -To return from the error to a normal R prompt, hit `-C` (alternatively, the "Stop" button in RStudio). -To restart the app, run `shiny::runApp(port = XXXX)` again (keeping the same port). - -Note that Shiny runs any code in the `pecan/shiny/` directory at the moment the app is launched. -So, any changes you make to the code in `server.R` and `ui.R` or scripts loaded therein will take effect the next time the app is started. - -If for whatever reason this doesn't work with RStudio, you can always run R from the command line. -Also, note that the ability to forward ports (`ssh -L`) may depend on the `ssh` configuration of your remote machine. -These instructions have been tested on the PEcAn VM (v.1.5.2+). diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/04-testing.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/04-testing.Rmd new file mode 100755 index 00000000000..68ccc3a399e --- /dev/null +++ b/book_source/02_demos_tutorials_workflows/05_developer_workflows/04-testing.Rmd @@ -0,0 +1,161 @@ +## Testing {#developer-testing} + +PEcAn uses two different kinds of testing -- [unit tests](#developer-testing-unit) and [integration tests](#developer-testing-integration). + +### Unit testing {#developer-testing-unit} + +Unit tests are short (<1 minute runtime) tests of functionality of specific functions. +Ideally, every function should have at least one unit test associated with it. + +A unit test *should* be written for each of the following situations: + +1. Each bug should get a regression test. + * The first step in handling a bug is to write code that reproduces the error + * This code becomes the test + * most important when error could re-appear + * essential when error silently produces invalid results + +2. Every time a (non-trivial) function is created or edited + * Write tests that indicate how the function should perform + * example: `expect_equal(sum(1,1), 2)` indicates that the sum + function should take the sum of its arguments + + * Write tests for cases under which the function should throw an + error + * example: `expect_error(sum("foo"))` + * better : `expect_error(sum("foo"), "invalid 'type' (character)")` +3. Any functionality that you would like to protect over the long term. Functionality that is not tested is more likely to be lost. +PEcAn uses the `testthat` package for unit testing. +A general overview of is provided in the ["Testing"](http://adv-r.had.co.nz/Testing.html) chapter of Hadley Wickham's book "R packages". +Another useful resource is the `testthat` [package documentation website](https://testthat.r-lib.org/). +See also our [`testthat` appendix](#appendix-testthat). +Below is a lightning introduction to unit testing with `testthat`. + +Each package's unit tests live in `.R` scripts in the folder `/tests/testthat`. +In addition, a `testthat`-enabled package has a file called `/tests/testthat.R` with the following contents: + +```r +library(testthat) +library() + +test_check("") +``` + +Tests should be placed in `/tests/testthat/test-.R`, and look like the following: + +```r +context("Mathematical operators") + +test_that("mathematical operators plus and minus work as expected",{ + sum1 <- sum(1, 1) + expect_equal(sum1, 2) + sum2 <- sum(-1, -1) + expect_equal(sum2, -2) + expect_equal(sum(1,NA), NA) + expect_error(sum("cat")) + set.seed(0) + expect_equal(sum(matrix(1:100)), sum(data.frame(1:100))) +}) + +test_that("different testing functions work, giving excuse to demonstrate",{ + expect_identical(1, 1) + expect_identical(numeric(1), integer(1)) + expect_equivalent(numeric(1), integer(1)) + expect_warning(mean('1')) + expect_that(mean('1'), gives_warning("argument is not numeric or logical: returning NA")) + expect_warning(mean('1'), "argument is not numeric or logical: returning NA") + expect_message(message("a"), "a") +}) +``` + +### Integration testing {#developer-testing-integration} + +Integration tests consist of running the PEcAn workflow in full. +One way to do integration tests is to manually run workflows for a given version of PEcAn, either through the web interface or by manually creating a [`pecan.xml` file](#pecanXML). +Such manual tests are an important part of checking PEcAn functionality. + +Alternatively, the [`base/workflow/inst/batch_run.R`][batch_run] script can be used to quickly run a series of user-specified integration tests without having to create a bunch of XML files. +This script is powered by the [`PEcAn.workflow::create_execute_test_xml()`][xml_fun] function, +which takes as input information about the model, meteorology driver, site ID, run dates, and others, +uses these to construct a PEcAn XML file, +and then uses the `system()` command to run a workflow with that XML. + +If run without arguments, `batch_run.R` will try to run the model configurations specified in the [`base/workflow/inst/default_tests.csv`][default_tests] file. +This file contains a CSV table with the following columns: + +- `model` -- The name of the model (`models.model_name` column in BETY) +- `revision` -- The version of the model (`models.revision` column in BETY) +- `met` -- The name of the meteorology driver source +- `site_id` -- The numeric site ID for the model run (`sites.site_id`) +- `pft` -- The name of the plant functional type to run. If `NA`, the script will use the first PFT associated with the model. +- `start_date`, `end_date` -- The start and end dates for the model run, respectively. These should be formatted according to ISO standard (`YYYY-MM-DD`, e.g. `2010-03-16`) +- `sensitivity` -- Whether or not to run the sensitivity analysis. `TRUE` means run it, `FALSE` means do not. +- `ensemble_size` -- The number of ensemble members to run. Set this to 1 to do a single run at the trait median. +- `comment` -- An string providing some user-friendly information about the run. + +The `batch_run.R` script will run a workflow for every row in the input table, sequentially (for now; eventually, it will try to run them in parallel), +and at the end of each workflow, will perform some basic checks, including whether or not the workflow finished and if the model produced any output. +These results are summarized in a CSV table (by default, a file called `test_result_table.csv`), with all of the columns as the input test CSV plus the following: + +- `outdir` -- Absolute path to the workflow directory. +- `workflow_complete` -- Whether or not the PEcAn workflow completed. Note that this is a relatively low bar -- PEcAn workflows can complete without having run the model or finished some other steps. +- `has_jobsh` -- Whether or not PEcAn was able to write the model's `job.sh` script. This is a good indication of whether or not the model's `write.configs` step was successful, and may be useful for separating model configuration errors from model execution errors. +- `model_output_raw` -- Whether or not the model produced any output files at all. This is just a check to see of the `/out` directory is empty or not. Note that some models may produce logfiles or similar artifacts as soon as they are executed, whether or not they ran even a single timestep, so this is not an indication of model success. +- `model_output_processed` -- Whether or not PEcAn was able to post-process any model output. This test just sees if there are any files of the form `YYYY.nc` (e.g. `1992.nc`) in the `/out` directory. + +Right now, these checks are not particularly robust or comprehensive, but they should be sufficient for catching common errors. +Development of more, better tests is ongoing. + +The `batch_run.R` script can take the following command-line arguments: + +- `--help` -- Prints a help message about the script's arguments +- `--dbfiles=` -- The path to the PEcAn `dbfiles` folder. The default value is `~/output/dbfiles`, based on the file structure of the PEcAn VM. Note that for this and all other paths, if a relative path is given, it is assumed to be relative to the current working directory, i.e. the directory from which the script was called. +- `--table=` -- Path to an alternate test table. The default is the `base/workflow/inst/default_tests.csv` file. See preceding paragraph for a description of the format. +- `--userid=` -- The numeric user ID for registering the workflow. The default value is 99000000002, corresponding to the guest user on the PEcAn VM. +- `--outdir=` -- Path to a directory (which will be created if it doesn't exist) for storing the PEcAn workflow outputs. Default is `batch_test_output` (in the current working directory). +- `--pecandir=` -- Path to the PEcAn source code root directory. Default is the current working directory. +- `--outfile=` -- Full path (including file name) of the CSV file summarizing the results of the runs. Default is `test_result_table.csv`. The format of the output + +[batch_run]: https://github.com/pecanproject/pecan/tree/develop/base/workflow/inst/batch_run.R +[default_tests]: https://github.com/pecanproject/pecan/tree/develop/base/workflow/inst/default_tests.csv +[xml_fun]: + +### Continuous Integration + +Every time anyone commits a change to the PEcAn code, the act of pushing to GitHub triggers an automated build and test of the full PEcAn codebase, and all pull requests must report a successful CI build before they will be merged. This will sometimes feel like a burden when the build breaks on an issue that looks trivial, but anything that breaks the build is important enough to fix. It's much better to find errors early and fix them before they get incorporated into the released PEcAn code. + +At this writing PEcAn's CI builds primarily use [GitHub Actions](https://github.com/PecanProject/pecan/actions) and the rest of this section assumes a GitHub Actions. + +All our GitHub Actions builds run in a containers using different versions of R in parallel. The build will use the latest pecan/depends container for that specific R version. Each night this depends image is rebuild. + +Each build starts by launching a separate clean virtual machine for each R version and performs roughly the following actions on all of them: +* Compile the source code in the container + - Installs all the R packages that are declared as dependencies in any PEcAn package, as computed by `scripts/generate_dependencies.R`. + - This will also check to see if any files have been modified during this step +* Run the tests inside the container, and checks to see if they all pass + - This will also check to see if any files have been modified during this step +* Run the doxygen command inside the container + - This will also check to see if any files have been modified during this step +* Run the check command inside the container, and checks if there are any new warnings and/or errors + - Runs package unit tests (the same ones you run locally with `make test` or `devtools::test(pkgname)`). + - As discussed in [Unit testing](#developer-testing-unit), these tests should run quickly and test individual components in relative isolation. + - Any test that calls the `skip_on_ci` function will be skipped. This is useful for tests that need to run for a very long time (e.g. large data product downloads) or require resources that aren't available on Travis (e.g. specific models), but be sure to run these tests locally before pushing your code! + - This will also check to see if any files have been modified during this step + - Any ERROR in the check output will stop the build immediately. + - If there are no ERRORs, any WARNINGs or NOTEs are compared against a stored historic check result in `/tests/Rcheck_reference.log`. If the package has no stored reference result, all WARNINGs and NOTEs are considered newly added and reported as build failures. + - If all messages from the current built were also present in the reference result, the check passes. If any messages are newly added, a build failure is reported. + - Each line of the check log is considered a separate message, and the test requires exact matching, so a change from `Undocumented arguments in documentation object 'foo': 'x'` to `Undocumented arguments in documentation object 'foo': 'x', 'y'` will be counted as a new warning... and you should fix both of them while you're at it! + - The idea here is to enforce good coding practice and catch likely errors in all new code while recognizing that we have a lot of legacy code whose warnings need to be fixed as we have time rather than all at once. + - As we fix historic warnings, we will revoke their grandfathered status by removing them from the stored check results, so that they will break the build if they reappear. + - If your PR reports a failure in pre-existing code that you think ought to be grandfathered, please fix it as part of your PR anyway. It's frustrating to see tests complain about code you didn't touch, but the failures all need to be cleaned up eventually and it's likely easier to fix the error than to figure out how to re-ignore it. +* Run a simple integration test using SIPNET model +* Create the docker images + - Once your PR is merged, it will push them to DockerHub and github container repository. +* Compiles the PEcAn documentation book (`book_source`) and the tutorials (`documentation/tutorials`) and uploads them to the [PEcAn website](https://pecanproject.github.io/pecan-documentation). + - This is only done for commits to the `master` or `develop` branch, so changes to in-progress pull requests never change the live documentation until after they are merged. + +If your build fails and indicates that files have been modified there are a few common causes. It should also list the files that have changes, and what has changed. +* The most common cause is that you forgot to Roxygenize before committing. +* This step will also detect newly added files, e.g. tests improperly writing to the current working directory rather than `tempdir()` and then failing to clean up after themselves. + +If any of the actionsreports an error, the build is marked as "failed". If they all pass, the GitHub actions marks the build as successful and tells the PR that it's OK to allow your changes to be merged... but the final decision belongs to the human reviewing your code and they might still ask you for other changes! diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/04_compile_PEcAn.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/05-compile-pecan.Rmd similarity index 100% rename from book_source/02_demos_tutorials_workflows/05_developer_workflows/04_compile_PEcAn.Rmd rename to book_source/02_demos_tutorials_workflows/05_developer_workflows/05-compile-pecan.Rmd diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/05_directory_structure.Rmd b/book_source/02_demos_tutorials_workflows/05_developer_workflows/06-directory-structure.Rmd similarity index 100% rename from book_source/02_demos_tutorials_workflows/05_developer_workflows/05_directory_structure.Rmd rename to book_source/02_demos_tutorials_workflows/05_developer_workflows/06-directory-structure.Rmd diff --git a/book_source/03_topical_pages/01_advanced_vm.Rmd b/book_source/03_topical_pages/01_advanced_vm.Rmd index 76ea34e405b..d1890bfcf37 100644 --- a/book_source/03_topical_pages/01_advanced_vm.Rmd +++ b/book_source/03_topical_pages/01_advanced_vm.Rmd @@ -28,22 +28,22 @@ Host pecan-vm This will allow you to SSH into the VM with the simplified command, `ssh pecan-vm`. -## Connecting to bety on the VM via SSh {#ssh-vm-bety} +## Connecting to BETYdb on the VM via SSH {#ssh-vm-bety} -Sometimes, you may want to develop code locally but connect to an instance of Bety on the VM. -To do this, first open a new terminal and connect to the VM while enabling port forwarding (with the `-L` flag) and setting XXXX to any available port (more or less any 4 digit number -- a reasonable choice is 3333). +Sometimes, you may want to develop code locally but connect to an instance of BETYdb on the VM. +To do this, first open a new terminal and connect to the VM while enabling port forwarding (with the `-L` flag) and setting the port number. Using 5433 does not conflict with the postgres default port of 5432, the forwarded port will not conflict with a postgres database server running locally. ``` -ssh -L XXXX:localhost:5432 carya@localhost:6422 +ssh -L 5433:localhost:5432 carya@localhost:6422 ``` -This makes port XXXX on the local machine match port 5432 on the VM. -This means that connecting to `localhost:XXXX` will give you access to Bety on the VM. +This makes port 5433 on the local machine match port 5432 on the VM. +This means that connecting to `localhost:5433` will give you access to BETYdb on the VM. To test this on the command line, try the following command, which, if successful, will drop you into the `psql` console. ``` -psql -d bety -U bety -h localhost -p XXXX +psql -d bety -U bety -h localhost -p 5433 ``` To test this in R, open a Postgres using the analogous parameters: @@ -56,12 +56,12 @@ con <- dbConnect( password = "bety", dbname = "bety", host = "localhost", - port = XXXX + port = 5433 ) dbListTables(con) # This should return a vector of bety tables ``` -Note that the same general approach will work on any Bety server where port forwarding is enabled. +Note that the same general approach will work on any BETYdb server where port forwarding is enabled, but it requires ssh access. ### Using Amazon Web Services for a VM (AWS) {#awsvm} @@ -231,35 +231,3 @@ Once all done, stop the virtual machine ```bash history -c && ${HOME}/cleanvm.sh ``` - -### VM Desktop Conversion {#vm-dektop-conversion} - -```bash -sudo apt-get update -sudo apt-get install xfce4 xorg -``` - -For a more refined desktop environment, try - -```bash -sudo apt-get install --no-install-recommends xubuntu-desktop -``` -* replace `xubuntu-` with `ubuntu-`, `lubuntu-`, or other preferred desktop enviornment -* the `--no-install-recommends` eliminates additional applications, removing it will add a word processor, a browser, and lots of other applications included in the default operating system. - -Reinstall Virtual Box additions for better integration adding X/mouse support - -```bash -sudo mount /dev/cdrom /mnt -sudo /mnt/VBoxLinuxAdditions.run -sudo umount /mnt -``` - -### Install RStudio Desktop {#install-rstudio} - -```bash -wget http://download1.rstudio.org/rstudio-0.97.551-amd64.deb -apt-get install libjpeg621 -dpkg -i rstudio-* -rm rstudio-* -``` diff --git a/book_source/03_topical_pages/03_pecan_xml.Rmd b/book_source/03_topical_pages/03_pecan_xml.Rmd index ea6449863ba..8cece42197e 100644 --- a/book_source/03_topical_pages/03_pecan_xml.Rmd +++ b/book_source/03_topical_pages/03_pecan_xml.Rmd @@ -21,6 +21,7 @@ It contains the following major sections ("nodes"): - (experimental) [`state.data.assimilation`](#xml-state-data-assimilation) -- State data assimilation - (experimental) [`browndog`](#xml-browndog) -- Brown Dog configuration - (experimental) [`benchmarking`](#xml-benchmarking) -- Benchmarking + - [`remote_process`](#xml-remote_process) -- Remote data module A basic example looks like this: @@ -105,9 +106,9 @@ A basic example looks like this: In the following sections, we step through each of these sections in detail. -### Core configuration {#xml-core-config} +## Core configuration {#xml-core-config} -#### Top-level structure {#xml-structure} +### Top-level structure {#xml-structure} The first line of the XML file should contain version and encoding information. @@ -123,7 +124,7 @@ The rest of the XML file should be surrounded by `...` tags. ``` -#### `info`: Run metadata {#xml-info} +### `info`: Run metadata {#xml-info} This section contains run metadata. This information is not essential to a successful model run, but is useful for tracking run provenance. @@ -132,7 +133,7 @@ This information is not essential to a successful model run, but is useful for t Example run -1 - guestuser + guestuser 2018/09/18 19:12:28 +0000 ``` @@ -249,6 +250,7 @@ The PEcAn system requires at least 1 plant functional type (PFT) to be specified 1 + Path to a post.distns.*.Rdata or prior.distns.Rdata ``` @@ -256,6 +258,9 @@ The PEcAn system requires at least 1 plant functional type (PFT) to be specified * `name` : (required) the name of the PFT, which must *exactly* match the name in the PEcAn database. * `outdir`: (optional) Directory path in which PFT-specific output will be stored during meta-analysis and sensitivity analysis. If not specified (recommended), it will be written into `/`. * `contants`: (optional) this section contains information that will be written directly into the model specific configuration files. For example, some models like ED2 use PFT numbers instead of names for PFTs, and those numbers can be specified here. See documentation for model-specific code for details. +* `posterior.files` (Optional) this tag helps to signal write.config functions to use specific posterior/prior files (such as HPDA or MA analysis) for generating samples without needing to access to the bety database. + +`` This information is currently used by the following PEcAn workflow function: @@ -375,6 +380,7 @@ This section provides detailed configuration for the model run, including the si 2004/01/01 2004/12/31 + TRUE ``` @@ -452,6 +458,8 @@ The following tags are optional run settings that apply to any model: * `jobtemplate`: the template used when creating a `job.sh` file, which is used to launch the actual model. Each model has its own default template in the `inst` folder of the corresponding R package (for instance, here is the one for [ED2](https://github.com/PecanProject/pecan/blob/master/models/ed/inst/template.job)). The following variables can be used: `@SITE_LAT@`, `@SITE_LON@`, `@SITE_MET@`, `@START_DATE@`, `@END_DATE@`, `@OUTDIR@`, `@RUNDIR@` which all come variables in the `pecan.xml` file. The following two command can be used to copy and clean the results from a scratch folder (specified as scratch in the run section below, for example local disk vs network disk) : `@SCRATCH_COPY@`, `@SCRATCH_CLEAR@`. +* `stop_on_error`: (logical) Whether the workflow should immediately terminate if _any_ of the model runs fail. If unset, this defaults to `TRUE` unless you are running an ensemble simulation (and ensemble size is greater than 1). + Some models also have model-specific tags, which are described in the [PEcAn Models](#pecan-models) section. ### `host`: Host information for remote execution {#xml-host} @@ -475,7 +483,7 @@ The following provides a quick overview of XML tags related to remote execution. TRUE qsub -N @NAME@ -o @STDOUT@ -e @STDERR@ -S /bin/bash Your job ([0-9]+) .* - qstat -j @JOBID@ &> /dev/null || echo DONE + 'qstat -j @JOBID@ &> /dev/null || echo DONE' module load udunits R/R-3.0.0_gnu-4.4.6 /usr/local/bin/modellauncher @@ -503,7 +511,7 @@ The `modellauncher` has 2 arguements: * `binary` : [required] The full path to the binary modellauncher. Source code for this file can be found in `pecan/contrib/modellauncher`](https://github.com/PecanProject/pecan/tree/develop/contrib/modellauncher). * `qsub.extra` : [optional] Additional flags to pass to qsub besides those specified in the `qsub` tag in host. This option can be used to specify that the MPI environment needs to be used and the number of nodes that should be used. -### Advanced features {#xml-advanced} +## Advanced features {#xml-advanced} ### `ensemble`: Ensemble Runs {#xml-ensemble} @@ -771,3 +779,46 @@ This information is currently used by the following R functions: Coming soon... +### Remote data module {#xml-remote_process} + +This section describes the tags required for configuring `remote_process`. + +```xml + + ... + ... + ... + ... + ... + ... + ... + ... + ... + ... + +``` + +* `out_get_data`: (required) type of raw output requested, e.g, bands, smap +* `source`: (required) source of remote data, e.g., gee or appeears +* `collection`: (required) dataset or product name as it is provided on the source, e.g. "COPERNICUS/S2_SR" for gee or "SPL3SMP_E.003" for appeears +* `scale`: (optional) pixel resolution required for some gee collections, recommended to use 10 for Sentinel 2 +* `projection`: (optional) type of projection. Only required for appeears polygon AOI type +* `qc`: (optional) quality control parameter, required for some gee collections +* `overwrite`: (optional) if TRUE database checks will be skipped and existing data of same type will be replaced entirely. When processed data is requested, the raw data required for creating it will also be replaced. By default FALSE + +These tags are only required if processed data is requested: + +* `out_process_data`: (optional) type of processed output requested, e.g, LAI +* `algorithm`: (optional) algorithm used for processing data, currently only SNAP is implemented to estimate LAI from Sentinel-2 bands +* `credfile`: (optional) absolute path to JSON file containing Earthdata username and password, only required for AppEEARS +* `pro_mimetype`: (optional) MIME type of the processed file +* `pro_formatname`: (optional) format name of the processed file + +Additional information for the module are taken from the registration files located at `data.remote/inst/registration` + +The output data from the module are returned in the following tags: + +* `raw_id`: input id of the raw file +* `raw_path`: absolute path to the raw file +* `pro_id`: input id of the processed file +* `pro_path`: absolute path to the processed file diff --git a/book_source/03_topical_pages/04_R_workflow.Rmd b/book_source/03_topical_pages/04_R_workflow.Rmd index b29c575fe10..8b2f898226a 100644 --- a/book_source/03_topical_pages/04_R_workflow.Rmd +++ b/book_source/03_topical_pages/04_R_workflow.Rmd @@ -8,23 +8,23 @@
-### Read Settings {#workflow-readsettings} +## Read Settings {#workflow-readsettings} (TODO: Under construction...) -### Input Conversions {#workflow-input} +## Input Conversions {#workflow-input} -### Input Data {#workflow-input-data} +## Input Data {#workflow-input-data} Models require input data as drivers, parameters, and boundary conditions. In order to make a variety of data sources that have unique formats compatible with models, conversion scripts are written to convert them into a PEcAn standard format. That format is a netcdf file with variables names and specified to our standard variable table. Within the PEcAn repository, code pertaining to input conversion is in the MODULES directory under the data.atmosphere and data.land directories. -### Initial Conditions {#workflow-input-initial} +## Initial Conditions {#workflow-input-initial} (TODO: Under construction) -### Meteorological Data {#workflow-met} +## Meteorological Data {#workflow-met} To convert meterological data into the PEcAn Standard and then into model formats we follow four main steps: @@ -57,7 +57,7 @@ The main script that handles Met Processing, is [`met.process`](https://github.c - Example Code to [convert Standard into Sipnet format](https://github.com/PecanProject/pecan/blob/develop/models/sipnet/R/met2model.SIPNET.R) -#### Downloading Raw data (Description of Process) {#workflow-met-download} +### Downloading Raw data (Description of Process) {#workflow-met-download} Given the information passed from the pecan.xml met.process will call the `download.raw.met.module` to facilitate the execution of the necessary functions to download raw data. @@ -75,26 +75,26 @@ The main script that handles Met Processing, is [`met.process`](https://github.c ### Converting from PEcAn standard to model-specific format {#workflow-met-model} -### Traits {#workflow-traits} +## Traits {#workflow-traits} (TODO: Under construction) -### Meta Analysis {#workflow-metaanalysis} +## Meta Analysis {#workflow-metaanalysis} (TODO: Under construction) -### Model Configuration {#workflow-modelconfig} +## Model Configuration {#workflow-modelconfig} (TODO: Under construction) -### Run Execution {#workflow-modelrun} +## Run Execution {#workflow-modelrun} (TODO: Under construction) -### Post Run Analysis {#workflow-postrun} +## Post Run Analysis {#workflow-postrun} (TODO: Under construction) -### Advanced Analysis {#workflow-advanced} +## Advanced Analysis {#workflow-advanced} (TODO: Under construction) diff --git a/book_source/03_topical_pages/05_models/00_model_index.Rmd b/book_source/03_topical_pages/05_models/00_model_index.Rmd index f0250d113a3..604544c4379 100644 --- a/book_source/03_topical_pages/05_models/00_model_index.Rmd +++ b/book_source/03_topical_pages/05_models/00_model_index.Rmd @@ -15,6 +15,7 @@ This section will contain information about all models and output variables that | [MAESPA](#models-maespa)| Yes | Yes | No | No | | [PRELES](#models-preles) | Yes | Yes | Partially | No | | [SiPNET](#models-sipnet)| Yes | Yes | Yes| Yes | +| [STICS](#models-stics)| Yes | Yes | No | No | *Available in the VM* - Denotes if a model is publicly available with PEcAn. @@ -30,4 +31,3 @@ This section will contain information about all models and output variables that PEcAn converts all model outputs to a single [Output Standards]. This standard evolved out of MsTMIP project, which is itself based on NACP, LBA, and other model-intercomparison projects. This standard was expanded for the PalEON MIP and the needs of the PEcAn modeling community to support variables not in these standards. _Model developers_: do not add variables to your PEcAn output without first adding them to the PEcAn standard table! Also, do not create new variables equivalent to existing variables but just with different names or units. - diff --git a/book_source/03_topical_pages/05_models/biocro.Rmd b/book_source/03_topical_pages/05_models/biocro.Rmd index 77524efe75e..cfb8f11e5a7 100644 --- a/book_source/03_topical_pages/05_models/biocro.Rmd +++ b/book_source/03_topical_pages/05_models/biocro.Rmd @@ -1,4 +1,4 @@ -### BioCro {#models-biocro} +## BioCro {#models-biocro} | Model Information | | | -- | -- | diff --git a/book_source/03_topical_pages/05_models/clm.Rmd b/book_source/03_topical_pages/05_models/clm.Rmd index a11cec95911..0a077a61a03 100644 --- a/book_source/03_topical_pages/05_models/clm.Rmd +++ b/book_source/03_topical_pages/05_models/clm.Rmd @@ -1,4 +1,4 @@ -### CLM {#models-clm} +## CLM {#models-clm} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/dalec.Rmd b/book_source/03_topical_pages/05_models/dalec.Rmd index d870a6cdaf8..754acc0a1cf 100644 --- a/book_source/03_topical_pages/05_models/dalec.Rmd +++ b/book_source/03_topical_pages/05_models/dalec.Rmd @@ -1,4 +1,4 @@ -### DALEC {#models-dalec} +## DALEC {#models-dalec} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/ed.Rmd b/book_source/03_topical_pages/05_models/ed.Rmd index f5c2e8563c4..eaa9c46ca21 100644 --- a/book_source/03_topical_pages/05_models/ed.Rmd +++ b/book_source/03_topical_pages/05_models/ed.Rmd @@ -1,4 +1,4 @@ -### ED2 {#models-ed} +## ED2 {#models-ed} | Model Information | | | -- | -- | @@ -8,11 +8,11 @@ | Authors | Paul Moorcroft, ... | | PEcAn Integration | Michael Dietze, Rob Kooper | -#### Introduction +### Introduction Introduction about ED model -#### PEcAn configuration file additions +### PEcAn configuration file additions The following sections of the PEcAn XML are relevant to the ED model: @@ -70,7 +70,7 @@ The following sections of the PEcAn XML are relevant to the ED model: - `veg`: [required] location of vegetation data - `soil`: [required] location of soil data -#### PFT configuration in ED2 {#models-ed-pft-configuration} +### PFT configuration in ED2 {#models-ed-pft-configuration} ED2 has more detailed PFTs than many models, and a more complex system for configuring these PFTs. ED2 has 17 PFTs, based roughly on growth form (e.g. tree vs. grass), biome (tropical vs. temperate), leaf morphology (broad vs. needleleaf), leaf phenology (evergreen vs. deciduous), and successional status (e.g. early, mid, or late). @@ -160,11 +160,11 @@ However, if you would like ED2 to run with all 17 PFTs (NOTE: using ED2's intern [convert-samples-ed]: https://pecanproject.github.io/models/ed/docs/reference/convert.samples.ED.html -#### Model specific input files +### Model specific input files List of inputs required by model, such as met, etc. -#### Model configuration files +### Model configuration files ED2 is configured using 2 files which are placed in the run folder. @@ -209,7 +209,7 @@ The ED2IN template can contain the following variables. These will be replaced w * **@OUTDIR@** : location where output files are written (**without the runid**), from \\\, should not be used. * **@SCRATCH@** : local scratch space for outputs, generated /scratch/\/run\$scratch, should not be used right now since it only works on ebi-cluster -#### Installation notes +### Installation notes This section contains notes on how to compile the model. The notes for the VM might work on other machines or configurations as well. diff --git a/book_source/03_topical_pages/05_models/gday.Rmd b/book_source/03_topical_pages/05_models/gday.Rmd index bc24611cb60..90595573206 100644 --- a/book_source/03_topical_pages/05_models/gday.Rmd +++ b/book_source/03_topical_pages/05_models/gday.Rmd @@ -1,4 +1,4 @@ -### GDAY {#models-gday} +## GDAY {#models-gday} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/linkages.Rmd b/book_source/03_topical_pages/05_models/linkages.Rmd index 8f30cc763a6..3754a6d47af 100644 --- a/book_source/03_topical_pages/05_models/linkages.Rmd +++ b/book_source/03_topical_pages/05_models/linkages.Rmd @@ -1,4 +1,4 @@ -### LINKAGES {#models-linkages} +## LINKAGES {#models-linkages} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/lpj-guess.Rmd b/book_source/03_topical_pages/05_models/lpj-guess.Rmd index 5fe185369f5..a5c46d414c7 100644 --- a/book_source/03_topical_pages/05_models/lpj-guess.Rmd +++ b/book_source/03_topical_pages/05_models/lpj-guess.Rmd @@ -1,4 +1,4 @@ -### LPJ-GUESS {#models-lpjguess} +## LPJ-GUESS {#models-lpjguess} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/maespa.Rmd b/book_source/03_topical_pages/05_models/maespa.Rmd index 7841c39165e..7ebca7f67eb 100644 --- a/book_source/03_topical_pages/05_models/maespa.Rmd +++ b/book_source/03_topical_pages/05_models/maespa.Rmd @@ -1,4 +1,4 @@ -### MAESPA {#models-maespa} +## MAESPA {#models-maespa} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/preles.Rmd b/book_source/03_topical_pages/05_models/preles.Rmd index 8799b030aba..cba82a13da4 100644 --- a/book_source/03_topical_pages/05_models/preles.Rmd +++ b/book_source/03_topical_pages/05_models/preles.Rmd @@ -1,4 +1,4 @@ -### PRELES {#models-preles} +## PRELES {#models-preles} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/sipnet.Rmd b/book_source/03_topical_pages/05_models/sipnet.Rmd index 02df0037dea..bbcef49aeaf 100644 --- a/book_source/03_topical_pages/05_models/sipnet.Rmd +++ b/book_source/03_topical_pages/05_models/sipnet.Rmd @@ -1,4 +1,4 @@ -### SiPNET {#models-sipnet} +## SiPNET {#models-sipnet} | Model Information || | -- | -- | diff --git a/book_source/03_topical_pages/05_models/stics.Rmd b/book_source/03_topical_pages/05_models/stics.Rmd new file mode 100644 index 00000000000..54eb5702fdc --- /dev/null +++ b/book_source/03_topical_pages/05_models/stics.Rmd @@ -0,0 +1,33 @@ +## STICS {#models-stics} + +| Model Information || +| -- | -- | +| Home Page | https://www6.paca.inrae.fr/stics/ | +| Source Code | | +| License | | +| Authors | | +| PEcAn Integration | Istem Fer | + +**Introduction** + +STICS (Simulateur mulTIdisciplinaire pour les Cultures Standard) is a crop model that has been developed since 1996 at INRA (French National Institute for Agronomic Research) in collaboration with other research (CIRAD, Irstea, Ecole des Mines de Paris, ESA, LSCE) or professional (ARVALIS, Terres Inovia, CTIFL, ITV, ITB, Agrotransferts, etc.) and teaching institutes or organizations. + + +**PEcAn configuration file additions** + +Should list the model specific additions to the PEcAn file here + +**Model specific input files** + +List of inputs required by model, such as met, etc. + +**Model configuration files** + +STICS is configured using different XML files located in two fixed directories: config, plant and user defined workspace(s) directorie(s). A java app called JavaStics allows users to generate these files. + +**Installation notes** + +The software (JavaStics interface and STICS model) is available for download after a registration procedure (see procedure at http://www6.paca.inra.fr/stics_eng/ Download). + + +**VM** diff --git a/book_source/03_topical_pages/06_data/01_meteorology.Rmd b/book_source/03_topical_pages/06_data/01_meteorology.Rmd index 59abde31092..e912ac6545f 100644 --- a/book_source/03_topical_pages/06_data/01_meteorology.Rmd +++ b/book_source/03_topical_pages/06_data/01_meteorology.Rmd @@ -1,6 +1,6 @@ # Available Meteorological Drivers -### Ameriflux +## Ameriflux Scale: site @@ -10,7 +10,7 @@ Availability: varies by site http:\/\/ameriflux.lbl.gov\/data\/data-availability Notes: Old ORNL server, use is deprecated -### AmerifluxLBL +## AmerifluxLBL Scale: site @@ -20,7 +20,7 @@ Availability: varies by site http:\/\/ameriflux.lbl.gov\/data\/data-availability Notes: new Lawrence Berkeley Lab server -### Fluxnet2015 +## Fluxnet2015 Scale: site @@ -30,7 +30,7 @@ Availability: varies by site [http:\/\/fluxnet.fluxdata.org\/sites\/site-list-an Notes: Fluxnet 2015 synthesis product. Does not cover all FLUXNET sites -### NARR +## NARR Scale: North America @@ -38,7 +38,7 @@ Resolution: 3 hr, approx. 32km \(Lambert conical projection\) Availability: 1979-present -### CRUNCEP +## CRUNCEP Scale: global @@ -46,7 +46,7 @@ Resolution: 6hr, 0.5 degree Availability: 1901-2010 -### CMIP5 +## CMIP5 Scale: varies by model @@ -56,7 +56,7 @@ Availability: 2006-2100 Currently only GFDL available. Different scenerios and ensemble members can be set via Advanced Edit. -### NLDAS +## NLDAS Scale: Lower 48 + buffer, @@ -64,7 +64,7 @@ Resolution: 1 hour, .125 degree Availability: 1980-present -### GLDAS +## GLDAS Scale: Global @@ -72,7 +72,7 @@ Resolution: 3hr, 1 degree Availability: 1948-2010 -### PalEON +## PalEON Scale: -100 to -60 W Lon, 35 to 50 N Latitude \(US northern hardwoods + buffer\) @@ -80,7 +80,7 @@ Resolution: 6hr, 0.5 degree Availability: 850-2010 -### FluxnetLaThuile +## FluxnetLaThuile Scale: site @@ -90,7 +90,7 @@ Availability: varies by site http:\/\/www.fluxdata.org\/DataInfo\/Dataset%20Doc Notes: 2007 synthesis. Fluxnet2015 supercedes this for sites that have been updated -### Geostreams +## Geostreams Scale: site @@ -100,7 +100,7 @@ Availability: varies by site Notes: This is a protocol, not a single archive. The PEcAn functions currently default to querying [https://terraref.ncsa.illinois.edu/clowder/api/geostreams], which requires login and contains data from only two sites (Urbana IL and Maricopa AZ). However the interface can be used with any server that supports the [Geostreams API](https://opensource.ncsa.illinois.edu/confluence/display/CATS/Geostreams+API). -### ERA5 +## ERA5 Scale: Global @@ -113,3 +113,22 @@ Notes: It's important to know that the raw ERA5 tiles needs to be downloaded and registered in the database first. Inside the `inst` folder in the data.atmosphere package there are R files for downloading and registering files in the BETY. However, it assumes that you have registered and setup your API requirements. Check out how to setup your API [here] (https://confluence.ecmwf.int/display/CKB/How+to+download+ERA5#HowtodownloadERA5-3-DownloadERA5datathroughtheCDSAPI). In the `inst` folder you can find two files (`ERA5_db_register.R` and `ERA5_USA_download.R`). If you setup your `ecmwf` account as it's explained in the link above, `ERA5_USA_download.R` will help you to download all the tiles with all the variables required for pecan `extract.nc.ERA5` function to generate pecan standard met files. Besides installing the required packages for this file, it should work from top to bottom with no problem. After downloading the tiles, there is simple script in `ERA5_db_register.R` which helps you register your tiles in the bety. `met.process` later on uses that entery to find the required tiles for extracting met data for your sites. There are important points about this file. 1- Make sure you don't change the site id in the script (which is the same the `ParentSite` in ERA5 registeration xml file). 2- Make sure the start and end date in that script matches the downloaded tiles. Set your `ERA5.files.path` to where you downloaded the tiles and then the rest of the script should be working fine. +## ICOS Drought 2018 + +Scale: site + +Resolution: 30 min + +Availability: Varies by [site](https://meta.icos-cp.eu/collections/ueb_7FcyEcbG6y9-UGo5HUqV) + +Notes: To use this option, set `source` as `ICOS` and a `product` tag containing `drought2018` in `pecan.xml` + +## ICOS Ecosystem Archive + +Scale: site + +Resolution: 30 min + +Availability: Varies by [site](https://meta.icos-cp.eu/collections/q4V7P1VLZevIrnlsW6SJO1Rz) + +Notes: To use this option, set `source` as `ICOS` and a `product` tag containing `etc` in `pecan.xml` diff --git a/book_source/03_topical_pages/06_data/02_GFDL.Rmd b/book_source/03_topical_pages/06_data/02_GFDL.Rmd index 4301c695704..bc9350adb18 100644 --- a/book_source/03_topical_pages/06_data/02_GFDL.Rmd +++ b/book_source/03_topical_pages/06_data/02_GFDL.Rmd @@ -1,10 +1,10 @@ -### Download GFDL +## Download GFDL The Downlad.GFDL function assimilates 3 hour frequency CMIP5 outputs generated by multiple GFDL models. GFDL developed several distinct modeling streams on the timescale of CMIP5 and AR5. These models include CM3, ESM2M and ESM2G with a spatial resolution of 2 degrees latitude by 2.5 degrees longitude. Each model has future outputs for the AR5 Representative Concentration Pathways ranging from 2006-2100. -### CM3 +## CM3 GFDL’s CMIP5 experiments with CM3 included many of the integrations found in the long-term CMIP5 experimental design. The focus of this physical climate model is on the role of aerosols, aerosol-cloud interactions, and atmospheric chemistry in climate variability and climate change. -### ESM2M & ESM2G +## ESM2M & ESM2G Two new models representing ocean physics with alternative numerical frameworks to explore the implications of some of the fundamental assumptions embedded in these models. Both ESM2M and ESM2G utilize a more advanced land model, LM3, than was available in ESM2.1 including a variety of enhancements (Milly et al., in prep). GFDL’s CMIP5 experiments with Earth System Models included many of the integrations found in the long-term CMIP5 experimental design. The ESMs, by design, close the carbon cycle and are used to study the impact of climate change on ecosystems, ecosystem changes on climate and human activities on ecosystems. diff --git a/book_source/03_topical_pages/07_remote_access/01_pecan_api.Rmd b/book_source/03_topical_pages/07_remote_access/01_pecan_api.Rmd new file mode 100644 index 00000000000..0b15310149e --- /dev/null +++ b/book_source/03_topical_pages/07_remote_access/01_pecan_api.Rmd @@ -0,0 +1,1395 @@ +# PEcAn Project API + +## Introduction + +__Welcome to the PEcAn Project API Documentation.__ + +The Predictive Ecosystem Analyser (PEcAn) Project is an open source framework initiated to meet the demands for more accessible, transparent & repeatable modeling of ecosystems. PEcAn can be considered as an ecoinformatics toolbox combined with a set of workflows that wrap around ecosystem models that allow users to effectively perform data synthesis, propagation of uncertainty through a model & ecological predictions in an integrated fashion using a diverse repository of data & models. + +Our API allows users to remotely interact with the PEcAn servers and leverage the functionalities provided by the PEcAn Project. It has been designed to follow common RESTful API conventions. Most operations are performed using the HTTP methods: `GET` (retrieve) & `POST` (create). + +_Please note that the PEcAn Project API is currently under active development and is possible that any information in this document is subject to change._ + +## Authentication + +Authentication to the PEcAn API occurs via [Basic HTTP Auth](https://en.wikipedia.org/wiki/Basic_access_authentication). The credentials for using the API are the same as those used to log into PEcAn & BetyDB. Here is how you use basic HTTP auth with `curl`: +``` +$ curl --user ':' +``` + +Authentication also depends on the PEcAn server that the user interacts with. Some servers, at the time of deployment have the `AUTH_REQ = FALSE`, meaning that such servers do not require user autertication for the usage of the PEcAn APIs. Regardless of the type of server, the endpoints defind under General section can be accessed without any authentication. + +## RESTful API Endpoints + +This page contains the high-level overviews & the functionalities offered by the different RESTful endpoints of the PEcAn API. + +__For the most up-to-date documentation, you can visit the [PEcAn API Documentation](http://pecan-dev.ncsa.illinois.edu/swagger/).__ + +The currently implemented functionalities include: + +* __General:__ + * [`GET /api/ping`](#get-apiping): Ping the server to check if it is live + * [`GET /api/status`](#get-apistatus): Obtain general information about PEcAn & the details of the database host + +* __Models:__ + * [`GET /api/models/`](#get-apimodels): Search for model(s) using search pattern based on model name & revision + * [`GET /api/models/{model_id}`](#get-apimodelsmodel_id): Fetch the details of specific model + +* __Sites:__ + * [`GET /api/sites/`](#get-apisites): Search for site(s) using search pattern based on site name + * [`GET /api/sites/{site_id}`](#get-apisitessite_id): Fetch the details of specific site + +* __PFTs:__ + * [`GET /api/pfts/`](#get-apipfts): Search for PFT(s) using search pattern based on PFT name, PFT type & Model type + * [`GET /api/pfts/{pft_id}`](#get-apipftspft_id): Fetch the details of specific PFT + +* __Formats:__ + * [`GET /api/formats/`](#get-apiformats): Search for format(s) using search pattern based on format name & mime type + * [`GET /api/formats/{format_id}`](#get-formatsformat_id): Fetch the details of specific Format + +* __Inputs:__ + * [`GET /api/inputs/`](#get-apiinputs): Search for inputs needed for a PEcAn workflow based on `model_id`, `site_id`, `format_id` & `host_id`. + * [`GET /api/inputs/{input_id}`](#get-apiinputsinput_id) *: Download the desired input file (if the `input_id` corresponds to a folder, an optional `filename` argument must be provided) + +* __Workflows:__ + * [`GET /api/workflows/`](#get-apiworkflows): Retrieve a list of PEcAn workflows + * [`POST /api/workflows/`](#post-apiworkflows): Submit a new PEcAn workflow + * [`GET /api/workflows/{id}`](#get-apiworkflowsid): Obtain the details of a particular PEcAn workflow by supplying its ID + * [`GET /api/workflows/{id}/status`](#get-apiworkflowsidstatus): Obtain the status of a particular PEcAn workflow + * [`GET /api/workflows/{id}/file/{filename}`](#get-apiworkflowsidfilefilename): Download the desired file from a PEcAn workflow + +* __Runs:__ + * [`GET /api/runs`](#get-apiruns): Get the list of all the runs + * [`GET /api/runs/{run_id}`](#get-apirunsrun_id): Fetch the details of a specified PEcAn run + * [`GET /api/runs/{run_id}/input/{filename}`](#get-apirunsrun_idinputfilename): Download the desired input file for a run + * [`GET /api/runs/{run_id}/output/{filename}`](#get-apirunsrun_idoutputfilename): Download the desired output file for a run + * [`GET /api/runs/{run_id}/graph/{year}/{y_var}`](#get-apirunsrun_idgraphyeary_var): Plot the graph of desired output variables for a run + +_* indicates that the particular API is under development & may not be ready for use_ + + +## Examples: + +### Prerequisites to interact with the PEcAn API Server {.tabset .tabset-pills} + +#### R Packages +* [httr](https://cran.r-project.org/web/packages/httr/index.html) +* [jsonlite](https://cran.r-project.org/web/packages/jsonlite/index.html) +* [xml2](https://cran.r-project.org/web/packages/xml2/index.html) + +#### Python Packages +* [requests](https://requests.readthedocs.io/en/master/) +* [json](https://docs.python.org/3/library/json.html) +* [xml](https://docs.python.org/3/library/xml.html) + +### {-} + + +Following are some example snippets to call the PEcAn API endpoints: + +### `GET /api/ping` {.tabset .tabset-pills} + +#### R Snippet + +```R +res <- httr::GET("http://localhost:8000/api/ping") +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $request +## [1] "ping" + +## $response +## [1] "pong" +``` +#### Python Snippet + +```python +response = requests.get("http://localhost:8000/api/ping") +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "request": "ping", +## "response": "pong" +## } +``` +### {-} + + +### `GET /api/status` {.tabset .tabset-pills} + +#### R Snippet + +```R +res <- httr::GET("http://localhost:8000/api/status") +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $pecan_details$version +## [1] "1.7.0" + +## $pecan_details$branch +## [1] "develop" + +## $pecan_details$gitsha1 +## [1] "unknown" + +## $host_details$hostid +## [1] 99 + +## $host_details$hostname +## [1] "" + +## $host_details$start +## [1] 99000000000 + +## $host_details$end +## [1] 99999999999 + +## $host_details$sync_url +## [1] "" + +## $host_details$sync_contact +## [1] "" +``` + +#### Python Snippet + +```python +response = requests.get("http://localhost:8000/api/status") +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "pecan_details": { +## "version": "1.7.0", +## "branch": "develop", +## "gitsha1": "unknown" +## }, +## "host_details": { +## "hostid": 99, +## "hostname": "", +## "start": 99000000000, +## "end": 99999999999, +## "sync_url": "", +## "sync_contact": "" +## } +## } +``` + +### {-} + +### `GET /api/models/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Search model(s) with `model_name` containing "sip" & `revision` containing "ssr" +res <- httr::GET( + "http://localhost:8000/api/models/?model_name=sip&revision=ssr&ignore_case=TRUE", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $models +## model_id model_name revision +## 1 1000000022 SIPNET ssr + +## $count +## [1] 1 +``` + +#### Python Snippet + +```python +# Search model(s) with `model_name` containing "sip" & `revision` containing "ssr" +response = requests.get( + "http://localhost:8000/api/models/?model_name=sip&revision=ssr&ignore_case=TRUE", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "models": [ +## { +## "model_id": "1000000022", +## "model_name": "SIPNET", +## "revision": "ssr" +## } +## ], +## "count": 1 +## } +``` + +### {-} + +### `GET /api/models/{model_id}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Fetch the details of PEcAn model with id = 1000000022 +res <- httr::GET( + "http://localhost:8000/api/models/1000000022", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $modeltype_id +## [1] 3 + +## $model_type +## [1] "SIPNET" + +## $model_id +## [1] 1000000022 + +## $model_name +## [1] "SIPNET" + +## $revision +## [1] "ssr" + +## $inputs +## input required +## 1 met TRUE +## 2 poolinitcond FALSE +``` + +#### Python Snippet + +```python +# Fetch the details of PEcAn model with id = 1000000022 +response = requests.get( + "http://localhost:8000/api/models/1000000022", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "model_id": "1000000022", +## "model_name": "SIPNET", +## "revision": "ssr", +## "modeltype_id": 3, +## "model_type": "SIPNET" +## "inputs": [ +## { +## "input": "met", +## "required": TRUE +## }, +## { +## "input": "poolinitcond", +## "required": FALSE +## } +## ] +## } +``` + +### {-} + +### `GET /api/sites/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Search site(s) with `site_name` containing "willow" +res <- httr::GET( + "http://localhost:8000/api/sites/?sitename=willow&ignore_case=TRUE", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $sites +## id sitename +## 1 676 Willow Creek (US-WCr) +## 2 1108 Willow Creek (WC)-Chequamegon National Forest +## 3 1202 Tully_willow +## 4 1223 Saare SRF willow plantation +## 5 1000005151 Willow Creek (US-WCr) + +## $count +## [1] 5 +``` + +#### Python Snippet + +```python +# Search site(s) with `site_name` containing "willow" +response = requests.get( + "http://localhost:8000/api/models/?sitename=willow&ignore_case=TRUE", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "sites": [ +## { +## "id": 676, +## "sitename": "Willow Creek (US-WCr)" +## }, +## { +## "id": 1108, +## "sitename": "Willow Creek (WC)-Chequamegon National Forest" +## }, +## { +## "id": 1202, +## "sitename": "Tully_willow" +## }, +## { +## "id": 1223, +## "sitename": "Saare SRF willow plantation" +## }, +## { +## "id": 1000005151, +## "sitename": "Willow Creek (US-WCr)" +## } +## ], +## "count": 5 +## } +``` + +### {-} + +### `GET /api/sites/{site_id}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Fetch the details of PEcAn site with id = 676 +res <- httr::GET( + "http://localhost:8000/api/sites/676", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $id +## [1] 676 + +## $city +## [1] "Park Falls Ranger District" + +## $state +## [1] "Wisconsin" + +## $country +## [1] "US" + +## $mat +## [1] 4 + +## $map +## [1] 815 + +## $soil +## [1] "" + +## $som +## [1] "NA" + +## $notes +## [1] "MF" + +## $soilnotes +## [1] "" + +## $sitename +## [1] "Willow Creek (US-WCr)" + +## $greenhouse +[1] FALSE + +## $sand_pct +## [1] 42.52 + +## $clay_pct +## [1] 20.17 + +## $time_zone +## [1] "America/Chicago" +``` + +#### Python Snippet + +```python +# Fetch the details of PEcAn site with id = 676 +response = requests.get( + "http://localhost:8000/api/sites/676", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "id": 676, +## "city": "Park Falls Ranger District", +## "state": "Wisconsin", +## "country": "US", +## "mat": 4, +## "map": 815, +## "soil": "", +## "notes": "MF", +## "soilnotes": "", +## "sitename": "Willow Creek (US-WCr)", +## "greenhouse": false, +## "sand_pct": 42.52, +## "clay_pct": 20.17, +## "time_zone": "America/Chicago" +## } +``` + +### {-} + +### `GET /api/pfts/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Search pft(s) of "plant" type with `pft_name` containing "temperate" & belonging to `model_type` "SIPNET" +res <- httr::GET( + "http://localhost:8000/api/pfts/?pft_name=temperate&pft_type=plant&model_type=sipnet&ignore_case=TRUE", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $pfts +## model_type pft_id pft_name pft_type +## +## 1 SIPNET 41 temperate.deciduous plant +## 2 SIPNET 1000000105 temperate.deciduous.IF plant +## 3 SIPNET 1000000107 temperate.deciduous_SDA plant +## 4 SIPNET 1000000115 temperate.deciduous.ALL plant +## 5 SIPNET 1000000118 temperate.deciduous.ALL.NORMAL plant +## 6 SIPNET 2000000017 tundra.deciduous.NGEE_Arctic plant +## 7 SIPNET 2000000045 temperate.broadleaf.deciduous plant + +## $count +## [1] 7 +``` + +#### Python Snippet + +```python +# Search pft(s) of "plant" type with `pft_name` containing "temperate" & belonging to `model_type` "SIPNET" +response = requests.get( + "http://localhost:8000/api/pfts/?pft_name=temperate&pft_type=plant&model_type=sipnet&ignore_case=TRUE", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "pfts": [ +## { +## "model_type": "SIPNET", +## "pft_id": 41, +## "pft_name": "temperate.deciduous", +## "pft_type": "plant" +## }, +## ... +## ], +## "count": 7 +## } +``` + +### {-} + +### `GET /api/pfts/{pft_id}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Fetch the details of PEcAn PFT with id = 2000000045 +res <- httr::GET( + "http://localhost:8000/api/pfts/2000000045", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $model_type +## [1] "SIPNET" + +## $pft_id +## [1] 2000000045 + +## $pft_name +## [1] "temperate.broadleaf.deciduous" + +## $definition +## [1] "SIPNET Temperate Deciduous PFT with priors on all parameters" + +## $pft_type +## [1] "plant" +``` + +#### Python Snippet + +```python +# Fetch the details of PEcAn PFT with id = 2000000045 +response = requests.get( + "http://localhost:8000/api/pfts/2000000045", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "model_type": "SIPNET", +## "pft_id": 2000000045, +## "pft_name": "temperate.broadleaf.deciduous", +## "definition": "SIPNET Temperate Deciduous PFT with priors on all parameters", +## "pft_type": "plant" +## } +``` + +### {-} + +### `GET /api/formats/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Search format(s) with name containing 'ameriflux' & mime type containing 'csv' +res <- httr::GET( + "http://localhost:8000/api/formats/?format_name=ameriflux&mimetype=csv&ignore_case=TRUE", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $formats +## mimetype format_id format_name +## 1 text/csv 19 AmeriFlux.level4.h +## 2 text/csv 20 AmeriFlux.level4.d +## 3 text/csv 21 AmeriFlux.level4.w +## 4 text/csv 22 AmeriFlux.level4.m +## 5 text/csv 35 AmeriFlux.level2.h +## 6 text/csv 36 AmeriFlux.level3.h + +## $count +## [1] 6 +``` + +#### Python Snippet + +```python +# # Search format(s) with name containing 'ameriflux' & mime type containing 'csv' +response = requests.get( + "http://localhost:8000/api/formats/?format_name=ameriflux&mimetype=csv&ignore_case=TRUE", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "formats": [ +## { +## "mimetype": "text/csv", +## "format_id": 19, +## "format_name": "AmeriFlux.level4.h" +## }, +## { +## "mimetype": "text/csv", +## "format_id": 20, +## "format_name": "AmeriFlux.level4.d" +## }, +## ... +## ], +## "count": 6 +## } + +``` + +### {-} + +### `GET /api/formats/{format_id}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Fetch the details of PEcAn format with id = 19 +res <- httr::GET( + "http://localhost:8000/api/formats/19", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $mimetype +## [1] "text/csv" + +## $format_id +## [1] 19 + +## $name +## [1] "AmeriFlux.level4.h" + +## $notes +## [1] "Half-hourly AmeriFlux level 4 gap filled, partitioned, and flagged flux tower data. Variables description: Level 4 data are obtained from the level 3 products, data are ustar filtered, gap-filled using different methods (ANN and MDS) and partitioned (i.e. NEE, GPP, and Re). Flags with information regarding quality of the original and gapfilled data are added. Missing values: -9999." + +## $header +## [1] "" + +## $format_variables +## description name unit +## 1 Latent heat flux LE_f W m-2 +## 2 Sensible heat flux H_f W m-2 +## 3 air temperature Ta_f degrees C +## 4 Vapor Pressure Deficit VPD_f Pa +## 5 Cumulative ecosystem respiration over a specified time step Reco umol C02 m-2 s-1 +## 6 Net ecosystem exchange NEE_st_fMDS umol C m-2 s-1 +``` + +#### Python Snippet + +```python +# Fetch the details of PEcAn format with id = 19 +response = requests.get( + "http://localhost:8000/api/formats/19", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "mimetype": "text/csv", +## "format_id": 19, +## "name": "AmeriFlux.level4.h", +## "notes": "Half-hourly AmeriFlux level 4 gap filled, partitioned, and flagged flux tower data. Variables description: ## Level 4 data are obtained from the level 3 products, data are ustar filtered, gap-filled using different methods (ANN and ## MDS) and partitioned (i.e. NEE, GPP, and Re). Flags with information regarding quality of the original and gapfilled data ## are added. Missing values: -9999.", +## "header": "", +## "format_variables": [ +## { +## "description": "Latent heat flux", +## "name": "LE_f", +## "unit": "W m-2" +## }, +## ... +## ] +## } +``` + +### {-} + +### `GET /api/inputs/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Get the inputs needed for a workflow with model_id = 1000000022 & site_id = 676 +res <- httr::GET( + "http://localhost:8000/api/inputs/?model_id=1000000022&site_id=676", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $inputs +## sitename model_name revision tag hostname file_name format_name mimetype +## 1 Willow Creek (US-WCr) SIPNET ssr met ebi-forecast.igb.illinois.edu wcr.clim Sipnet.climna text/csv +## 2 Willow Creek (US-WCr) SIPNET ssr met docker wcr.clim Sipnet.climna text/csv +## file_path id input_name start_date end_date +## 1 /home/share/data/dbfiles/ 235 2000-01-01 06:00:00 2007-01-01 05:59:00 +## 2 /data/sites/willow 2000000001 1998-01-01 00:00:00 2006-12-31 00:00:00 + +## $count +## [1] 2 +``` + +```R +# Get the inputs needed for a workflow with format_id = 5000000002 (AMERIFLUX_BASE_HH) & host_id = 99000000001 (docker) +res <- httr::GET( + "http://localhost:8000/api/inputs/?format_id=5000000002&host_id=99000000001", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $inputs +## sitename mimetype format_name hostname file_name +## 1 Niwot Ridge Forest/LTER NWT1 (US-NR1) text/csv AMERIFLUX_BASE_HH docker AMF_US-NR1_BASE_HH_15-5 +## file_path id input_name start_date end_date +## 1 /data/dbfiles/AmerifluxLBL_site_0-772 1000011238 AmerifluxLBL_site_0-772 1998-01-01 2016-12-31 + +## $count +## [1] 1 +``` + +#### Python Snippet + +```python +# Get the inputs needed for a workflow with model_id = 1000000022 & site_id = 676 +response = requests.get( + "http://localhost:8000/api/inputs/?model_id=1000000022&site_id=676", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "inputs": [ +## { +## "sitename": "Willow Creek (US-WCr)", +## "model_name": "SIPNET", +## "revision": "ssr", +## "tag": "met", +## "hostname": "ebi-forecast.igb.illinois.edu", +## "file_name": "wcr.clim", +## "format_name": "Sipnet.climna", +## "mimetype": "text/csv", +## "file_path": "/home/share/data/dbfiles/", +## "id": 235, +## "input_name": "", +## "start_date": "2000-01-01 06:00:00", +## "end_date": "2007-01-01 05:59:00" +## }, +## ... +## ], +## "count": 2 +## } +``` + +```python +# Get the inputs needed for a workflow with format_id = 5000000002 (AMERIFLUX_BASE_HH) & host_id = 99000000001 (docker) +response = requests.get( + "http://localhost:8000/api/inputs/?format_id=5000000002&host_id=99000000001", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "inputs": [ +## { +## "sitename": "Niwot Ridge Forest/LTER NWT1 (US-NR1)", +## "hostname": "docker", +## "file_name": "AMF_US-NR1_BASE_HH_15-5", +## "format_name": "AMERIFLUX_BASE_HH", +## "mimetype": "text/csv", +## "file_path": "/data/dbfiles/AmerifluxLBL_site_0-772", +## "id": 1000011238, +## "input_name": "AmerifluxLBL_site_0-772", +## "start_date": "1998-01-01", +## "end_date": "2016-12-31" +## } +## ], +## "count": 1, +## } +``` + +### {-} + +### `GET /api/inputs/{input_id}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Download the input file with id = 99000000003 +res <- httr::GET( + "http://localhost:8000/api/inputs/99000000003", + httr::authenticate("carya", "illinois") + ) +writeBin(res$content, "test.2002.nc") + +# Download the file 'fraction.plantation' from the input directory with id = 295 +res <- httr::GET( + "http://localhost:8000/api/inputs/295?filename=fraction.plantation", + httr::authenticate("carya", "illinois") + ) +writeBin(res$content, "test.fraction.plantation") +``` + +#### Python Snippet + +```python +# Download the input file for with id = 99000000003 +response = requests.get( + "http://localhost:8000/api/inputs/99000000003", + auth=HTTPBasicAuth('carya', 'illinois') + ) +with open("test.2002.nc", "wb") as file: + file.write(response.content) + +# Download the file 'fraction.plantation' from the input directory with id = 295 +response = requests.get( + "http://localhost:8000/api/inputs/295?filename=fraction.plantation", + auth=HTTPBasicAuth('carya', 'illinois') + ) +with open("test.2002.nc", "wb") as file: + file.write(response.content) +``` + +### {-} + +### `GET /api/workflows/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Get workflow(s) that use `model_id` = 1000000022 [SIPNET] & `site_id` = 676 [Willow Creek (US-WCr)] +res <- httr::GET( + "http://localhost:8000/api/workflows/?model_id=1000000022&site_id=676", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $workflows +## id folder started_at site_id model_id hostname start_date end_date +## 1 1000009900 /fs/data2/output//PEcAn_1000009900 2018-11-09 08:56:37 676 1000000022 geo.bu.edu 2004-01-01 2004-12-31 +## 2 1000009172 /fs/data2/output//PEcAn_1000009172 2018-04-11 18:14:52 676 1000000022 test-pecan.bu.edu 2004-01-01 2004-12-31 +## ... + +## $count +## [1] 5 +``` + +#### Python Snippet + +```python +# Get workflow(s) that use `model_id` = 1000000022 [SIPNET] & `site_id` = 676 [Willow Creek (US-WCr)] +response = requests.get( + "http://localhost:8000/api/workflows/?model_id=1000000022&site_id=676", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "workflows": [ +## { +## "id": 1000009172, +## "folder": "/fs/data2/output//PEcAn_1000009900", +## "started_at": "2018-11-09 08:56:37", +## "site_id": 676, +## "model_id": 1000000022, +## "hostname": "geo.bu.edu", +## "start_date": "2004-01-01", +## "end_date": "2004-12-31" +## }, +## ... +## ], +## "count": 5 +## } +``` + +### {-} + +### `POST /api/workflows/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Submit a workflow in XML format for execution +xmlFile <- "pecan/tests/api.sipnet.xml" +xml_string <- paste0(xml2::read_xml(xmlFile)) +res <- httr::POST( + "http://localhost:8000/api/workflows/", + httr::authenticate("carya", "illinois"), + httr::content_type("application/xml"), + body = xml_string + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $workflow_id +## [1] 99000000001 + +## $status +## [1] "Submitted successfully" +``` + +#### Python Snippet + +```python +# Submit a workflow in XML format for execution +xml_file = "pecan/tests/api.sipnet.xml" +root = xml.etree.ElementTree.parse(xml_file).getroot() +response = requests.post( + "http://localhost:8000/api/workflows/", + auth=HTTPBasicAuth('carya', 'illinois'), + headers = {'Content-Type': 'application/xml'}, + data = xml.etree.ElementTree.tostring(root, encoding='unicode', method='xml') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "workflow_id": "99000000001", +## "status": "Submitted successfully" +## } +``` + +### {-} + +### `GET /api/workflows/{id}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Get details of workflow with `id` = '1000009172' +res <- httr::GET( + "http://localhost:8000/api/workflows/1000009172", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $id +## [1] "1000009172" + +## $folder +## [1] "/fs/data2/output//PEcAn_1000009172" + +## $hostname +## [1] "test-pecan.bu.edu" + +## $user_id +## [1] "NA" + +## $properties +## $properties$end +## [1] "2004/12/31" + +## $properties$pft +## $properties$pft[[1]] +## [1] "soil.IF" + +## $properties$pft[[2]] +## [1] "temperate.deciduous.IF" + + +## $properties$email +## [1] "" + +## $properties$notes +## [1] "" + +## $properties$start +## [1] "2004/01/01" + +## $properties$siteid +## [1] "676" + +## $properties$modelid +## [1] "1000000022" + +## $properties$hostname +## [1] "test-pecan.bu.edu" + +## $properties$sitename +## [1] "WillowCreek(US-WCr)" + +## $properties$input_met +## [1] "AmerifluxLBL.SIPNET" + +## $properties$pecan_edit +## [1] "on" + +## $properties$sitegroupid +## [1] "1000000022" + +## $properties$fluxusername +## [1] "pecan" + +## $properties$input_poolinitcond +## [1] "-1" +``` + +#### Python Snippet + +```python +# Get details of workflow with `id` = '1000009172' +response = requests.get( + "http://localhost:8000/api/workflows/1000009172", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "id": "1000009172", +## "folder": "/fs/data2/output//PEcAn_1000009172", +## "hostname": "test-pecan.bu.edu", +## "user_id": "NA", +## "properties": { +## "end": "2004/12/31", +## "pft": [ +## "soil.IF", +## "temperate.deciduous.IF" +## ], +## "email": "", +## "notes": "", +## "start": "2004/01/01", +## "siteid": "676", +## "modelid": "1000000022", +## "hostname": "test-pecan.bu.edu", +## "sitename": "WillowCreek(US-WCr)", +## "input_met": "AmerifluxLBL.SIPNET", +## "pecan_edit": "on", +## "sitegroupid": "1000000022", +## "fluxusername": "pecan", +## "input_poolinitcond": "-1" +## } +## } +``` + +### {-} + +### `GET /api/workflows/{id}/status` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Get list of run belonging to the workflow with `workflow_id` = '99000000001' +res <- httr::GET( + "http://localhost:8000/api/workflows/99000000001/status", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $workflow_id +## [1] "99000000001" + +## $status +## [1] "TRAIT 2020-07-22 07:02:33 2020-07-22 07:02:35 DONE " +## [2] "META 2020-07-22 07:02:35 2020-07-22 07:02:38 DONE " +## [3] "CONFIG 2020-07-22 07:02:38 2020-07-22 07:02:40 DONE " +## [4] "MODEL 2020-07-22 07:02:40 2020-07-22 07:04:07 DONE " +## [5] "OUTPUT 2020-07-22 07:04:07 2020-07-22 07:04:08 DONE " +## [6] "ENSEMBLE 2020-07-22 07:04:08 2020-07-22 07:04:09 DONE " +## [7] "SENSITIVITY 2020-07-22 07:04:09 2020-07-22 07:04:16 DONE " +## [8] "FINISHED 2020-07-22 07:04:16 2020-07-22 07:04:16 DONE " +``` + +#### Python Snippet + +```python +# Get list of run belonging to the workflow with `workflow_id` = '99000000001' +response = requests.get( + "http://localhost:8000/api/workflows/99000000001/status", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "workflow_id": "99000000001", +## "status": [ +## "TRAIT 2020-07-22 07:02:33 2020-07-22 07:02:35 DONE ", +## "META 2020-07-22 07:02:35 2020-07-22 07:02:38 DONE ", +## "CONFIG 2020-07-22 07:02:38 2020-07-22 07:02:40 DONE ", +## "MODEL 2020-07-22 07:02:40 2020-07-22 07:04:07 DONE ", +## "OUTPUT 2020-07-22 07:04:07 2020-07-22 07:04:08 DONE ", +## "ENSEMBLE 2020-07-22 07:04:08 2020-07-22 07:04:09 DONE ", +## "SENSITIVITY 2020-07-22 07:04:09 2020-07-22 07:04:16 DONE ", +## "FINISHED 2020-07-22 07:04:16 2020-07-22 07:04:16 DONE " +## ] +## } +``` +### {-} + +### `GET /api/workflows/{id}/file/{filename}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Download the 'ensemble.ts.99000000017.NPP.2002.2002.Rdata' output file for the workflow with id = 99000000031 +res <- httr::GET( + "http://localhost:8000/api/workflows/99000000031/file/ensemble.ts.99000000017.NPP.2002.2002.Rdata", + httr::authenticate("carya", "illinois") + ) +writeBin(res$content, "test.ensemble.ts.99000000017.NPP.2002.2002.Rdata") +``` + +#### Python Snippet + +```python +# Download the 'ensemble.ts.99000000017.NPP.2002.2002.Rdata' output file for the workflow with id = 99000000031 +response = requests.get( + "http://localhost:8000/api/workflows/99000000031/file/ensemble.ts.99000000017.NPP.2002.2002.Rdata", + auth=HTTPBasicAuth('carya', 'illinois') + ) +with open("test.ensemble.ts.99000000017.NPP.2002.2002.Rdata", "wb") as file: + file.write(response.content) +``` + +### {-} + +### `GET /api/runs/` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Get list of run belonging to the workflow with `workflow_id` = '1000009172' +res <- httr::GET( + "http://localhost:8000/api/runs/?workflow_id=1000009172", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $runs +## runtype ensemble_id workflow_id id model_id site_id parameter_list start_time +## finish_time +## 1 ensemble 1000017624 1000009172 1002042201 1000000022 796 ensemble=1 2005-01-01 +## 00:00:00 2011-12-31 00:00:00 +## ... + +## $count +## [1] 50 +``` + +#### Python Snippet + +```python +# Get list of run belonging to the workflow with `workflow_id` = '1000009172' +response = requests.get( + "http://localhost:8000/api/runs/?workflow_id=1000009172", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "runs": [ +## { +## "runtype": "ensemble", +## "ensemble_id": 1000017624, +## "workflow_id": 1000009172, +## "id": 1002042201, +## "model_id": 1000000022, +## "site_id": 796, +## "parameter_list": "ensemble=1", +## "start_time": "2005-01-01", +## "finish_time": "2011-12-31" +## }, +## ... +## ] +## "count": 50, +## "next_page": "http://localhost:8000/api/workflows/?workflow_id=1000009172&offset=50&limit=50" +## } +``` + +### {-} + +### `GET /api/runs/{run_id}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Get details of run belonging with `id` = '99000000282' +res <- httr::GET( + "http://localhost:8000/api/runs/99000000282", + httr::authenticate("carya", "illinois") + ) +print(jsonlite::fromJSON(rawToChar(res$content))) +``` +``` +## $runtype +## [1] "sensitivity analysis" + +## $ensemble_id +## [1] 99000000016 + +## $workflow_id +## [1] 99000000031 + +## $id +## [1] 99000000282 + +## $model_id +## [1] 1000000014 + +## $site_id +## [1] 772 + +## $start_time +## [1] "2002-01-01" + +## $finish_time +## [1] "2002-12-31" + +## $parameter_list +## [1] "quantile=MEDIAN,trait=all,pft=temperate.coniferous" + +## $started_at +## [1] "2020-07-22 07:02:40" + +## $finished_at +## [1] "2020-07-22 07:02:57" + +## $inputs +## $inputs$info +## [1] "README.txt" + +## $inputs$others +## [1] "sipnet.clim" "sipnet.in" "sipnet.param" "sipnet.param-spatial" + +## $outputs +## $outputs$logfile +## [1] "logfile.txt" + +## $outputs$info +## [1] "README.txt" + +## $outputs$years +## $outputs$years$`2002` +## $outputs$years$`2002`$data +## [1] "2002.nc" + +## $outputs$years$`2002`$variables +## $outputs$years$`2002`$variables$GPP +## [1] "Gross Primary Productivity" + +## $outputs$years$`2002`$variables$NPP +## [1] "Net Primary Productivity" + +## ... +``` + +#### Python Snippet + +```python +# Get details of run with `id` = '1002042201' +response = requests.get( + "http://localhost:8000/api/runs/1002042201", + auth=HTTPBasicAuth('carya', 'illinois') + ) +print(json.dumps(response.json(), indent=2)) +``` +``` +## { +## "runtype": "ensemble", +## "ensemble_id": 1000017624, +## "workflow_id": 1000009172, +## "id": 1002042201, +## "model_id": 1000000022, +## "site_id": 796, +## "parameter_list": "ensemble=1", +## "start_time": "2005-01-01", +## "finish_time": "2011-12-31", +## "inputs": { +## "info": "README.txt", +## "others": [ +## "sipnet.clim", +## "sipnet.in", +## "sipnet.param", +## "sipnet.param-spatial" +## ] +## } +## "outputs": { +## "logfile": "logfile.txt", +## "info": "README.txt", +## "years": { +## "2002": { +## "data": "2002.nc", +## "variables": { +## "GPP": "Gross Primary Productivity", +## "NPP": "Net Primary Productivity", +## ... +## } +## } +## } +## } +## } +``` + +### {-} + +### `GET /api/runs/{run_id}/input/{filename}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Download the 'sipnet.in' input file for the run with id = 99000000282 +res <- httr::GET( + "http://localhost:8000/api/runs/99000000282/input/sipnet.in", + httr::authenticate("carya", "illinois") + ) +writeBin(res$content, "test.sipnet.in") +``` + +#### Python Snippet + +```python +# Download the 'sipnet.in' input file for the run with id = 99000000282 +response = requests.get( + "http://localhost:8000/api/runs/99000000282/input/sipnet.in", + auth=HTTPBasicAuth('carya', 'illinois') + ) +with open("test.sipnet.in", "wb") as file: + file.write(response.content) +``` + +### {-} + +### `GET /api/runs/{run_id}/output/{filename}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Download the '2002.nc' output file for the run with id = 99000000282 +res <- httr::GET( + "http://localhost:8000/api/runs/99000000282/output/2002.nc", + httr::authenticate("carya", "illinois") + ) +writeBin(res$content, "test.2002.nc") +``` + +#### Python Snippet + +```python +# Download the '2002.nc' output file for the run with id = 99000000282 +response = requests.get( + "http://localhost:8000/api/runs/99000000282/output/2002.nc", + auth=HTTPBasicAuth('carya', 'illinois') + ) +with open("test.2002.nc", "wb") as file: + file.write(response.content) +``` + +### {-} + +### `GET /api/runs/{run_id}/graph/{year}/{y_var}` {.tabset .tabset-pills} + +#### R Snippet + +```R +# Plot the Gross Primary Productivity vs Time for the run with ID `99000000282` for the year 2002 +res <- httr::GET( + "http://localhost:8000/api/runs/99000000282/graph/2002/GPP", + httr::authenticate("carya", "illinois") + ) +writeBin(res$content, "test.png") +``` +```{r, echo=FALSE, fig.align='center'} +knitr::include_graphics(rep("figures/run_output_plot.png")) +``` + +#### Python Snippet + +```python +# Plot the Gross Primary Productivity vs Time for the run with ID `99000000282` for the year 2002 +response = requests.get( + "http://localhost:8000/api/runs/99000000282/graph/2002/GPP", + auth=HTTPBasicAuth('carya', 'illinois') + ) +with open("test.png", "wb") as file: + file.write(response.content) +``` +```{r, echo=FALSE, fig.align='center'} +knitr::include_graphics(rep("figures/run_output_plot.png")) +``` + + +### {-} diff --git a/book_source/03_topical_pages/08_Database-Synchronization.Rmd b/book_source/03_topical_pages/08_Database-Synchronization.Rmd index 34b1077cbcc..d587339e45a 100644 --- a/book_source/03_topical_pages/08_Database-Synchronization.Rmd +++ b/book_source/03_topical_pages/08_Database-Synchronization.Rmd @@ -1,16 +1,16 @@ -# Database synchronization +# Database synchronization {#database-sync} The database synchronization consists of 2 parts: - Getting the data from the remote servers to your server - Sharing your data with everybody else -### How does it work? +## How does it work? Each server that runs the BETY database will have a unique machine_id and a sequence of ID's associated. Whenever the user creates a new row in BETY it will receive an ID in the sequence. This allows us to uniquely identify where a row came from. This is information is crucial for the code that works with the synchronization since we can now copy those rows that have an ID in the sequence specified. If you have not asked for a unique ID your ID will be 99. The synchronization code itself is split into two parts, loading data with the `load.bety.sh` script and exporting data using `dump.bety.sh`. If you do not plan to share data, you only need to use `load.bety.sh` to update your database. -### Set up +## Set up Requests for new machine ID's is currently handled manually. To request a machine ID contact Rob Kooper . In the examples below this ID is referred to as 'my siteid'. @@ -21,7 +21,7 @@ sudo -u postgres {$PECAN}/scripts/load.bety.sh -c -u -m ``` WARNING: At the moment running CREATE deletes all current records in the database. If you are running from the VM this includes both all runs you have done and all information that the database is prepopulated with (e.g. input and model records). Remote records can be fetched (see below), but local records will be lost (we're working on improving this!) -### Fetch latest data +## Fetch latest data When logged into the machine you can fetch the latest data using the load.bety.sh script. The script will check what site you want to get the data for and will remove all data in the database associated with that id. It will then reinsert all the data from the remote database. @@ -62,7 +62,7 @@ dump.bety.sh -h -u should unchecked data be dumped, default is NO ``` -### Sharing data +## Sharing data Sharing your data requires a few steps. First, before entering any data, you will need to request an ID from the PEcAn developers. Simply open an issue at github and we will generate an ID for you. If possible, add the URL of your data host. @@ -92,7 +92,7 @@ NOTE: If you want your dumps to be accessible to other PEcAn servers you need to Plans to simplify this process are in the works -### Automation +## Automation Below is an example of a script to synchronize PEcAn database instances across the network. @@ -120,11 +120,11 @@ MAILTO=user@yourUniversity.edu 12 * * * * /home/dietze/db.sync.sh ``` -### Database maintentance +## Database maintentance All databases need maintenance performed on them. Depending upon the database type this can happen automatically, or it needs to be run through a scheduler or manually. The BETYdb database is Postgresql and it needs to be reindexed and vacuumed on a regular basis. Reindexing introduces efficiencies back into the database by reorganizing the indexes. Vacuuming the database frees up resources to the database by rearranging and compacting the database. Both of these operations are necessary and safe. As always if there's a concern, a backup of the database should be made ahead of time. While running the reindexing and vacuuming commands, users will notice a slowdown at times. Therefore it's better to run these maintenance tasks during off hours. -#### Reindexing the database +### Reindexing the database As mentioned above, reindexing allows the database to become more efficient. Over time as data gets updated and deleted, the indexes become less efficient. This has a negative inpact on executed statements. Reindexing makes the indexes efficient again (at least for a while) allowing faster statement execution and reducing the overall load on the database. @@ -167,7 +167,7 @@ Splitting up the indexing commands over time allows the database to operate effi Please refere to the Automation section above for information on using cron to schedule reindexing commands. -#### Vacuuming the database +### Vacuuming the database Vacuuming the BETYdb Postgresql database reduces the amount of resources it uses and introduces its own efficiencies. @@ -223,17 +223,17 @@ psql -U bety -c "VACUUM yields; VACUUM FULL yields; VACUUM ANALYZE yields;" Give its impact, it's typically not desireable to perform a VACUUM FULL after every normal vacuum; it should be done on an "as needed" basis or infrequently. -### Troubleshooting +## Troubleshooting There are several possibilities if a scheduled cron job apepars to be running but isn't producing the expected results. The following are suggestions on what to try to resolve the issue. -##### Username and password +### Username and password The user that scheduled a cron job may not have access permissions to the database. This can be easily confirmed by running the command line from the cron job while logged in as the user that scheduled the job. An error message will be shown if the user doesn't have permissions. To resolve this, be sure to include a valid database user (not a BETYdb user) with their credentials on the command in crontab. -##### db_hba.conf file +### db_hba.conf file Iit's possible that the machine hosting the docker image of the database doesn't have permissions to access the database. This may due to the cron job running on a machine that is not the docker instance of the database. @@ -249,7 +249,7 @@ This command should return a series of text lines. For each row except those beg Ensure that the host machine is listed under the fourth column (machine addresse range, or 'all'), is also included in the IP mask if one was specified, and finally that any authentication option are not set to 'reject'. If the host machine is not included the db_hba.conf file will need to be updated to allow access. -### Network Status Map +## Network Status Map https://pecan2.bu.edu/pecan/status.php @@ -258,7 +258,7 @@ Nodes: red = down, yellow = out-of-date schema, green = good Edges: red = fail, yellow = out-of-date sync, green = good -### Tasks +## Tasks Following is a list of tasks we plan on working on to improve these scripts: - [pecanproject/bety#368](https://github.com/PecanProject/bety/issues/368) allow site-specific customization of information and UI elements including title, contacts, logo, color scheme. diff --git a/book_source/03_topical_pages/09_standalone_tools.Rmd b/book_source/03_topical_pages/09_standalone_tools.Rmd index 4fc1812df07..b9819fda433 100644 --- a/book_source/03_topical_pages/09_standalone_tools.Rmd +++ b/book_source/03_topical_pages/09_standalone_tools.Rmd @@ -5,7 +5,7 @@ - Allometry ([`modules/allometry`](https://pecanproject.github.io/modules/allometry/docs/index.html)); [vignette](https://pecanproject.github.io/modules/allometry/docs/articles/AllomVignette.html) - Load data ([`modules/benchmark`](https://pecanproject.github.io/modules/benchmark/docs/index.html) -- `PEcAn.benchmark::load_data`) -### Loading Data in PEcAn {#LoadData} +## Loading Data in PEcAn {#LoadData} If you are loading data in to PEcAn for benchmarking, using the Benchmarking shiny app [provide link?] is recommended. @@ -13,9 +13,7 @@ Data can be loaded manually using the `load_data` function which in turn require Below is a description of the `load_data` function an a simple example of loading data manually. -### Function `load_data` - -#### Inputs +### Inputs Required @@ -28,11 +26,12 @@ Optional - `end_year = NA`: - `site = NA` - `vars.used.index=NULL` -### Output + +### Output - R data frame containing the requested variables converted in to PEcAn standard name and units and time steps in `POSIX` format. -#### Example +### Example The data for this example has already been entered in to the database. To add new data go to [new data documentation](#NewInput). @@ -49,7 +48,7 @@ bety = PEcAn.DB::betyConnect(php.config = "pecan/web/config.php") 2. Look up the inputs record for the data in BETY. ```{r, echo=FALSE, out.height = "50%", out.width = "50%", fig.align = 'center'} -knitr::include_graphics("04_advanced_user_guide/images/Input_ID_name.png") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/Input_ID_name.png") ``` To find the input ID, either look at @@ -126,7 +125,7 @@ input.id = tbl(bety,"inputs") %>% filter(name == input_name) %>% pull(id) data.path = PEcAn.DB::query.file.path( input.id = input.id, host_name = PEcAn.remote::fqdn(), - con = bety$con) + con = bety) ``` 6. Load the data @@ -134,3 +133,246 @@ input.id = tbl(bety,"inputs") %>% filter(name == input_name) %>% pull(id) ```R data = PEcAn.benchmark::load_data(data.path = data.path, format = format) ``` + +## Remote data module +Remote data module retrieves remote sensing data from MODISTools, Google Earth Engine and AppEEARS. The downloaded data can be used while performing further analysis in PEcAn. + +#### Google Earth Engine +[Google Earth Engine](https://earthengine.google.com/) is a cloud-based platform for performing analysis on satellite data. It provides access to a [large data catalog](https://developers.google.com/earth-engine/datasets) through an online JavaScript code editor and a Python API. + +Datasets currently available for use in PEcAn via Google Earth Engine are, + +* [Sentinel-2 MSI](https://developers.google.com/earth-engine/datasets/catalog/COPERNICUS_S2_SR) [`gee2pecan_s2()`](https://github.com/PecanProject/pecan/blob/develop/modules/data.remote/inst/gee2pecan_s2.py) +* [SMAP Global Soil Moisture Data](https://developers.google.com/earth-engine/datasets/catalog/NASA_USDA_HSL_SMAP_soil_moisture) [`gee2pecan_smap()`](https://github.com/PecanProject/pecan/blob/develop/modules/data.remote/inst/gee2pecan_smap.py) +* [Landsat 8 Surface Reflectance](https://developers.google.com/earth-engine/datasets/catalog/LANDSAT_LC08_C01_T1_SR) [`gee2pecan_l8()`](https://github.com/PecanProject/pecan/blob/develop/modules/data.remote/inst/gee2pecan_l8.py) + +#### AppEEARS +[AppEEARS (Application for Extracting and Exploring Analysis Ready Samples)](https://lpdaacsvc.cr.usgs.gov/appeears/) is an online tool which provides an easy to use interface for downloading analysis ready remote sensing data. [Products available on AppEEARS.](https://lpdaacsvc.cr.usgs.gov/appeears/products) Note: AppEEARS uses a task based system for processing the data request, it is possible for a task to run for long hours before it gets completed. The module checks the task status after every 60 seconds and saves the files when the task gets completed. + +#### Processing functions currently available are, + +* [SNAP](https://github.com/PecanProject/pecan/blob/develop/modules/data.remote/inst/satellitetools/biophys_xarray.py) + +#### Set-Up instructions (first time and one time only): + +1. **Sign up for the Google Earth Engine**. Follow the instructions [here](https://earthengine.google.com/new_signup/) to sign up for using GEE. You need to have your own GEE account for using the GEE download functions in this module. + +2. **Sign up for NASA Earthdata**. Using AppEEARS requires an Earthdata account visit this [page](https://urs.earthdata.nasa.gov/users/new) to create your own account. + +3. **Install the RpTools package**. Python codes required by this module are stored in a Python package named "RpTools" using this requires Python3 and the package manager pip3 to be installed in your system. + To install the package, +a. Navigate to `pecan/modules/data.remote/inst/RpTools` If you are inside the pecan directory, this can be done by, +```bash +cd modules/data.remote/inst/RpTools +``` +b. Use pip3 to install the package. "-e" flag is used to install the package in an editable or develop mode, so that changes made to the code get updated in the package without reinstalling. +```bash +pip3 install -e . +``` +4. **Authenticate GEE**. The GEE API needs to be authenticated using your credentials. The credentials will be stored locally on your system. This can be done by, +```bash +#this will open a browser and ask you to sign in with the Google account registered for GEE +earthengine authenticate +``` +Alternate way, +```bash +python3 + +import ee +ee.Authenticate() +``` + +5. **Save the Earthdata credentials**. If you wish to use AppEEARS you will have to store your username and password inside a JSON file and then pass its file path as an argument in `remote_process` + +#### Usage guide: +This module is accesible using the R function `remote_process` which uses the Python package "RpTools" (located at `data.remote/inst/RpTools`) for downloading and processing data. RpTools has a function named `rp_control` which controls two other functions, + +1. `get_remote_data` which controls the scripts which are used for downloading data from the source. For example, `gee2pecan_s2` downloads bands from Sentinel 2 using GEE. + +2. `process_remote_data` which controls the scripts responsible for processing the raw data. For example, `bands2lai_snap` uses the downloaded bands to compute LAI using the SNAP algorithm. + +![Workflow of the module](03_topical_pages/11_images/remotemodule.png) + + +### Configuring `remote_process` + +`remote_process` is configured using remote data tags in the `pecan.xml`. The required tags are described below, + +```xml + + ... + ... + ... + ... + ... + ... + ... + ... + ... + ... + +``` + + +* `out_get_data`: (required) type of raw output requested, e.g, bands, smap +* `source`: (required) source of remote data, e.g., gee or appeears +* `collection`: (required) dataset or product name as it is provided on the source, e.g. "COPERNICUS/S2_SR" for gee or "SPL3SMP_E.003" for appeears +* `scale`: (optional) pixel resolution required for some gee collections, recommended to use 10 for Sentinel 2 **scale** Information about how GEE handles scale can be found out [here](https://developers.google.com/earth-engine/scale) +* `projection`: (optional) type of projection. Only required for appeears polygon AOI type +* `qc`: (optional) quality control parameter, required for some gee collections +* `overwrite`: (optional) if TRUE database checks will be skipped and existing data of same type will be replaced entirely. When processed data is requested, the raw data required for creating it will also be replaced. By default FALSE + +These tags are only required if processed data is requested: + +* `out_process_data`: (optional) type of processed output requested, e.g, lai +* `algorithm`: (optional) algorithm used for processing data, currently only SNAP is implemented to estimate LAI from Sentinel-2 bands +* `credfile`: (optional) absolute path to JSON file containing Earthdata username and password, only required for AppEEARS + +Additional information are taken from the registration files located at [pecan/modules/data.remote/inst/registration](https://github.com/PecanProject/pecan/tree/develop/modules/data.remote/inst/registration), each source has its own registration file. This is so because there isn't a standardized way to retrieve all image collections from GEE and each image collection may require its own way of performing quality checks, etc whereas all of the products available on AppEEARS can be retrieved using its API in a standardized way. + +GEE registration file (register.GEE.xml) : + +* `collection` + * `original_name` original name of the image collection, e.g. COPERNICUS/S2_SR + * `pecan_name` short form of original name using which the collection is represented in PEcAn, e.g. s2 +* `coord` + * `coord_type` coordinate type supported by the collection +* `scale` the default value of the scale can be specified here +* `qc` the default value of the qc parameter can be specified here +* `raw_format` format details of the raw file + * `id` id of the format + * `name` name of the format + * `mimetype` MIME type +* `pro_format` format details of the processed file when the collection is used to create a processed file + * `id` id of the format + * `name` name of the format + * `mimetype` MIME type + +AppEEARS registarion file (registrer.APPEEARS.xml) : + +* `coord` + * `coord_type` coordinate type supported by the product +* `raw_format` format details of the output file + * `id` id of the format + * `name` name of the format + * `mimetype` MIME type + +Remaining input data: + +* start date, end date: these are taken from the `run` tag in `pecan.xml` +* outdir: from the `outdir` tag in `pecan.xml` +* Area of interest: the coordinates and site name are found out from BETY using `siteid` present in the `run` tag. These are then used to create a GeoJSON file which is used by the download functions. + +The output data from the module are returned in the following tags: + +* `raw_id`: input id of the raw file +* `raw_path`: absolute path to the raw file +* `pro_id`: input id of the processed file +* `pro_path`: absolute path to the processed file + +**Output files**: + +The output files are of netCDF type and are stored in a directory inside the specified outdir with the following naming convention: `source_site_siteid` + +The output files are created with the following naming convention: `source_collection_scale_projection_qc_site_siteid_TimeStampOfFileCreation` + +Whenever a data product is requested the output files are stored in the inputs table of BETYdb. Subsequently when the same product is requested again with a different date range but with the same qc, scale, projection the previous file in the db would be extended. The DB would always contain only one file of the same type. +As an example, if a file containing Sentinel 2 bands for start date: 2018-01-01, end date: 2018-06-30 exists in the DB and the same product is requested again for a different date range one of the following cases would happen, + +1. New dates are ahead of the existing file: For example, if the requested dates are start: 2018-10-01, end: 2018-12-31 in this case the previous file will be extended forward meaning the effective start date of the file to be downloaded would be the day after the end date of the previous file record, i.e. 2018-07-01. The new and the previous file would be merged and the DB would now be having data for 2018-01-01 to 2018-12-31. + +2. New dates are preceding of the existing file: For example, if the requested dates are start: 2017-01-01, end: 2017-06-30 in this case the effective end date of the new download would be the day before the start date of the existing file, i.e., 2017-12-31. The new and the previous file would be merged and the file in the DB would now be having data for 2017-01-01 to 2018-06-30. + +3. New dates contain the date range of the existing file: For example, if the requested dates are start: 2016-01-01, end: 2019-06-30 here the existing file would be replaced entirely with the new file. A more efficient way of doing this could be to divide your request into two parts, i.e, first request for 2016-01-01 to 2018-01-01 and then for 2018-06-30 to 2019-06-30. + +When a processed data product such as SNAP-LAI is requested, the raw product (here Sentinel 2 bands) used to create it would also be stored in the DB. If the raw product required for creating the processed product already exists for the requested time period, the processed product would be created for the entire time period of the raw file. For example, if Sentinel 2 bands are present in the DB for 2017-01-01 to 2017-12-31 and SNAP-LAI is requested for 2017-03-01 to 2017-07-31, the output file would be containing LAI for 2017-01-01 to 2017-12-31. + + +#### Creating Polygon based sites + +A polygon site can be created in the BETYdb using the following way, + +``` +PEcAn.DB::db.query("insert into sites (country, sitename, geometry) values ('country_name', 'site_name', ST_SetSRID(ST_MakePolygon(ST_GeomFromText('LINESTRING(lon lat elevation)')), crs));", con) +``` + +Example, + +``` +db.query("insert into sites (country, sitename, geometry) values ('FI', 'Qvidja_ca6cm', ST_SetSRID(ST_MakePolygon(ST_GeomFromText('LINESTRING(22.388957339620813 60.287395608412218 14.503780364990234, 22.389600591651835 60.287182336733203 14.503780364990234, +22.38705422266651 60.285516177775868 14.503780364990234, +22.386575219445195 60.285763643883932 14.503780364990234, +22.388957339620813 60.287395608412218 14.503780364990234 )')), 4326));", con) +``` + +#### Example use (GEE) +This example will download Sentinel 2 bands and then use the SNAP algorithm to compute Leaf Area Index. + +1. Add remotedata tag to `pecan.xml` and configure it. + +```xml + + bands + gee + COPERNICUS/S2_SR + 10 + 1 + snap + LAI + +``` + +2. Store the contents of `pecan.xml` in a variable named `settings` and pass it to `remote_process`. + +``` +PEcAn.data.remote::remote_process(settings) +``` + +The output netCDF files(bands and LAI) will be saved at outdir and their records would be kept in the inputs table of BETYdb. + +#### Example use (AppEEARS) + +This example will download the layers of a SMAP product(SPL3SMP_E.003) + +1. Add remotedata tag to `pecan.xml` and configure it. + +```xml + + smap + appeears + SPL3SMP_E.003 + native + + path/to/jsonfile/containingcredentials + +``` + +2. Store the contents of `pecan.xml` in a variable named `settings` and pass it to `remote_process`. + +``` +PEcAn.data.remote::remote_process(settings) +``` + +The output netCDF file will be saved at outdir and its record would be kept in the inputs table of BETYdb. + + +#### Adding new GEE image collections + +Once you have the Python script for downloading the collection from GEE, please do the following to integrate it with this module. + +1. Make sure that the function and script names are same and named in the following way: `gee2pecan_pecancodeofimagecollection` + `pecancodeofimagecollection` can be any name which you want to use for representing the collection is an easier way. + Additionaly, ensure that the function accepts and uses the following arguments, + * `geofile` - (str) GeoJSON file containing AOI information of the site + * `outdir` - (str) path where the output file has to be saved + * `start` - (str) start date in the form YYYY-MM-DD + * `end` - (str) end date in the form YYYY-MM-DD + * `scale` and `qc` if applicable. + +2. Make sure the output file is of netCDF type and follows the naming convention described above. + +3. Store the Python script at `pecan/modules/data.remote/inst/RpTools/RpTools` + +4. Update the `register.GEE.xml` file. + +After performing these steps the script will be integrated with the remote data module and would be ready to use. diff --git a/book_source/03_topical_pages/10_shiny/shiny.Rmd b/book_source/03_topical_pages/10_shiny/shiny.Rmd index abdcc91df66..f805f11ae1b 100644 --- a/book_source/03_topical_pages/10_shiny/shiny.Rmd +++ b/book_source/03_topical_pages/10_shiny/shiny.Rmd @@ -1,6 +1,42 @@ -# SHINY +# Shiny -### Debugging Shiny Apps +## Testing the Shiny Server + +Shiny can be difficult to debug because, when run as a web service, the R output is hidden in system log files that are hard to find and read. +One useful approach to debugging is to use port forwarding, as follows. + +First, on the remote machine (including the VM), make sure R's working directory is set to the directory of the Shiny app (e.g., `setwd(/path/to/pecan/shiny/WorkflowPlots)`, or just open the app as an RStudio project). +Then, in the R console, run the app as: + +``` +shiny::runApp(port = XXXX) +# E.g. shiny::runApp(port = 5638) +``` + +Then, on your local machine, open a terminal and run the following command, matching `XXXX` to the port above and `YYYY` to any unused port on your local machine (any 4-digit number should work). + +``` +ssh -L YYYY:localhost:XXXX +# E.g., for the PEcAn VM, given the above port: +# ssh -L 5639:localhost:5638 carya@localhost -p 6422 +``` + +Now, in a web browser on your local machine, browse to `localhost:YYYY` (e.g., `localhost:5639`) to run whatever app you started with `shiny::runApp` in the previous step. +All of the output should display in the R console where the `shiny::runApp` command was executed. +Note that this includes any `print`, `message`, `logger.*`, etc. statements in your Shiny app. + +If the Shiny app hits an R error, the backtrace should include a line like `Hit error at of server.R#LXX` -- that `XX` being a line number that you can use to track down the error. +To return from the error to a normal R prompt, hit `-C` (alternatively, the "Stop" button in RStudio). +To restart the app, run `shiny::runApp(port = XXXX)` again (keeping the same port). + +Note that Shiny runs any code in the `pecan/shiny/` directory at the moment the app is launched. +So, any changes you make to the code in `server.R` and `ui.R` or scripts loaded therein will take effect the next time the app is started. + +If for whatever reason this doesn't work with RStudio, you can always run R from the command line. +Also, note that the ability to forward ports (`ssh -L`) may depend on the `ssh` configuration of your remote machine. +These instructions have been tested on the PEcAn VM (v.1.5.2+). + +## Debugging Shiny Apps When developing shiny apps you can run the application from rstudio and place breakpoints int he code. To do this you will need to do the following steps first (already done on the VM) before starting rstudio: - echo "options(shiny.port = 6438)" >> ${HOME}/.Rprofile @@ -10,11 +46,11 @@ Next you will need to create a tunnel for port 6438 to the VM, which will be use Now you can from rstudio run your application using `shiny::runApp()` and it will show the output from the application in your console. You can now place breakpoints and evaluate the output. -#### Checking Log Files +## Checking Log Files To create Log files on the VM, execute the following: ``` sudo -s echo "preserve_logs true;" >> /etc/shiny-server/shiny-server.conf service shiny-server restart ``` -Then within the directory `/var/log/shiny-server` you will see log files for your specific shiny apps. \ No newline at end of file +Then within the directory `/var/log/shiny-server` you will see log files for your specific shiny apps. diff --git a/book_source/03_topical_pages/11_adding_to_pecan.Rmd b/book_source/03_topical_pages/11_adding_to_pecan.Rmd index e6f501c95d3..8e5abd9bc16 100644 --- a/book_source/03_topical_pages/11_adding_to_pecan.Rmd +++ b/book_source/03_topical_pages/11_adding_to_pecan.Rmd @@ -31,23 +31,32 @@ **Note that coupling a model to PEcAn should not require any changes to the model code itself**. A key aspect of our design philosophy is that we want it to be easy to add models to the system and we want to using the working version of the code that is used by all other model users, not a special branch (which would rapidly end up out-of-date). -#### PEcAn Database +### Using PEcAn Database -To run a model within PEcAn requires that the PEcAn database know about the model -- this includes a MODEL_TYPE designation, the types of inputs the model requires, the location of the model executable, and the plant functional types used by the model. The instructions below assume that you will be specifying this information using the BETYdb web-based interface. This can be done either on your local VM (localhost:3280/bety or localhost:6480/bety) or on a server installation of BETYdb, though in either case we'd encourage you to set up your PEcAn instance to support [database syncs](https://github.com/PecanProject/bety/wiki/Distributed-BETYdb) so that these changes can be shared and backed-up across the PEcAn network. +To run a model within PEcAn requires that the PEcAn database has sufficient information about the model. This includes a MODEL_TYPE designation, the types of inputs the model requires, the location of the model executable, and the plant functional types used by the model. + +The instructions in this section assume that you will be specifying this information using the BETYdb web-based interface. This can be done either on your local VM (localhost:3280/bety or localhost:6480/bety) or on a server installation of BETYdb. However you interact with BETYdb, we encourage you to set up your PEcAn instance to support [database syncs](#database-sync) so that these changes can be shared and backed-up across the PEcAn network. + +![](03_topical_pages/11_images/bety_main_page.png) The figure below summarizes the relevant database tables that need to be updated to add a new model and the primary variables that define each table. -![](https://www.lucidchart.com/publicSegments/view/54a8aea8-9360-4628-af9e-392a0a00c27b/image.png) +![](03_topical_pages/11_images/bety_new_model.png) + +### Define MODEL_TYPE -#### Define MODEL_TYPE +The first step to adding a model is to create a new MODEL_TYPE, which defines the abstract model class. This MODEL_TYPE is used to specify input requirements, define plant functional types, and keep track of different model versions. -The first step to adding a model is to create a new MODEL_TYPE, which defines the abstract model class which we will then use to specify input requirements, define plant functional types, and keep track of different model versions. A MODEL_TYPE is created by selecting Runs > Model Type and then clicking on _New Model Type_. The MODEL_TYPE name should be identical to the MODEL package name (see Interface Module below) and is case sensitive. +The MODEL_TYPE is created by selecting Runs > Model Type and then clicking on _New Model Type_. The MODEL_TYPE name should be identical to the MODEL package name (see Interface Module below) and is case sensitive. -#### MACHINE +![](03_topical_pages/11_images/bety_modeltype_1.png) +![](03_topical_pages/11_images/bety_modeltype_2.png) + +### MACHINE The PEcAn design acknowledges that the same model executables and input files may exist on multiple computers. Therefore, we need to define the machine that that we are using. If you are running on the VM then the local machine is already defined as _pecan_. Otherwise, you will need to select Runs > Machines, click _New Machine_, and enter the URL of your server (e.g. pecan2.bu.edu). -#### MODEL +### MODEL Next we are going to tell PEcAn where the model executable is. Select Runs > Files, and click ADD. Use the pull down menu to specify the machine you just defined above and fill in the path and name for the executable. For example, if SIPNET is installed at /usr/local/bin/sipnet then the path is /usr/local/bin/ and the file (executable) is sipnet. @@ -57,21 +66,30 @@ In the future, if you set up the SAME MODEL VERSION on a different computer you If a new version of the model is developed that is derived from the current version you should add this as a new Model record but with the same MODEL_TYPE as the original. Furthermore, you should set the previous version of the model as Parent of this new version. -#### FORMATS +### FORMATS The PEcAn database keep track of all the input files passed to models, as well as any data used in model validation or data assimilation. Before we start to register these files with PEcAn we need to define the format these files will be in. To create a new format see [Formats Documentation](#NewFormat). -#### MODEL_TYPE -> Formats +### MODEL_TYPE -> Formats For each of the input formats you specify for your model, you will need to edit your MODEL_TYPE record to add an association between the format and the MODEL_TYPE. Go to Runs > Model Type, select your record and click on the Edit button. Next, click on "Edit Associated Formats" and choose the Format you just defined from the pull down menu. If the *Input* box is checked then all matching Input records will be displayed in the PEcAn site run selection page when you are defining a model run. In other words, the set of model inputs available through the PEcAn web interface is model-specific and dynamically generated from the associations between MODEL_TYPEs and Formats. If you also check the *Required* box, then the Input will be treated as required and PEcAn will not run the model if that input is not available. Furthermore, on the site selection webpage, PEcAn will filter the available sites and only display pins on the Google Map for sites that have a full set of required inputs (or where those inputs could be generated using PEcAn's workflows). Similarly, to make a site appear on the Google Map, all you need to do is specify Inputs, as described in the next section, and the point should automatically appear on the map. -#### INPUTS +### INPUTS After a file Format has been created then input files can be registered with the database. Creating Inputs can be found under [How to insert new Input data](#NewInput). -#### PFTS (Plant Functional Types) +### Add Plant Functional Types (PFTs) + +Since many of the PEcAn tools are designed to keep track of parameter uncertainties and assimilate data into models, to use PEcAn with a model it is important to define Plant Functional Types for the sites or regions that you will be running the model. + +Create a new PFT entry by selecting Data > PFTs and then clicking on _New PFT_. -Since many of the PEcAn tools are designed to keep track of parameter uncertainties and assimilate data into models, to use PEcAn with a model it is important to define Plant Functional Types for the sites or regions that you will be running the model. PFTs are MODEL_TYPE specific, so when you create a new PFT entry (Data > PFTs; New PFT) you will want to choose your MODEL_TYPE from the pull down and then give the PFT a descriptive name (e.g. temperate deciduous). +![](03_topical_pages/11_images/bety_pft_1.png) +![](03_topical_pages/11_images/bety_pft_2.png) + +Give the PFT a descriptive name (e.g., temperate deciduous). PFTs are MODEL_TYPE specific, so choose your MODEL_TYPE from the pull down menu. + +![](03_topical_pages/11_images/bety_pft_3.png) #### Species @@ -83,15 +101,51 @@ You can also define PFTs whose members are *cultivars* instead of species. This It is not yet possible to add a cultivar PFT through the BETYdb web interface. See [this GithHub comment](https://github.com/PecanProject/pecan/pull/1826#issuecomment-360665864) for an example of how to define one manually in PostgreSQL. -#### PRIORS +### Adding Priors for Each Variable + +In addition to adding species, a PFT is defined in PEcAn by the list of variables associated with the PFT. PEcAn takes a fundamentally Bayesian approach to representing model parameters, so variables are not entered as fixed constants but as prior probability distributions. + +There are a wide variety of priors already defined in the PEcAn database that often range from very diffuse and generic to very informative priors for specific PFTs. + +These pre-existing prior distributions can be added to a PFT. Navigate to the PFT from Data > PFTs and selecting the edit button in the Actions column for the chosen PFT. + +![](03_topical_pages/11_images/bety_priors_1.png) -In addition to adding species, a PFT is defined in PEcAn by the list of variables associated with the PFT. PEcAn takes a fundamentally Bayesian approach to representing model parameters, so variables are not entered as fixed constants but as Prior probability distributions (see below). Once Priors are defined for each model variable then you Edit the PFT and use “View Related Priors” to search for and add Prior distributions for each model parameter. It is important to note that the priors are defined for the variable name and units as specified in the Variables table. **If the variable name or units is different within the model it is the responsibility of write.configs.MODEL function to handle name and unit conversions** (see Interface Modules below). This can also include common but nonlinear transformations, such as converting SLA to LMA or changing the reference temperature for respiration rates. +Click on "View Related Priors" button and search through the list for desired prior distributions. The list can be filtered by adding terms into the search box. Add a prior to the PFT by clicking on the far left button for the desired prior, changing it to an X. -There are a wide variety of priors already defined in the PEcAn database that often range from very diffuse and generic to very informative priors for specific PFTs. If the current set of Priors for a variable are inadequate, or if a prior needs to be specified for a new variable, this can be done under Data > Priors then “New Prior”. After using the pull-down menu to select the Variable you want to generate a prior for, the prior is defined by choosing a probability distribution and specifying values for that distribution’s parameters. These are labeled Parameter a & b but their exact meaning depends upon the distribution chosen. For example, for the Normal distribution a and b are the mean and standard deviation while for the Uniform they are the minimum and maximum. All parameters are defined based on their standard parameterization in the R language. If the prior is based on observed data (independent of data in the PEcAn database) then you can also specify the prior sample size, _N_. The _Phylogeny_ variable allows one to specify what taxonomic grouping the prior is defined for, at it is important to note that this is just for reference and doesn’t have to be specified in any standard way nor does it have to be monophyletic (i.e. it can be a functional grouping). Finally, the _Citation_ is a required variable that provides a reference for how the prior was defined. That said, there are a number of unpublished Citations in current use that simply state the expert opinion of an individual. +![](03_topical_pages/11_images/bety_priors_2.png) -Additional information on adding PFTs, Species, and Priors can be found under [[Choosing PFTs]] +Save this by scrolling to the bottom of the PFT page and hitting the Update button. -#### Interface Modules +![](03_topical_pages/11_images/bety_priors_3.png) + +#### Creating new prior distributions + +A new prior distribution can be created for a pre-existing variable, if a more constrained or specific one is known. + +* Select Data > Priors then “New Prior” +* In the _Citation_ box, type in or select an existing reference that indicates how the prior was defined. There are a number of unpublished citations in current use that simply state the expert opinion of an individual +* Fill the _Variable_ box by typing in part or all of a pre-existing variable's name and selecting it +* The _Phylogeny_ box allows one to specify what taxonomic grouping the prior is defined for, at it is important to note that this is just for reference and doesn’t have to be specified in any standard way nor does it have to be monophyletic (i.e. it can be a functional grouping) +* The prior distribution is defined by choosing an option from the drop-down _Distribution_ box, and then specifying values for both _Parameter a_ and _Parameter b_. The exact meaning of the two parameters depends on the distribution chosen. For example, for the Normal distribution a and b are the mean and standard deviation while for the Uniform they are the minimum and maximum. All parameters are defined based on their standard parameterization in the R language +* Specify the prior sample size in _N_ if the prior is based on observed data (independent of data in the PEcAn database) +* When this is done, scroll down and hit the Create button + +![](03_topical_pages/11_images/bety_priors_4.png) + +The new prior distribution can then be added a PFT as described in the "Adding Priors for Each Variable" section. + +#### Creating new variables + +It is important to note that the priors are defined for the variable name and units as specified in the Variables table. **If the variable name or units is different within the model it is the responsibility of write.configs.MODEL function to handle name and unit conversions** (see Interface Modules below). This can also include common but nonlinear transformations, such as converting SLA to LMA or changing the reference temperature for respiration rates. + +To add a new variable, select Data > Variables and click the New Variable button. Fill in the _Name_ field with the desired name for the variable and the units in the _Units_ field. There are additional fields, such as _Standard Units_, _Notes_, and _Description_, that can be filled out if desired. When done, hit the Create button. + +![](03_topical_pages/11_images/bety_priors_5.png) + +The new variable can be used to create a prior distribution for it as in the "Creating new prior distributions" section. + +### Interface Modules #### Setting up the module directory (required) @@ -152,13 +206,13 @@ Once the MODEL modules are written, you should follow the [Using-Git](Using-Git. ## Adding input data {#NewInput} -#### Input records in BETY +### Input records in BETY All model input data or data used for model calibration/validation must be registered in the BETY database. Before creating a new Input record, you must make sure that the format type of your data is registered in the database. If you need to make a new format record, see [Creating a new format record in BETY](#NewFormat). -#### Create a database file record for the input data +### Create a database file record for the input data An input record contains all the metadata required to identify the data, however, this record does not include the location of the data file. Since the same data may be stored in multiple places, every file has its own dbfile record. @@ -172,7 +226,7 @@ From your BETY interface: + Fill in the File Name with the name of the file itself. Note that some types of input records will refer to be ALL the files in a directory and thus File Name can be blank + Click Update -#### Creating a new Input record in BETY +### Creating a new Input record in BETY From your BETY interface: @@ -191,13 +245,13 @@ From your BETY interface: * Once you have found the DBFILE, click on the “+” icon to add the file * Click on “Update” at the bottom when you are done. -#### Adding a new input converter {#InputConversions} +### Adding a new input converter {#InputConversions} Three Types of data conversions are discussed below: Meteorological data, Vegetation data, and Soil data. Each section provides instructions on how to convert data from their raw formats into a PEcAn standard format, whether it be from a database or if you have raw data in hand. Also, see [PEcAn standard formats]. -### Meterological Data +#### Meterological Data ##### Adding a function to PEcAn to convert a met data source @@ -324,11 +378,11 @@ PEcAn.data.atmosphere::met2CF.csv(in.path = in.path, ``` -### Vegetation Data +#### Vegetation Data Vegetation data will be required to parameterize your model. In these examples we will go over how to produce a standard initial condition file. -The main function to process cohort data is the `ic.process.R` function. As of now however, if you require pool data you will run a separate function, `pool_ic_list2netcdf.R`. +The main function to process cohort data is the `ic_process.R` function. As of now however, if you require pool data you will run a separate function, `pool_ic_list2netcdf.R`. ###### Example 1: Processing Veg data from data in hand. @@ -338,7 +392,7 @@ First, you'll need to create a input record in BETY that will have a file record Once you have created an input record you must take note of the input id of your record. An easy way to take note of this is in the URL of the BETY webpage that shows your input record. In this example we use an input record with the id `1000013064` which can be found at this url: https://psql-pecan.bu.edu/bety/inputs/1000013064# . Note that this is the Boston University BETY database. If you are on a different machine, your url will be different. -With the input id in hand you can now edit a pecan XML so that the PEcAn function `ic.process` will know where to look in order to process your data. The `inputs` section of your pecan XML will look like this. As of now ic.process is set up to work with the ED2 model so we will use ED2 settings and then grab the intermediary Rds data file that is created as the standard PEcAn file. For your Inputs section you will need to input your input id wherever you see the `useic` flag. +With the input id in hand you can now edit a pecan XML so that the PEcAn function `ic_process` will know where to look in order to process your data. The `inputs` section of your pecan XML will look like this. As of now ic_process is set up to work with the ED2 model so we will use ED2 settings and then grab the intermediary Rds data file that is created as the standard PEcAn file. For your Inputs section you will need to input your input id wherever you see the `useic` flag. ``` @@ -442,12 +496,12 @@ Once you edit your PEcAn.xml you can than create a settings object using PEcAn f settings <- PEcAn.settings::read.settings("pecan.xml") settings <- PEcAn.settings::prepare.settings(settings, force=FALSE) ``` -You can then execute the `ic.process` function to convert data into a standard Rds file: +You can then execute the `ic_process` function to convert data into a standard Rds file: ``` input <- settings$run$inputs dir <- "." -ic.process(settings, input, dir, overwrite = FALSE) +ic_process(settings, input, dir, overwrite = FALSE) ``` Note that the argument `dir` is set to the current directory. You will find the final ED2 file there. More importantly though you will find the `.Rds ` file within the same directory. @@ -480,7 +534,7 @@ pool_ic_list2netcdf(input = input, outdir = outdir, siteid = siteid) You should now have a netcdf file with initial conditions. -### Soil Data +#### Soil Data ###### Example 1: Converting Data in hand @@ -529,7 +583,7 @@ In addition to location-specific soil data, PEcAn can extract soil texture infor This tutorial explains the process of ingesting data into PEcAn via our Data-Ingest Application. In order to ingest data, the users must first select data that they wish to upload. Then, they enter metadata to help PEcAn parse and load the data into the main PEcAn workflow. -#### Loading Data +### Loading Data #### Selecting Ingest Method The Data-Ingest application is capable of loading data from the DataONE data federation and from the user's local machine. The first step in the workflow is therefore to select an upload method. The application defaults to uploading from DataONE. To upload data from a local device, simply select the radio button titled `Local Files `. @@ -538,13 +592,13 @@ The Data-Ingest application is capable of loading data from the DataONE data fed
```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studies/images/data-ingest/D1Ingest-1.gif") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/data-ingest/D1Ingest-1.gif") ```
The DataONE download feature allows the user to download data at a given doi or DataONE specific package id. To do so, enter the doi or identifier in the `Import From DataONE` field and select `download`. The download process may take a couple of minutes to run depending on the number of files in the dataONE package. This may be a convenient option if the user does not wish to download files directly to their local machine. Once the files have been successfully downloaded from DataONE, they are displayed in a table. Before proceeding to the next step, the user can select a file to ingest by clicking on the corresponding row in the data table.
-#### Local Upload Example +### Local Upload Example
To upload local files, the user should first select the `Local Files` button. From there, the user can upload files from their local machines by selecting `Browse` or by dragging and dropping files into the text box. The files will begin uploading automatically. From there, the user should select a file to ingest and then select the `Next Step` button. @@ -553,20 +607,20 @@ After this step, the workflow is identical for both methods. However, please not
```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studies/images/data-ingest/Local_loader_sm.gif") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/data-ingest/Local_loader_sm.gif") ```
```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studies/images/data-ingest/local_browse.gif") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/data-ingest/local_browse.gif") ``` -#### 2. Creating an Input Record +### 2. Creating an Input Record Creating an input record requires some basic metadata about the file that is being ingested. Each entry field is briefly explained below.
- Site: To link the selected file with a site, the user can scroll or type to search all the sites in PEcAn. See Example:
```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studies/images/data-ingest/Selectize_Input_sm.gif") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/data-ingest/Selectize_Input_sm.gif") ```
- Parent: To link the selected file with another dataset, type to search existing datasets in the `Parent` field. @@ -581,12 +635,12 @@ knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studi
```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studies/images/data-ingest/DateTime.gif") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/data-ingest/DateTime.gif") ``` - Notes: Describe the data that is being uploaded. Please include any citations or references. -#### 3. Creating a format record +### 3. Creating a format record If it is necessary to add a new format to PEcAn, the user should fill out the form attached to the `Create New Format` button. The inputs to this form are described below: - Mimetype: type to search existing mimetypes. If the mimetype is not in that list, please click on the link `Create New Mimetype` and create a new mimetype via the BETY website. @@ -602,9 +656,9 @@ If it is necessary to add a new format to PEcAn, the user should fill out the fo Example:
```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studies/images/data-ingest/new_format_record.gif") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/data-ingest/new_format_record.gif") ``` -#### 4. Formats_Variables Record +### 4. Formats_Variables Record The final step in the ingest process is to register a formats-variables record. This record links pecan variables with variables from the selected data. - Variable: PEcAn variable that is equivalent to variable in selected file. @@ -618,14 +672,14 @@ The final step in the ingest process is to register a formats-variables record. - Column Number: Vector of integers that list the column numbers associated with variables in a dataset. Required for text files that lack headers.
```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("04_advanced_user_guide/02_adding_to_pecan/01_case_studies/images/data-ingest/D1Ingest-9_sm.gif") +knitr::include_graphics("02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/data-ingest/D1Ingest-9_sm.gif") ``` Finally, the path to the ingest data is displayed in the `Select Files` box. ## Creating a new format {#NewFormat} -##### Formats in BETY +### Formats in BETY The PEcAn database keeps track of all the input files passed to models, as well as any data used in model validation or data assimilation. Before we start to register these files with PEcAn we need to define the format these files will be in. @@ -633,7 +687,7 @@ The main goal is to take all the meta-data we have about a data file and create This information is stored in a Format record in the bety database. Make sure to read through the current Formats before deciding to make a new one. -##### Creating a new format in BETY +### Creating a new format in BETY If the Format you are looking for is not available, you will need to create a new record. Before entering information into the database, you need to be able to answer the following questions about your data: @@ -653,7 +707,7 @@ If the Format you are looking for is not available, you will need to create a ne Here is an example using a fake dataset: -![example_data](04_advanced_user_guide/images/example_data.png) +![example_data](02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/example_data.png) @@ -671,7 +725,8 @@ You will need to fill out the following fields: Here is the Formats record for the example data: -![format_record_1](04_advanced_user_guide/images/format_record_1.png) +![format_record_1](02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/format_record_1.png) + When you have finished this section, hit Create. The final record will be displayed on the screen. #### Formats -> Variables @@ -682,7 +737,7 @@ To enter this data, select Edit Record and on the edit screen select View Relate Here is the record for the example data after adding related variables: -![format_record_2](04_advanced_user_guide/images/format_record_2.png) +![format_record_2](02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/format_record_2.png) ##### Name and Unit @@ -692,7 +747,7 @@ Make sure to search for your variables under Data > Variables before suggesting For example bety contains a record for Net Primary Productivity: -![var_record](04_advanced_user_guide/images/var_record.png) +![var_record](03_topical_pages/11_images/var_record.png) This record does not have the same variable name or the same units as NPP in the example data. You may have to do some reading to confirm that they are the same variable. @@ -755,7 +810,7 @@ To acquire Format information from a Format record, use the R function `query.fo - R list object containing many things. Fill this in. -#### Creating a new benchmark reference run {#NewBenchmark} +## Creating a new benchmark reference run {#NewBenchmark} The purpose of the reference run record in BETY is to store all the settings from a run that are necessary in exactly recreating it. @@ -765,7 +820,7 @@ When a run that is performed using pecan is registered as a reference run, the s All completed runs are not automatically registered as reference runs. To register a run, navigate to the benchmarking section of the workflow visualizations Shiny app. -#### Editing records {#editing-records} +## Editing records {#editing-records} - Models - Species diff --git a/book_source/03_topical_pages/11_images/bety_main_page.png b/book_source/03_topical_pages/11_images/bety_main_page.png new file mode 100644 index 00000000000..5b268b41486 Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_main_page.png differ diff --git a/book_source/03_topical_pages/11_images/bety_modeltype_1.png b/book_source/03_topical_pages/11_images/bety_modeltype_1.png new file mode 100644 index 00000000000..cec1a21ffde Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_modeltype_1.png differ diff --git a/book_source/03_topical_pages/11_images/bety_modeltype_2.png b/book_source/03_topical_pages/11_images/bety_modeltype_2.png new file mode 100644 index 00000000000..fd3fbb5163c Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_modeltype_2.png differ diff --git a/book_source/03_topical_pages/11_images/bety_new_model.png b/book_source/03_topical_pages/11_images/bety_new_model.png new file mode 100644 index 00000000000..24860308e6f Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_new_model.png differ diff --git a/book_source/03_topical_pages/11_images/bety_pft_1.png b/book_source/03_topical_pages/11_images/bety_pft_1.png new file mode 100644 index 00000000000..a5226b4b9b0 Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_pft_1.png differ diff --git a/book_source/03_topical_pages/11_images/bety_pft_2.png b/book_source/03_topical_pages/11_images/bety_pft_2.png new file mode 100644 index 00000000000..705fc5d0b84 Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_pft_2.png differ diff --git a/book_source/03_topical_pages/11_images/bety_pft_3.png b/book_source/03_topical_pages/11_images/bety_pft_3.png new file mode 100644 index 00000000000..b09ce870880 Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_pft_3.png differ diff --git a/book_source/03_topical_pages/11_images/bety_priors_1.png b/book_source/03_topical_pages/11_images/bety_priors_1.png new file mode 100644 index 00000000000..0202d4b495b Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_priors_1.png differ diff --git a/book_source/03_topical_pages/11_images/bety_priors_2.png b/book_source/03_topical_pages/11_images/bety_priors_2.png new file mode 100644 index 00000000000..bef439213d6 Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_priors_2.png differ diff --git a/book_source/03_topical_pages/11_images/bety_priors_3.png b/book_source/03_topical_pages/11_images/bety_priors_3.png new file mode 100644 index 00000000000..f9241fe7023 Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_priors_3.png differ diff --git a/book_source/03_topical_pages/11_images/bety_priors_4.png b/book_source/03_topical_pages/11_images/bety_priors_4.png new file mode 100644 index 00000000000..c7a9109ba79 Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_priors_4.png differ diff --git a/book_source/03_topical_pages/11_images/bety_priors_5.png b/book_source/03_topical_pages/11_images/bety_priors_5.png new file mode 100644 index 00000000000..67f5d8e78cb Binary files /dev/null and b/book_source/03_topical_pages/11_images/bety_priors_5.png differ diff --git a/book_source/03_topical_pages/11_images/remotemodule.png b/book_source/03_topical_pages/11_images/remotemodule.png new file mode 100644 index 00000000000..2d6f1830928 Binary files /dev/null and b/book_source/03_topical_pages/11_images/remotemodule.png differ diff --git a/book_source/02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/var_record.png b/book_source/03_topical_pages/11_images/var_record.png similarity index 100% rename from book_source/02_demos_tutorials_workflows/02_user_demos/05_advanced_user_guide/images/var_record.png rename to book_source/03_topical_pages/11_images/var_record.png diff --git a/book_source/03_topical_pages/12_troubleshooting-pecan.Rmd b/book_source/03_topical_pages/12_troubleshooting-pecan.Rmd index e04bda7b223..5d75b628b43 100755 --- a/book_source/03_topical_pages/12_troubleshooting-pecan.Rmd +++ b/book_source/03_topical_pages/12_troubleshooting-pecan.Rmd @@ -1,14 +1,14 @@ # Troubleshooting and Debugging PEcAn -### Cookies and pecan web pages +## Cookies and pecan web pages You may need to disable cookies specifically for the pecan webserver in your browser. This shouldn't be a problem running from the virtual machine, but your installation of php can include a 'PHPSESSID' that is quite long, and this can overflow the params field of the workflows table, depending on how long your hostname, model name, site name, etc are. -### `Warning: mkdir() [function.mkdir]: No such file or directory` +## `Warning: mkdir() [function.mkdir]: No such file or directory` If you are seeing: `Warning: mkdir() [function.mkdir]: No such file or directory in /path/to/pecan/web/runpecan.php at line 169` it is because you have used a relative path for \$output_folder in system.php. -### After creating a new PFT the tag for PFT not passed to config.xml in ED +## After creating a new PFT the tag for PFT not passed to config.xml in ED This is a result of the rather clunky way we currently have adding PFTs to PEcAn. This is happening because you need to edit the ./pecan/models/ed/data/pftmapping.csv file to include your new PFTs. @@ -40,7 +40,7 @@ See [tests README](https://github.com/PecanProject/pecan/blob/master/tests/READM -### Useful scripts +## Useful scripts The following scripts (in `qaqc/vignettes` identify, respectively: diff --git a/book_source/03_topical_pages/14_backup.Rmd b/book_source/03_topical_pages/14_backup.Rmd index 8c08890df31..82887b9ec61 100644 --- a/book_source/03_topical_pages/14_backup.Rmd +++ b/book_source/03_topical_pages/14_backup.Rmd @@ -2,13 +2,13 @@ This section provides additional details about the BETY database used by PEcAn. It will discuss best practices for setting up the BETY database, how to backup the database and how to restore the database. -### Best practices {#database-setup} +## Best practices {#database-setup} When using the BETY database in non testing mode, it is best not to use the default users. This is accomplished when running the initialize of the database. When the database is initally created the database will be created with some default users (best known is the carya user) as well as the guestuser that can be used in the BETY web application. To disable these users you will either need to disable the users from the web interface, or you can reinitialize the database and remove the `-u` flag from the command line (the `-u` flag will create the default users). To disable the guestuser as well you can remove the `-g` flag from the command line, or disable the account from BETY. The default installation of BETY and PEcAn will assume there is a database called bety with a default username and password. The default installation will setup the database account to not have any superuser abilities. It is also best to limit access to the postgres database from trusted hosts, either by using firewalls, or configuring postgresql to only accept connections from a limited set of hosts. -### Backup of BETY database +## Backup of BETY database It is good practice to make sure you backup the BETY database. Just creating a copy of the files on disk is not enough to ensure you have a valid backup. Most likely if you do this you will end up with a corrupted backup of the database. @@ -23,7 +23,7 @@ Using this scheme, we can restore the database using any of the files generated. It is recommeneded to run this script using a cronjob at midnight such that you have a daily backup of the database and do not have to remember to create these backups. When running this script (either cron or by hand) make sure to place the backups on a different machine than the machine that holds the database in case of a larger system failure. -### Restore of BETY database +## Restore of BETY database Hopefully this section will never need to be used. Following are 5 steps that have been used to restore the database. Before you start it is worth it to read up online a bit on restoring the database as well as join the slack channel and ask any of the people there for help. diff --git a/book_source/03_topical_pages/92_workflow_modules.Rmd b/book_source/03_topical_pages/92_workflow_modules.Rmd index 6c664ccd25c..2248287649b 100644 --- a/book_source/03_topical_pages/92_workflow_modules.Rmd +++ b/book_source/03_topical_pages/92_workflow_modules.Rmd @@ -3,26 +3,26 @@ NOTE: As of PEcAn 1.2.6 -- needs to be updated significantly -### Overview +## Overview Workflow inputs and outputs (click to open in new page, then zoom). Code used to generate this image is provided in [qaqc/vignettes/module_output.Rmd](https://github.com/PecanProject/pecan/blob/master/qaqc/vignettes/module_output.Rmd) [![PEcAn Workflow](http://isda.ncsa.illinois.edu/~kooper/EBI/workflow.svg)](http://isda.ncsa.illinois.edu/~kooper/EBI/workflow.svg) -### Load Settings: -#### `read.settings("/home/pecan/pecan.xml")` +## Load Settings +### `read.settings("/home/pecan/pecan.xml")` * loads settings * create directories * generates new xml, put in output folder -### Query Database: -#### `get.trait.data()` +## Query Database +### `get.trait.data()` Queries the database for both the trait data and prior distributions associated with the PFTs specified in the settings file. The list of variables that are queried is determined by what variables have priors associated with them in the definition of the pft. Likewise, the list of species that are associated with a PFT determines what subset of data is extracted out of all data matching a given variable name. -### Meta Analysis: -#### `run.meta.analysis()` +## Meta Analysis +### `run.meta.analysis()` The meta-analysis code begins by distilling the trait.data to just the values needed for the meta-analysis statistical model, with this being stored in `madata.Rdata`. This reduced form includes the conversion of all error statistics into precision (1/variance), and the indexing of sites, treatments, and greenhouse. In reality, the core meta-analysis code can be run independent of the trait database as long as input data is correctly formatted into the form shown in `madata`. @@ -31,30 +31,30 @@ The evaluation of the meta-analysis is done using a Bayesian statistical softwar Meta-analyses are run, and summary plots are produced. -### Write Configuration Files -#### `write.configs(model)` +## Write Configuration Files +### `write.configs(model)` * writes out a configuration file for each model run ** writes 500 configuration files for a 500 member ensemble ** for _n_ traits, writes `6 * n + 1` files for running default Sensitivity Analysis (number can be changed in the pecan settings file) -### Start Runs: -#### `start.runs(model)` +## Start Runs +### `start.runs(model)` This code starts the model runs using a model specific run function named start.runs.[model]. If the ecosystem model is running on a remote server, this module also takes care of all of the communication with the remote server and its run queue. Each of your subdirectories should now have a [run.id].out file in it. One instance of the model is run for each configuration file generated by the previous write configs module. -### Get Model Output -#### `get.model.output(model)` +## Get Model Output +### `get.model.output(model)` This code first uses a model-specific model2netcdf.[model] function to convert the model output into a standard output format ([MsTMIP](http://nacp.ornl.gov/MsTMIP_variables.shtml)). Then it extracts the data for requested variables specified in the settings file as `settings$ensemble$variable`, averages over the time-period specified as `start.date` and `end.date`, and stores the output in a file `output.Rdata`. The `output.Rdata` file contains two objects, `sensitivity.output` and `ensemble.output`, that is the model prediction for the parameter sets specified in `sa.samples` and `ensemble.samples`. In order to save bandwidth, if the model output is stored on a remote system PEcAn will perform these operations on the remote host and only return the `output.Rdata` object. -### Ensemble Analysis -#### `run.ensemble.analysis()` +## Ensemble Analysis +### `run.ensemble.analysis()` This module makes some simple graphs of the ensemble output. Open ensemble.analysis.pdf to view the ensemble prediction as both a histogram and a boxplot. ensemble.ts.pdf provides a timeseries plot of the ensemble mean, meadian, and 95% CI -### Sensitivity Analysis, Variance Decomposition -#### `run.sensitivity.analysis()` +## Sensitivity Analysis, Variance Decomposition +### `run.sensitivity.analysis()` This function processes the output of the previous module into sensitivity analysis plots, `sensitivityanalysis.pdf`, and a variance decomposition plot, `variancedecomposition.pdf` . In the sensitivity plots you will see the parameter values on the x-axis, the model output on the Y, with the dots being the model evaluations and the line being the spline fit. @@ -63,7 +63,7 @@ The variance decomposition plot is discussed more below. For your reference, the The variance decomposition plot contains three columns, the coefficient of variation (normalized posterior variance), the elasticity (normalized sensitivity), and the partial standard deviation of each model parameter. This graph is sorted by the variable explaining the largest amount of variability in the model output (right hand column). From this graph identify the top-tier parameters that you would target for future constraint. -### Glossary +## Glossary * Inputs: data sets that are used, and file paths leading to them * Parameters: e.g. info set in settings file diff --git a/book_source/03_topical_pages/93_installation/00_installation_index.Rmd b/book_source/03_topical_pages/93_installation/00_installation_index.Rmd new file mode 100644 index 00000000000..be47aee4fa3 --- /dev/null +++ b/book_source/03_topical_pages/93_installation/00_installation_index.Rmd @@ -0,0 +1,3 @@ +# Installation details + +This chapter contains details about installing and maintaining the uncontainerized version of PEcAn on a virtual machine or a server. If you are running PEcAn inside of Docker, many of the particulars will be different and you should refer to the [docker](#docker-index) chapter instead of this one. diff --git a/book_source/03_topical_pages/93_installation/01_pecan_vm.Rmd b/book_source/03_topical_pages/93_installation/01_pecan_vm.Rmd index 63499b357dc..9fcdf05abb6 100644 --- a/book_source/03_topical_pages/93_installation/01_pecan_vm.Rmd +++ b/book_source/03_topical_pages/93_installation/01_pecan_vm.Rmd @@ -1,6 +1,6 @@ ## PEcAn Virtual Machine {#pecanvm} -This section includes the following VM related documentation: +See also other VM related documentation sections: * [Maintaining your PEcAn VM](#maintain-vm) * [Connecting to the VM via SSH](#ssh-vm) diff --git a/book_source/03_topical_pages/93_installation/01_setup/PEcAn-in-the-Cloud.Rmd b/book_source/03_topical_pages/93_installation/01_setup/PEcAn-in-the-Cloud.Rmd index 6e4a270ecfe..8712ad8b77a 100755 --- a/book_source/03_topical_pages/93_installation/01_setup/PEcAn-in-the-Cloud.Rmd +++ b/book_source/03_topical_pages/93_installation/01_setup/PEcAn-in-the-Cloud.Rmd @@ -1,15 +1,13 @@ -### AWS Setup +## AWS Setup ***********Mirror of earlier section in installation section?********************* -### Porting VM to AWS - The following are Mike's rough notes from a first attempt to port the PEcAn VM to the AWS. This was done on a Mac These notes are based on following the instructions [here](http://www.rittmanmead.com/2014/09/obiee-sampleapp-in-the-cloud-importing-virtualbox-machines-to-aws-ec2/) -#### Convert PEcAn VM +### Convert PEcAn VM AWS allows upload of files as VMDK but the default PEcAn VM is in OVA format @@ -21,7 +19,7 @@ AWS allows upload of files as VMDK but the default PEcAn VM is in OVA format tar xf ``` -#### Set up an account on [AWS](http://aws.amazon.com/) +### Set up an account on [AWS](http://aws.amazon.com/) After you have an account you need to set up a user and save your [access key and secret key](http://docs.aws.amazon.com/IAM/latest/UserGuide/ManagingCredentials.html) @@ -29,7 +27,7 @@ In my case I created a user named 'carya' Note: the key that ended up working had to be made at [https://console.aws.amazon.com/iam/home#security_credential](https://console.aws.amazon.com/iam/home#security_credential), not the link above. -#### Install [EC2 command line tools](http://docs.aws.amazon.com/AWSEC2/latest/CommandLineReference/set-up-ec2-cli-linux.html) +### Install [EC2 command line tools](http://docs.aws.amazon.com/AWSEC2/latest/CommandLineReference/set-up-ec2-cli-linux.html) ``` wget http://s3.amazonaws.com/ec2-downloads/ec2-api-tools.zip @@ -58,14 +56,14 @@ Then set your user credentials as environment variables: Note: you may want to add all the variables set in the above EXPORT commands above into your .bashrc or equivalent. -#### Create an AWS S3 'bucket' to upload VM to +### Create an AWS S3 'bucket' to upload VM to Go to [https://console.aws.amazon.com/s3](https://console.aws.amazon.com/s3) and click "Create Bucket" In my case I named the bucket 'pecan' -#### Upload +### Upload In the code below, make sure to change the PEcAn version, the name of the bucket, and the name of the region. Make sure that the PEcAn version matches the one you downloaded. @@ -81,7 +79,7 @@ Make sure to note the ID of the image since you'll need it to check the VM statu ec2-describe-conversion-tasks ``` -#### Configuring the VM +### Configuring the VM On the EC2 management webpage, [https://console.aws.amazon.com/ec2](https://console.aws.amazon.com/ec2), if you select **Instances** on the left hand side (LHS) you should be able to see your new PEcAn image as an option under Launch Instance. @@ -101,7 +99,7 @@ Select "Load Balancers" on the LHS, click on "Create Load Balancer", follow Wiza To be able to launch multiple VMs: Under "Instances" convert VM to an Image. When done, select Launch, enable multiple instances, and associate with the previous security group. Once running, go back to "Load Balancers" and add the instances to the load balancer. Each instance can be accessed individually by it's own public IP, but external users should access the system more generally via the Load Balancers DNS. -#### Booting the VM +### Booting the VM Return to "Instances" using the menu on the LHS. diff --git a/book_source/03_topical_pages/93_installation/01_setup/thredds.Rmd b/book_source/03_topical_pages/93_installation/01_setup/thredds.Rmd index 2cfa7b513d8..04549749c9b 100755 --- a/book_source/03_topical_pages/93_installation/01_setup/thredds.Rmd +++ b/book_source/03_topical_pages/93_installation/01_setup/thredds.Rmd @@ -1,4 +1,4 @@ -### Thredds Setup +## Thredds Setup Installing and configuring Thredds for PEcAn authors - Rob Kooper @@ -10,8 +10,6 @@ authors - Rob Kooper The Tomcat 8 server can be installed from the default Ubuntu repositories. The thredds webapp will be downloaded and installed from unidata. -#### Ubuntu - First step is to install Tomcat 8 and configure it. The flag `-Dtds.content.root.path` should point to the location of where the thredds folder is located. This needs to be writeable by the user for tomcat. `-Djava.security.egd` is a special flag to use a different random number generator for tomcat. The default would take to long to generate a random number. ``` diff --git a/book_source/03_topical_pages/93_installation/03_install_OS/00_install_OS.Rmd b/book_source/03_topical_pages/93_installation/03_install_OS/00_install_OS.Rmd index 7c3a98ac95e..b88c61ce652 100644 --- a/book_source/03_topical_pages/93_installation/03_install_OS/00_install_OS.Rmd +++ b/book_source/03_topical_pages/93_installation/03_install_OS/00_install_OS.Rmd @@ -1,7 +1,7 @@ -### OS Specific Installations {#osinstall} +## OS Specific Installations {#osinstall} - [Ubuntu](#ubuntu) -- [CentOS](#centos/redhat) +- [CentOS](#centosredhat) - [OSX](#macosx) - [Install BETY](#install-bety) THIS PAGE IS DEPRECATED - [Install Models](#install-models) diff --git a/book_source/03_topical_pages/93_installation/03_install_OS/01_Installing-PEcAn-Ubuntu.Rmd b/book_source/03_topical_pages/93_installation/03_install_OS/01_Installing-PEcAn-Ubuntu.Rmd index adec37e14a5..907c074c2de 100755 --- a/book_source/03_topical_pages/93_installation/03_install_OS/01_Installing-PEcAn-Ubuntu.Rmd +++ b/book_source/03_topical_pages/93_installation/03_install_OS/01_Installing-PEcAn-Ubuntu.Rmd @@ -1,10 +1,10 @@ -#### Ubuntu {#ubuntu} +### Ubuntu {#ubuntu} These are specific notes for installing PEcAn on Ubuntu (14.04) and will be referenced from the main [installing PEcAn](Installing-PEcAn) page. You will at least need to install the build environment and Postgres sections. If you want to access the database/PEcAn using a web browser you will need to install Apache. To access the database using the BETY interface, you will need to have Ruby installed. This document also contains information on how to install the Rstudio server edition as well as any other packages that can be helpful. -##### Install build environment +#### Install build environment ```bash sudo -s @@ -32,13 +32,13 @@ apt-get -y install apache2 libapache2-mod-php5 php5 apt-get -y install texinfo texlive-latex-base texlive-latex-extra texlive-fonts-recommended # install devtools -echo 'install.packages("devtools", repos="http://cran.rstudio.com/")' | R --vanilla +echo 'install.packages("devtools")' | R --vanilla # done as root exit ``` -##### Install Postgres +#### Install Postgres Documentation: http://trac.osgeo.org/postgis/wiki/UsersWikiPostGIS21UbuntuPGSQL93Apt @@ -71,7 +71,8 @@ exit ``` To install the BETYdb database .. -##### Apache Configuration PEcAn + +#### Apache Configuration PEcAn ```bash # become root @@ -97,7 +98,7 @@ a2enconf pecan exit ``` -##### Apache Configuration BETY +#### Apache Configuration BETY ```bash sudo -s @@ -122,7 +123,7 @@ a2enconf bety /etc/init.d/apache2 restart ``` -##### Rstudio-server +#### Rstudio-server *NOTE This will allow anybody to login to the machine through the rstudio interface and run any arbitrary code. The login used however is the same as the system login/password.* @@ -158,7 +159,7 @@ a2enconf rstudio exit ``` -##### Additional packages +#### Additional packages HDF5 Tools, netcdf, GDB and emacs ```bash diff --git a/book_source/03_topical_pages/93_installation/03_install_OS/02_Installing-PEcAn-CentOS.Rmd b/book_source/03_topical_pages/93_installation/03_install_OS/02_Installing-PEcAn-CentOS.Rmd index 38ad8f9da4b..b51113b290b 100755 --- a/book_source/03_topical_pages/93_installation/03_install_OS/02_Installing-PEcAn-CentOS.Rmd +++ b/book_source/03_topical_pages/93_installation/03_install_OS/02_Installing-PEcAn-CentOS.Rmd @@ -1,10 +1,10 @@ -#### CentOS/RedHat {#centos/redhat} +### CentOS/RedHat {#centosredhat} These are specific notes for installing PEcAn on CentOS (7) and will be referenced from the main [installing PEcAn](Installing-PEcAn) page. You will at least need to install the build environment and Postgres sections. If you want to access the database/PEcAn using a web browser you will need to install Apache. To access the database using the BETY interface, you will need to have Ruby installed. This document also contains information on how to install the Rstudio server edition as well as any other packages that can be helpful. -##### Install build environment +#### Install build environment ```bash sudo -s @@ -37,7 +37,7 @@ firewall-cmd --reload #apt-get -y install texinfo texlive-latex-base texlive-latex-extra texlive-fonts-recommended # install devtools -echo 'install.packages("devtools", repos="http://cran.rstudio.com/")' | R --vanilla +echo 'install.packages("devtools")' | R --vanilla # done as root exit @@ -46,7 +46,7 @@ echo "module load mpi" >> ~/.bashrc module load mpi ``` -###### Install and configure PostgreSQL, udunits2, NetCDF +#### Install and configure PostgreSQL, udunits2, NetCDF ```bash sudo -s @@ -77,7 +77,7 @@ systemctl start postgresql-9.4 exit ``` -##### Apache Configuration PEcAn +#### Apache Configuration PEcAn Install and Start Apache ```bash @@ -113,7 +113,7 @@ a2enconf pecan exit ``` -##### Apache Configuration BETY +#### Apache Configuration BETY ```bash sudo -s @@ -144,7 +144,7 @@ EOF systemctl restart httpd ``` -##### Rstudio-server +#### Rstudio-server NEED FIXING @@ -200,7 +200,7 @@ Then, proceed with the following: * restart the Apache server: `sudo httpd restart` * now you should be able to access `http:///rstudio` -###### Install ruby-netcdf gem +#### Install ruby-netcdf gem ```bash cd $RUBY_APPLICATION_HOME @@ -223,7 +223,7 @@ bundle install --without development ``` -##### Additional packages +#### Additional packages NEED FIXING diff --git a/book_source/03_topical_pages/93_installation/03_install_OS/04_Installing-PEcAn-OSX.Rmd b/book_source/03_topical_pages/93_installation/03_install_OS/04_Installing-PEcAn-OSX.Rmd index b7047896559..d057ea41246 100755 --- a/book_source/03_topical_pages/93_installation/03_install_OS/04_Installing-PEcAn-OSX.Rmd +++ b/book_source/03_topical_pages/93_installation/03_install_OS/04_Installing-PEcAn-OSX.Rmd @@ -1,11 +1,11 @@ -#### Mac OSX {#macosx} +### Mac OSX {#macosx} These are specific notes for installing PEcAn on Mac OSX and will be referenced from the main [installing PEcAn](Installing-PEcAn) page. You will at least need to install the build environment and Postgres sections. If you want to access the database/PEcAn using a web browser you will need to install Apache. To access the database using the BETY interface, you will need to have Ruby installed. This document also contains information on how to install the Rstudio server edition as well as any other packages that can be helpful. -##### Install build environment +#### Install build environment ```bash # install R @@ -42,7 +42,7 @@ sudo make install cd .. ``` -##### Install Postgres +#### Install Postgres For those on a Mac I use the following app for postgresql which has postgis already installed (http://postgresapp.com/) @@ -62,14 +62,14 @@ CREATE EXTENSION postgis_tiger_geocoder; To check your postgis run the following command again in psql: `SELECT PostGIS_full_version();` -##### Additional installs +#### Additional installs -###### Install JAGS +##### Install JAGS Download JAGS from http://sourceforge.net/projects/mcmc-jags/files/JAGS/3.x/Mac%20OS%20X/JAGS-Mavericks-3.4.0.dmg/download -###### Install udunits +##### Install udunits Installing udunits-2 on MacOSX is done from source. @@ -86,7 +86,7 @@ make sudo make install ``` -##### Apache Configuration +#### Apache Configuration Mac does not support pdo/postgresql by default. The easiest way to install is use: http://php-osx.liip.ch/ @@ -102,10 +102,10 @@ Alias /pecan ${PWD}/pecan/web EOF ``` -##### Ruby +#### Ruby The default version of ruby should work. Or use [JewelryBox](https://jewelrybox.unfiniti.com/). -##### Rstudio Server +#### Rstudio Server For the mac you can download [Rstudio Desktop](http://www.rstudio.com/). diff --git a/book_source/03_topical_pages/93_installation/03_install_OS/05_install_BETY.Rmd b/book_source/03_topical_pages/93_installation/03_install_OS/05_install_BETY.Rmd index fddd44b2064..24739ba9154 100644 --- a/book_source/03_topical_pages/93_installation/03_install_OS/05_install_BETY.Rmd +++ b/book_source/03_topical_pages/93_installation/03_install_OS/05_install_BETY.Rmd @@ -1,4 +1,4 @@ -#### Installing BETY {#install-bety} +### Installing BETY {#install-bety} **************THIS PAGE IS DEPRECATED************* diff --git a/book_source/03_topical_pages/93_installation/03_install_OS/06_install_models/00_install_models.Rmd b/book_source/03_topical_pages/93_installation/03_install_OS/06_install_models/00_install_models.Rmd index 3d4e45d7e19..e3b8cf88aea 100644 --- a/book_source/03_topical_pages/93_installation/03_install_OS/06_install_models/00_install_models.Rmd +++ b/book_source/03_topical_pages/93_installation/03_install_OS/06_install_models/00_install_models.Rmd @@ -1,4 +1,4 @@ -#### Install Models +### Install Models This page contains instructions on how to download and install ecosystem models that have been or are being coupled to PEcAn. These instructions have been tested on the PEcAn unbuntu VM. Commands may vary on other operating systems. diff --git a/book_source/03_topical_pages/93_installation/03_install_OS/07_Installing-PEcAn-Data.Rmd b/book_source/03_topical_pages/93_installation/03_install_OS/07_Installing-PEcAn-Data.Rmd index 9345a6f542e..cce8c87e438 100644 --- a/book_source/03_topical_pages/93_installation/03_install_OS/07_Installing-PEcAn-Data.Rmd +++ b/book_source/03_topical_pages/93_installation/03_install_OS/07_Installing-PEcAn-Data.Rmd @@ -1,8 +1,8 @@ -#### Installing data for PEcAn {#install-data} +### Installing data for PEcAn {#install-data} PEcAn assumes some of the data to be installed on the machine. This page will describe how to install this data. -##### Site Information +#### Site Information These are large-ish files that contain data used with ED2 and SIPNET @@ -19,7 +19,7 @@ tar zxf inputs.tgz rm inputs.tgz ``` -##### FIA database +#### FIA database FIA database is large and will add an extra 10GB to the installation. @@ -33,7 +33,7 @@ psql -U bety -d fia5data < fia5data.psql rm fia5data.psql ``` -##### Flux Camp +#### Flux Camp Following will install the data for flux camp (as well as the demo script for PEcAn). @@ -44,7 +44,7 @@ tar zxf plot.tgz rm plot.tgz ``` -##### Harvard for ED tutorial +#### Harvard for ED tutorial Add datasets and runs diff --git a/book_source/03_topical_pages/94_docker/02_quickstart.Rmd b/book_source/03_topical_pages/94_docker/02_quickstart.Rmd index d23ed2bf550..552da07e98d 100644 --- a/book_source/03_topical_pages/94_docker/02_quickstart.Rmd +++ b/book_source/03_topical_pages/94_docker/02_quickstart.Rmd @@ -1,4 +1,37 @@ -## The PEcAn docker install process in detail {#docker-quickstart} +## Quick-start docker install {#docker-quickstart} + +```bash +git clone git@github.com/pecanproject/pecan +cd pecan + +# start database +docker-compose -p pecan up -d postgres + +# add example data (first time only) +docker-compose run --rm bety initialize +docker run -ti --rm --network pecan_pecan --volume pecan_pecan:/data --env FQDN=docker pecan/data:develop + +# start PEcAn +docker-compose -p pecan up -d + +# run a model +curl -v -X POST \ + -F 'hostname=docker' \ + -F 'modelid=5000000002' \ + -F 'sitegroupid=1' \ + -F 'siteid=772' \ + -F 'sitename=Niwot Ridge Forest/LTER NWT1 (US-NR1)' \ + -F 'pft[]=temperate.coniferous' \ + -F 'start=2004/01/01' \ + -F 'end=2004/12/31' \ + -F 'input_met=5000000005' \ + -F 'email=' \ + -F 'notes=' \ + 'http://localhost:8000/pecan/04-runpecan.php' +``` + + +## The PEcAn docker install process in detail ### Configure docker-compose {#pecan-setup-compose-configure} @@ -65,48 +98,49 @@ As a side effect, the above command will also create blank data ["volumes"](http Because our project is called `pecan` and `docker-compose.yml` describes a network called `pecan`, the resulting network is called `pecan_pecan`. This is relevant to the following commands, which will actually initialize and populate the BETY database. -Assuming the above ran successfully, next run the following: +Assuming the above has run successfully, next run the following: ```bash -docker-compose run --rm bety initialize +docker run --rm --network pecan_pecan pecan/db ``` The breakdown of this command is as follows: {#docker-run-init} -- `docker-compose run` -- This says we will be running a specific command inside the target service (bety in this case). +- `docker run` -- This says we will be running a container. - `--rm` -- This automatically removes the resulting container once the specified command exits, as well as any volumes associated with the container. This is useful as a general "clean-up" flag for one-off commands (like this one) to make sure you don't leave any "zombie" containers or volumes around at the end. -- `bety` -- This is the name of the service in which we want to run the specified command. -- Everything after the service name (here, `bety`) is interpreted as an argument to the image's specified [entrypoint](https://docs.docker.com/engine/reference/builder/#entrypoint). For the `bety` service, the entrypoint is the script [`docker/entrypoint.sh`](https://github.com/PecanProject/bety/blob/master/docker/entrypoint.sh) located in the BETY repository. Here, the `initialize` argument is parsed to mean "Create a new database", which first runs `psql` commands to create the `bety` role and database and then runs the `load.bety.sh` script. - - NOTE: The entrypoint script that is used is the one copied into the Docker container at the time it was built, which, depending on the indicated image version and how often images are built on Docker Hub relative to updates to the source, may be older than whatever is in the source code. +- `--network pecan_pecan` -- Thsi will start the container in the same network space as the posgres container, allowing it to push data into the database. +- `pecan/db` -- This is the name of the container, this holds a copy of the database used to initialize the postgresql database. Note that this command may throw a bunch of errors related to functions and/or operators already existing. This is normal -- it just means that the PostGIS extension to PostgreSQL is already installed. The important thing is that you see output near the end like: ``` -CREATED SCHEMA -Loading schema_migrations : ADDED 61 -Started psql (pid=507) -Updated formats : 35 (+35) -Fixed formats : 46 -Updated machines : 23 (+23) -Fixed machines : 24 -Updated mimetypes : 419 (+419) -Fixed mimetypes : 1095 -... -... -... -Added carya41 with access_level=4 and page_access_level=1 with id=323 -Added carya42 with access_level=4 and page_access_level=2 with id=325 -Added carya43 with access_level=4 and page_access_level=3 with id=327 -Added carya44 with access_level=4 and page_access_level=4 with id=329 -Added guestuser with access_level=4 and page_access_level=4 with id=331 +---------------------------------------------------------------------- +Safety checks + +---------------------------------------------------------------------- + +---------------------------------------------------------------------- +Making sure user 'bety' exists. ``` If you do not see this output, you can look at the [troubleshooting](#docker-quickstart-troubleshooting) section at the end of this section for some troubleshooting tips, as well as some solutions to common problems. Once the command has finished successfully, proceed with the next step which will load some initial data into the database and place the data in the docker volumes. +#### Add first user to PEcAn database + +You can add an initial user to the BETY database, for example the following commands will add the guestuser account as well as the demo `carya` account: + +``` +# guest user +docker-compose run --rm bety user guestuser guestuser "Guest User" guestuser@example.com 4 4 + +# example user +docker-compose run --rm bety user carya illinois "Carya Demo User" carya@example.com 1 1 +``` + #### Add example data (first time only) {#pecan-docker-quickstart-init-data} The following command will add some initial data to the PEcAn stack and register the data with the database. diff --git a/book_source/03_topical_pages/94_docker/03_architecture.Rmd b/book_source/03_topical_pages/94_docker/03_architecture.Rmd index ffbb10891e6..7defafb8545 100644 --- a/book_source/03_topical_pages/94_docker/03_architecture.Rmd +++ b/book_source/03_topical_pages/94_docker/03_architecture.Rmd @@ -22,9 +22,8 @@ The PEcAn docker architecture consists of many containers (see figure below) that will communicate with each other. The goal of this architecture is to easily expand the PEcAn system by deploying new model containers and registering them with PEcAn. Once this is done the user can now use these new models in their work. The PEcAn framework will setup the configurations for the models, and send a message to the model containers to start execution. Once the execution is finished the PEcAn framework will continue. This is exactly as if the model is running on a HPC machine. Models can be executed in parallel by launching multiple model containers. ```{r, echo=FALSE,out.height= "50%", out.width="50%", fig.align='center'} -knitr::include_graphics("06_reference/04_docker/pecan-docker.png") +knitr::include_graphics("03_topical_pages/94_docker/pecan-docker.png") ``` - As can be seen in the figure the architecture leverages of two standard containers (in orange). The first container is postgresql with postgis ([mdillon/postgis](https://hub.docker.com/r/mdillon/postgis/)) which is used to store the database used by both BETY and PEcAn. The second containers is a messagebus, more specifically RabbitMQ ([rabbitmq](https://hub.docker.com/_/rabbitmq/)). The BETY app container ([pecan/bety](https://hub.docker.com/r/pecan/bety/)) is the front end to the BETY database and is connected to the postgresql container. A http server can be put in front of this container for SSL termination as well to allow for load balancing (by using multiple BETY app containers). @@ -252,7 +251,7 @@ Our configuration is as follows: yaml::write_yaml(dc_yaml$services["bety"], stdout()) ``` -The BETY container Dockerfile is located in the root directory of the [BETY GitHub repository](https://github.com/pecan/bety) ([direct link](https://github.com/PecanProject/bety/blob/master/Dockerfile)). +The BETY container Dockerfile is located in the root directory of the [BETY GitHub repository](https://github.com/PecanProject/bety) ([direct link](https://github.com/PecanProject/bety/blob/master/Dockerfile)). ### `docs` {#pecan-dc-docs} @@ -275,7 +274,7 @@ Our configuration is as follows: yaml::write_yaml(dc_yaml$services["web"], stdout()) ``` -Its Dockerfile ships with the PEcAn source code, in [`docker/base/Dockerfile.web`](https://github.com/PecanProject/pecan/blob/develop/docker/base/Dockerfile.web). +Its Dockerfile ships with the PEcAn source code, in [`docker/web/Dockerfile`](https://github.com/PecanProject/pecan/blob/develop/docker/web/Dockerfile). In terms of [actively developing PEcAn using Docker](#pecan-docker-develop), this is the service to modify when making changes to the web interface (i.e. PHP, HTML, and JavaScript code located in the PEcAn `web` directory). @@ -290,9 +289,9 @@ Our configuration is as follows: yaml::write_yaml(dc_yaml$services["executor"], stdout()) ``` -Its Dockerfile is ships with the PEcAn source code, in [`docker/base/Dockerfile.executor`](https://github.com/PecanProject/pecan/blob/develop/docker/base/Dockerfile.executor). -Its image is built on top of the `pecan/base` image ([`docker/base/Dockerfile.base`](https://github.com/PecanProject/pecan/blob/develop/docker/base/Dockerfile.base)), which contains the actual PEcAn source. -To facilitate caching, the `pecan/base` image is itself built on top of the `pecan/depends` image ([`docker/base/Dockerfile.depends`](https://github.com/PecanProject/pecan/blob/develop/docker/base/Dockerfile.depends)), a large image that contains an R installation and PEcAn's many system and R package dependencies (which usually take ~30 minutes or longer to install from scratch). +Its Dockerfile is ships with the PEcAn source code, in [`docker/executor/Dockerfile`](https://github.com/PecanProject/pecan/blob/develop/docker/executor/Dockerfile). +Its image is built on top of the `pecan/base` image ([`docker/base/Dockerfile`](https://github.com/PecanProject/pecan/blob/develop/docker/base/Dockerfile)), which contains the actual PEcAn source. +To facilitate caching, the `pecan/base` image is itself built on top of the `pecan/depends` image ([`docker/depends/Dockerfile`](https://github.com/PecanProject/pecan/blob/develop/docker/depends/Dockerfile)), a large image that contains an R installation and PEcAn's many system and R package dependencies (which usually take ~30 minutes or longer to install from scratch). In terms of [actively developing PEcAn using Docker](#pecan-docker-develop), this is the service to modify when making changes to the PEcAn R source code. Note that, unlike changes to the `web` image's PHP code, changes to the R source code do not immediately propagate to the PEcAn container; instead, you have to re-compile the code by running `make` inside the container. @@ -318,5 +317,5 @@ In general, their configuration should be similar to the following configuration yaml::write_yaml(dc_yaml$services["sipnet"], stdout()) ``` -The PEcAn source contains Dockerfiles for ED2 ([`docker/models/Dockerfile.ed2`](https://github.com/PecanProject/pecan/blob/develop/docker/models/Dockerfile.ed2)) and SIPNET ([`docker/models/Dockerfile.sipnet`](https://github.com/PecanProject/pecan/blob/develop/docker/models/Dockerfile.sipnet)) that can serve as references. +The PEcAn source contains Dockerfiles for ED2 ([`models/ed/Dockerfile`](https://github.com/PecanProject/pecan/blob/develop/models/ed/Dockerfile.)) and SIPNET ([`models/sipnet/Dockerfile`](https://github.com/PecanProject/pecan/blob/develop/models/sipnet/Dockerfile)) that can serve as references. For additional tips on constructing a Dockerfile for your model, see [Dockerfiles for Models](#model-docker). diff --git a/book_source/03_topical_pages/94_docker/05_building_images.Rmd b/book_source/03_topical_pages/94_docker/05_building_images.Rmd index 126dc4397f2..40fcaf1f6d4 100644 --- a/book_source/03_topical_pages/94_docker/05_building_images.Rmd +++ b/book_source/03_topical_pages/94_docker/05_building_images.Rmd @@ -9,20 +9,20 @@ However, there are cases where it makes sense to re-build the Docker images loca The following is a list of PEcAn-specific images and reasons why you would want to rebuild them locally: - `pecan/depends` -- Rebuild if: - - You modify the `docker/base/Dockerfile.depends` + - You modify the `docker/depends/Dockerfile` - You introduce new system dependencies (i.e. things that need to be installed with `apt-get`) - You introduce new R package dependencies, and you want those R package installations to be cached during future builds. For packages with fast build times, it may be fine to let them be installed as part of PEcAn's standard build process (i.e. `make`). - `pecan/base` -- Rebuild if: - You built a new version of `pecan/depends` (on which `pecan/base` depends) - - You modify the `docker/base/Dockerfile.base` + - You modify the `docker/base/Dockerfile` - You made changes to the PEcAn R package source code, the Makefile, or `web/workflow.R`. - NOTE that changes to the web interface code affect `pecan/web`, _not_ `pecan/base` - `pecan/executor` -- Rebuild if: - You built a new version of `pecan/base` (on which `pecan/executor` depends) and/or, `pecan/depends` (on which `pecan/base` depends) - - You modified the `docker/base/Dockerfile.executor` - - You modified the RabbitMQ Python scripts (e.g. `docker/receiver.py`, `docker/sender.py`) + - You modified the `docker/executor/Dockerfile` + - You modified the RabbitMQ Python script (e.g. `docker/receiver.py`) - `pecan/web` -- Rebuild if you modified any of the following: - - `docker/base/Dockerfile.web` + - `docker/web/Dockerfile` - The PHP/HTML/JavaScript code for the PEcAn web interface in `web/` (_except_ `web/workflow.R` -- that goes in `pecan/base`) - `docker/config.docker.php` (the `config.php` file for Docker web instances) - `documentation/index_vm.html` (the documentation HTML website) @@ -47,7 +47,7 @@ docker build -t pecan/: -f docker/base/Dockerfile.`. +- `-f docker/depends/Dockerfile` -- The `-f/--file` tag is used to provide an alternative location and file name for the Dockerfile. ### Local development and testing with Docker {#docker-local-devel} diff --git a/book_source/03_topical_pages/94_docker/06_troubleshooting.Rmd b/book_source/03_topical_pages/94_docker/06_troubleshooting.Rmd index 855d96d40aa..ca162c24ffc 100644 --- a/book_source/03_topical_pages/94_docker/06_troubleshooting.Rmd +++ b/book_source/03_topical_pages/94_docker/06_troubleshooting.Rmd @@ -7,20 +7,20 @@ ``` Installing package into ‘/usr/local/lib/R/site-library’ (as ‘lib’ is unspecified) -Warning: unable to access index for repository https://mran.microsoft.com/snapshot/2018-09-01/src/contrib: - cannot open URL 'https://mran.microsoft.com/snapshot/2018-09-01/src/contrib/PACKAGES' +Warning: unable to access index for repository : + cannot open URL '' Warning message: package ‘’ is not available (for R version 3.5.1) ``` -**CAUSE**: This can sometimes happen if there are problems with Microsoft's CRAN snapshots, which are the default repository for the `rocker/tidyverse` containers. +**CAUSE**: This can sometimes happen if there are problems with the RStudio Package manager, which is the default repository for the `rocker/tidyverse` containers. See GitHub issues [rocker-org/rocker-versioned#102](https://github.com/rocker-org/rocker-versioned/issues/102) and [#58](https://github.com/rocker-org/rocker-versioned/issues/58). -**SOLUTION**: Add the following line to the `depends` and/or `base` Dockerfiles _before_ (i.e. above) any commands that install R packages (e.g. `Rscript -e "install.packages(...)"`): +**WORKAROUND**: Add the following line to the `depends` and/or `base` Dockerfiles _before_ (i.e. above) any commands that install R packages (e.g. `Rscript -e "install.packages(...)"`): ``` RUN echo "options(repos = c(CRAN = 'https://cran.rstudio.org'))" >> /usr/local/lib/R/etc/Rprofile.site ``` -This will set the default repository to the more reliable (albeit, more up-to-date; beware of breaking package changes!) RStudio CRAN mirror. +This will set the default repository to the more reliable (**albeit, more up-to-date; beware of breaking package changes!**) RStudio CRAN mirror. Then, build the image as usual. diff --git a/book_source/03_topical_pages/94_docker/09_rabbitmq.Rmd b/book_source/03_topical_pages/94_docker/09_rabbitmq.Rmd index 76ecf1f6777..76601a50879 100644 --- a/book_source/03_topical_pages/94_docker/09_rabbitmq.Rmd +++ b/book_source/03_topical_pages/94_docker/09_rabbitmq.Rmd @@ -2,42 +2,25 @@ This section provides additional details about how PEcAn uses RabbitMQ to manage communication between its Docker containers. -In PEcAn, we use the Python [`pika`](http://www.rabbitmq.com/tutorials/tutorial-one-python.html) client to post and retrieve messages from RabbitMQ. -As such, every Docker container that communicates with RabbitMQ contains two Python scripts: `sender.py` and `reciever.py`. -Both are located in the `docker` directory in the PEcAn source code root. +In PEcAn, we use the Python [`pika`](http://www.rabbitmq.com/tutorials/tutorial-one-python.html) client to retrieve messages from RabbitMQ. The PEcAn.remote library has convenience functions that wrap the API to post and read messages. The executor and models use the python version of the RabbitMQ scripts to retrieve messages, and launch the appropriate code. -### Producer -- `sender.py` {#rabbitmq-basics-sender} +### Producer -- `PEcAn.remote::rabbitmq_post_message` {#rabbitmq-basics-sender} -The `sender.py` script is in charge of posting messages to RabbitMQ. -In the RabbitMQ documentation, it is known as a "producer". -It runs once for every message posted to RabbitMQ, and then immediately exits (unlike the `receiver.py`, which runs continuously -- see [below](#rabbitmq-basics-receiver)). +The `PEcAn.remote::rabbitmq_post_message` function allows you to post messages to RabbitMQ from R. In the RabbitMQ documentation, it is known as a "producer". It takes the body of the message to be posted and will return any output generated when the message is posted to the approriate queue. -Its usage is as follows: +The function has three required arguments and two optional ones: -```bash -python3 sender.py -``` - -The arguments are: - -- `` -- The unique identifier of the RabbitMQ instance, similar to a URL. -The format is `amqp://username:password@host/vhost`. -By default, this is `amqp://guest:guest@rabbitmq/%2F` (the `%2F` here is the hexadecimal encoding for the `/` character). - -- `` -- The name of the queue on which to post the message. +- `uri` -- This is the URI used to connect to RabbitMQ, it will have the form `amqp://username:password\@server:5672/vhost`. Most containers will have this injected using the environment variable `RABBITMQ_URI`. +- `queue` -- The queue to post the message on, this is either `pecan` for a workflow to be exected, the name of the model and version to be executed, for example `SIPNET_r136`. +- `message` -- The actual message to be send, this is of type list and will be converted to a json string representation. +- `prefix` -- The code will talk to the rest api, this is the prefix of the rest api. In the case of the default docker-compse file, this will be `/rabbitmq` and will be injected as `RABBITMQ_PREFIX`. +- `port` -- The code will talk to the rest api, this is the port of the rest api. In the case of the default docker-compse file, this will be `15672` and will be injected as `RABBITMQ_PORT`. -- `` -- The contents of the message to post, in JSON format. -A typical message posted by PEcAn looks like the following: - - ```json - { "folder" : "/path/to/PEcAn_WORKFLOWID", "workflow" : "WORKFLOWID" } - ``` - -The `PEcAn.remote::start_rabbitmq` function is a wrapper for this script that provides an easy way to post a `folder` message to RabbitMQ from R. +The `PEcAn.remote::start_rabbitmq` function is a wrapper for this function that provides an easy way to post a `folder` message to RabbitMQ. ### Consumer -- `receiver.py` {#rabbitmq-basics-receiver} -Unlike `sender.py`, `receiver.py` runs like a daemon, constantly listening for messages. +The `receiver.py` script runs like a daemon, constantly listening for messages. In the RabbitMQ documentation, it is known as a "consumer". In PEcAn, you can tell that it is ready to receive messages if the corresponding logs (e.g. `docker-compose logs executor`) show the following message: diff --git a/book_source/03_topical_pages/95_remote_execution.Rmd b/book_source/03_topical_pages/95_remote_execution.Rmd index 6d02a401520..ef879465994 100644 --- a/book_source/03_topical_pages/95_remote_execution.Rmd +++ b/book_source/03_topical_pages/95_remote_execution.Rmd @@ -308,8 +308,7 @@ will fall back on the older versions install site-library ``` install.packages(c('udunits2', 'lubridate'), - configure.args=c(udunits2='--with-udunits2-lib=/project/earth/packages/udunits-2.1.24/lib --with-udunits2-include=/project/earth/packages/udunits-2.1.24/include'), - repos='http://cran.us.r-project.org') + configure.args=c(udunits2='--with-udunits2-lib=/project/earth/packages/udunits-2.1.24/lib --with-udunits2-include=/project/earth/packages/udunits-2.1.24/include')) ``` Finally to install support for both ED and SIPNET: diff --git a/book_source/04_appendix/03_courses_taught.Rmd b/book_source/04_appendix/03_courses_taught.Rmd index 9e85f011cb9..17d1bb83bac 100755 --- a/book_source/04_appendix/03_courses_taught.Rmd +++ b/book_source/04_appendix/03_courses_taught.Rmd @@ -1,27 +1,29 @@ # PEcAn Project Used in Courses -### University classes +## University classes -#### GE 375 - Environmental Modeling - Spring 2013, 2014 (Mike Dietze, Boston University) +### GE 375 - Environmental Modeling - Spring 2013, 2014 (Mike Dietze, Boston University) The final "Case Study: Terrestrial Ecosystem Models" is a PEcAn-based hands-on activity. Each class has been 25 students. GE 585 - Ecological forecasting Fall 2013 (Mike Dietze, Boston University) -### Summer Courses / Workshops -#### Annual summer course in flux measurement and advanced modeling (Mike Dietze, Ankur Desai) Niwot Ridge, CO + +## Summer Courses / Workshops + +### Annual summer course in flux measurement and advanced modeling (Mike Dietze, Ankur Desai) Niwot Ridge, CO About 1/3 lecture, 2/3 hands-on (the syllabus is actually wrong as it list the other way around). Each class has 24 students. [2013 Syllabus](http://www.fluxcourse.org/files/SyllabusFluxcourse_2013.pdf) see Tuesday Week 2 Data Assimilation lectures and PEcAn demo and the Class projects and presentations on Thursday and Friday. (Most students use PEcAn for their group projects. 2014 will be the third year that PEcAn has been used for this course. -#### Assimilating Long-Term Data into Ecosystem Models: Paleo-Ecological Observatory Network (PalEON) Project +### Assimilating Long-Term Data into Ecosystem Models: Paleo-Ecological Observatory Network (PalEON) Project Here is a link to the course: https://www3.nd.edu/~paleolab/paleonproject/summer-course/ This course uses the same demo as above, including collecting data in the field and assimilating it (part 3) -#### Integrating Evidence on Forest Response to Climate Change: Physiology to Regional Abundance +### Integrating Evidence on Forest Response to Climate Change: Physiology to Regional Abundance http://blue.for.msu.edu/macrosystems/workshop @@ -29,12 +31,12 @@ May 13-14, 2013 Session 4: Integrating Forest Data Into Ecosystem Models -#### Ecological Society of America meetings +### Ecological Society of America meetings [Workshop: Combining Field Measurements and Ecosystem Models](http://eco.confex.com/eco/2013/webprogram/Session9007.html) -### Selected Publications +## Selected Publications 1. Dietze, M.C., D.S LeBauer, R. Kooper (2013) [On improving the communication between models and data](https://github.com/PecanProject/pecan/blob/master/documentation/dietze2013oic.pdf?raw=true). Plant, Cell, & Environment doi:10.1111/pce.12043 2. LeBauer, D.S., D. Wang, K. Richter, C. Davidson, & M.C. Dietze. (2013). [Facilitating feedbacks between field measurements and ecosystem models](https://github.com/PecanProject/pecan/blob/master/documentation/lebauer2013ffb.pdf?raw=true). Ecological Monographs. doi:10.1890/12-0137.1 \ No newline at end of file diff --git a/book_source/04_appendix/04-package-dependencies.Rmd b/book_source/04_appendix/04-package-dependencies.Rmd new file mode 100644 index 00000000000..94d80ddf96e --- /dev/null +++ b/book_source/04_appendix/04-package-dependencies.Rmd @@ -0,0 +1,101 @@ +# Package Dependencies {#package-dependencies} + +## Executive Summary: What to usually do + +When you're editing one PEcAn package and want to use a function from any other R package (including other PEcAn packages), the standard method is to add the other package to the `Imports:` field of your DESCRIPTION file, spell the function in fully namespaced form (`pkg::function()`) everywhere you call it, and be done. There are a few cases where this isn't enough, but they're rarer than you think. The rest of this section mostly deals with the exceptions to this rule and why not to use them when they can be avoided. + +## Big Picture: What's possible to do + +To make one PEcAn package use functionality from another R package (including other PEcAn packages), you must do at least one and up to four things in your own package. + +* Always, *declare* which packages your package depends on, so that R can install them as needed when someone installs your package and so that human readers can understand what additional functionality it uses. Declare dependencies by manually adding them to your package's DESCRIPTION file. +* Sometimes, *import* functions from the dependency package into your package's namespace, so that your functions know where to find them. This is only sometimes necessary, because you can usually use `::` to call functions without importing them. Import functions by writing Roxygen `@importFrom` statements and do not edit the NAMESPACE file by hand. +* Rarely, *load* dependency code into the R environment, so that the person using your package can use it without loading it separately. This is usually a bad idea, has caused many subtle bugs, and in PEcAn it should only be used when unavoidable. When unavoidable, prefer `requireNamespace(... quietly = TRUE)` over `Depends:` or `require()` or `library()`. +* Only if your dependency relies on non-R tools, *install* any components that R won't know how to find for itself. These components are often but not always identifiable from a `SystemRequirements` field in the dependency's DESCRIPTION file. The exact installation procedure will vary case by case and from one operating system to another, and for PEcAn the key point is that you should skip this step until it proves necessary. When it does prove necessary, edit the documentation for your package to include advice on installing the dependency components, then edit the PEcAn build and testing scripts as needed so that they follow your advice. + +The advice below about each step is written specifically for PEcAn, although much of it holds for R packages in general. For more details about working with dependencies, start with Hadley Wickham's [R packages](http://r-pkgs.had.co.nz/description.html#dependencies) and treat the CRAN team's [Writing R Extensions](https://cran.r-project.org/doc/manuals/R-exts.html) as the final authority. + + +## Declaring Dependencies: Depends, Suggests, Imports + +List all dependencies in the DESCRIPTION file. Every package that is used by your package's code must appear in exactly one of the sections `Depends`, `Imports`, or `Suggests`. + +Please list packages in alphabetical order within each section. R doesn't care about the order, but you will later when you're trying to check whether this package uses a particular dependency. + +* `Imports` is the correct place to declare most PEcAn dependencies. This ensures that they get installed, but *does not* automatically import any of their functions -- Since PEcAn style prefers to mostly use `::` instead of importing, this is what we want. + +* `Depends` is, despite the name, usually the wrong place to declare PEcAn dependencies. The only difference between `Depends` and `Imports` is that when the user attaches your packages to their own R workspace (e.g. using `library("PEcAn.yourpkg")`), the packages in `Depends` are attached as well. Notice that a call like `PEcAn.yourpkg::yourfun()` *will not* attach your package *or* its dependencies, so your code still needs to import or `::`-qualify all functions from packages listed in `Depends`. In short, `Depends` is not a shortcut, is for user convenience not developer convenience, and makes it easy to create subtle bugs that appear to work during interactive test sessions but fail when run from scripts. As the [R extensions manual](https://cran.r-project.org/doc/manuals/R-exts.html#Package-Dependencies) puts it (emphasis added): + + > This [Imports and Depends] scheme was developed before all packages had namespaces (R 2.14.0 in October 2011), and good practice changed once that was in place. Field ‘Depends’ should nowadays be used rarely, only for packages which are intended to be put on the search path to make their facilities **available to the end user (and not to the package itself)**." + +* The `Suggests` field can be used to declare dependencies on packages that make your package more useful but are not completely essential. Again from the [R extensions manual](https://cran.r-project.org/doc/manuals/R-exts.html#Package-Dependencies): + + > The `Suggests` field uses the same syntax as `Depends` and lists packages that are not necessarily needed. This includes packages used only in examples, tests or vignettes (see [Writing package vignettes](https://cran.r-project.org/doc/manuals/R-exts.html#Writing-package-vignettes)), and packages loaded in the body of functions. E.g., suppose an example from package foo uses a dataset from package bar. Then it is not necessary to have bar use foo unless one wants to execute all the examples/tests/vignettes: it is useful to have bar, but not necessary. + + Some of the PEcAn model interface packages push this definition of "not necessarily needed" by declaring their coupled model package in `Suggests` rather than `Imports`. For example, the `PEcAn.BIOCRO` package cannot do anything useful when the BioCro model is not installed, but it lists BioCro in Suggests because *PEcAn as a whole* can work without it. This is a compromise to simplify installation of PEcAn for users who only plan to use a few models, so that they can avoid the bother of installing BioCro if they only plan to run, say, SIPNET. + + Since the point of Suggests is that they are allowed to be missing, all code that uses a suggested package must behave reasonably when the package is not found. Depending on the situation, "reasonably" could mean checking whether the package is available and throwing an error as needed (PEcAn.BIOCRO uses its `.onLoad` function to check at load time whether BioCro is installed and will refuse to load if it is not), or providing an alternative behavior (`PEcAn.data.atmosphere::get_NARR_thredds` checks at call time for either `parallel` or `doParallel` and uses whichever one it finds first), or something else, but your code should never just assume that the suggested package is available. + + You are not allowed to import functions from `Suggests` into your package's namespace, so always call them in `::`-qualified form. By default R will not install suggested packages when your package is installed, but users can change this using the `dependencies` argument of `install.packages`. Note that for testing on Travis CI, PEcAn *does* install all `Suggests` (because they are required for full package checks), so any of your code that runs when a suggested package is not available will never be exercised by Travis checks. + + It is often tempting to move a dependency from Imports to Suggests because it is a hassle to install (large, hard to compile, no longer available from CRAN, currently broken on GitHub, etc), in the hopes that this will isolate the rest of PEcAn from the troublesome dependency. This helps for some cases, but fails for two very common ones: It does not reduce install time for CI builds, because all suggested packages need to be present when running full package checks (`R CMD check` or `devtools::check` or `make check`). It also does not prevent breakage when updating PEcAn via `make install`, because `devtools::install_deps` does not install suggested packages that are missing but does try to *upgrade* any that are already installed to the newest available version -- even if the installed version took ages to compile and would have worked just fine! + +## Importing Functions: Use Roxygen + +PEcAn style is to import very few functions and instead use fully namespaced function calls (`pkg::fn()`) everywhere it's practical to do so. In cases where double-colon notation would be especially burdensome, such as when importing custom binary operators like `%>%`, it's acceptable to import specific functions into the package namespace. Do this by using Roxygen comments of the form `#' @importFrom pkg function`, not by hand-editing the NAMESPACE file. + +If the import is only used in one or a few functions, use an `@importFrom` in the documentation for each function that uses it. If it is used all over the package, use a single `@importFrom` in the Roxygen documentation block for the whole package, which probably lives in a file called either `zzz.R` or `-package.R`: + +```r +#' What your package does +#' +#' Longer description of the package goes here. +#' Probably with links to other resources about it, citations, etc. +#' +#' @docType package +#' @name PEcAn.yourpkg +#' @importFrom magrittr %>% +NULL +``` + +Roxygen will make sure there's only one NAMESPACE entry per imported function no matter how many `importFrom` statements there are, but please pick a scheme (either import on every usage or once for the whole package), stick with it, and do not make function `x()` rely on an importFrom in the comments above function `y()`. + +Please do *not* import entire package namespaces (`#' @import pkg`); it increases the chance of function name collisions and makes it much harder to understand which package a given function was called from. + +A special note about importing functions from the [tidyverse](https://tidyverse.org): Be sure to import from the package(s) that actually contain the functions you want to use, e.g. `Imports: dplyr, magrittr, purrr` / `@importFrom magrittr %>%` / `purrr::map(...)`, not `Imports: tidyverse` / `@importFrom tidyverse %>%` / `tidyverse::map(...)`. The package named `tidyverse` is just a interactive shortcut that loads the whole collection of constituent packages; it doesn't export any functions in its own namespace and therefore importing it into your package doesn't make them available. + +## Loading Code: Don't... But Use `requireNamespace` When You Do + +The very short version of this section: We want to maintain clear separation between the [package's namespace](http://r-pkgs.had.co.nz/namespace.html) (which we control and want to keep predictable) and the global namespace (which the user controls, might change in ways we have no control over, and will be justifiably angry if we change it in ways they were not expecting). Therefore, avoid attaching packages to the search path (so no `Depends` and no `library()` or `require()` inside functions), and do not explicitly load other namespaces if you can help it. + +The longer version requires that we make a distinction often glossed over: *Loading* a package makes it possible for *R* to find things in the package namespace and does any actions needed to make it ready for use (e.g. running its .onLoad method, loading DLLs if the package contains compiled code, etc). *Attaching* a package (usually by calling `library("somePackage")`) loads it if it wasn't already loaded, and then adds it to the search path so that the *user* can find things in its namespace. As discussed in the "Declaring Dependancies" section above, dependencies listed in `Depends` will be attached when your package is attached, but they will be *neither attached nor loaded* when your package is loaded without being attached. + +Loading a dependency into the package namespace is undesirable because it makes it hard to understand our own code -- if we need to use something from elsewhere, we'd prefer call it from its own namespace using `::` (which implicitly loads the dependency!) or explicitly import it with a Roxygen `@import` directive. But in a few cases this isn't enough. The most common reason to need to explicitly load a dependency is that some packages *define* new S3 methods for generic functions defined in other packages, but do not *export* these methods directly. We would prefer that these packages did not do this, but sometimes we have to use them anyway. An [example from PEcAn](https://github.com/PecanProject/pecan/issues/1368) is that PEcAn.MA needs to call `as.matrix` on objects of class `mcmc.list`. When the `coda` namespace is loaded, `as.matrix(some_mcmc.list)` can be correctly dispatched by `base::as.matrix` to the unexported method `coda:::as.matrix.mcmc.list`, but when `coda` is not loaded this dispatch will fail. Unfortunately coda does not export `as.matrix.mcmc.list` so we cannot call it directly or import it into the PEcAn.MA namespace, so instead we [load the `coda` namespace](https://github.com/PecanProject/pecan/pull/1966/files#diff-e0b625a54a8654cc9b22d9c076e7a838R13) whenever PEcAn.MA is loaded. + +Attaching packages to the user's search path is even more problematic because it makes it hard for the user to understand *how your package will affect their own code*. Packages attached by a function stay attached after the function exits, so they can cause name collisions far downstream of the function call, potentially in code that has nothing to do with your package. And worse, since names are looked up in reverse order of package loading, it can cause behavior that differs in strange ways depending on the order of lines that look independent of each other: + +```r +library(Hmisc) +x = ... +y = 3 +summarize(x) # calls Hmisc::summarize +y2 <- some_package_that_attaches_dplyr::innocent.looking.function(y) +# Loading required package: dplyr +summarize(x) # Looks identical to previous summarize, but calls dplyr::summarize! +``` + +This is not to say that users will *never* want your package to attach another one for them, just that it's rare and that attaching dependencies is much more likely to cause bugs than to fix them and additionally doesn't usually save the package author any work. + +One possible exception to the do-not-attach-packages rule is a case where your dependency ignores all good practice and wrongly assumes, without checking, that all of its own dependencies are attached; if its DESCRIPTION uses only `Depends` instead of `Imports`, this is often a warning sign. For example, a small-but-surprising number of packages depend on the `methods` package without proper checks (this is probably because most *but not all* R interpreters attach `methods` by default and therefore it's easy for an author to forget it might ever be otherwise unless they happen to test with a but-not-all interpreter). + +If you find yourself with a dependency that does this, accept first that you are relying on a package that is broken, and you should either convince its maintainer to fix it or find a way to remove the dependency from PEcAn. But as a short-term workaround, it is sometimes possible for your code to attach the direct dependency so that it will behave right with regard to its secondary dependencies. If so, make sure the attachment happens every time your package is loaded (e.g. by calling `library(depname)` inside your package's `.onLoad` method) and not just when your package is attached (e.g. by putting it in Depends). + +When you do need to load or attach a dependency, it is probably better to do it inside your package's `.onLoad` method rather than in individual functions, but this isn't ironclad. To only load, use `requireNamespace(pkgname, quietly=TRUE)` -- this will make it available inside your package's namespace while avoiding (most) annoying loadtime messages and not disturbing the user's search path. To attach when you really can't avoid it, declare the dependency in `Depends` and *also* attach it using `library(pkgname)` in your .onLoad method. + +Note that scripts in `inst/` are considered to be sample code rather than part of the package namespace, so it is acceptable for them to explicitly attach packages using `library()`. You may also see code that uses `require(pkgname)`; this is just like `library`, but returns FALSE instead of erroring if package load fails. It is OK for scripts in `inst/` that can do *and do* do something useful when a dependency is missing, but if it is used as `if(!require(pkg)){ stop(...)}` then replace it with `library(pkg)`. + +If you think your package needs to load or attach code for any reason, please note why in your pull request description and be prepared for questions about it during code review. If your reviewers can think of an alternate approach that avoids loading or attaching, they will likely ask you to use it even if it creates extra work for you. + +## Installing dependencies: Let the machines do it + +In most cases you won't need to think about how dependencies get installed -- just declare them in your package's DESCRIPTION and the installation will be handled automatically by R and devtools during the build process. The main exception is when a dependency relies on non-R software that R does not know how to install automatically. For example, rjags relies on JAGS, which might be installed in a different place on every machine. If your dependency falls in this category, you will know (because your CI builds will keep failing until you figure out how to fix it), but the exact details of the fix will differ for every case. diff --git a/book_source/04_appendix/05-testthat.Rmd b/book_source/04_appendix/05-testthat.Rmd new file mode 100644 index 00000000000..fae9a3f1b8e --- /dev/null +++ b/book_source/04_appendix/05-testthat.Rmd @@ -0,0 +1,134 @@ +# Testing with the `testthat` package {#appendix-testthat} + +Tests are found in `/tests/testthat/` (for example, `base/utils/inst/tests/`) + +See attached file and +[http://r-pkgs.had.co.nz/tests.html](http://r-pkgs.had.co.nz/tests.html) +for details on how to use the testthat package. + +## List of Expectations + +|Full |Abbreviation| +|---|----| +|expect_that(x, is_true()) |expect_true(x)| +|expect_that(x, is_false()) |expect_false(x)| +|expect_that(x, is_a(y)) |expect_is(x, y)| +|expect_that(x, equals(y)) |expect_equal(x, y)| +|expect_that(x, is_equivalent_to(y)) |expect_equivalent(x, y)| +|expect_that(x, is_identical_to(y)) |expect_identical(x, y)| +|expect_that(x, matches(y)) |expect_matches(x, y)| +|expect_that(x, prints_text(y)) |expect_output(x, y)| +|expect_that(x, shows_message(y)) |expect_message(x, y)| +|expect_that(x, gives_warning(y)) |expect_warning(x, y)| +|expect_that(x, throws_error(y)) |expect_error(x, y)| + +## Basic use of the `testthat` package + +Create a file called `/tests/testthat.R` with the following contents: + +```r +library(testthat) +library(mypackage) + +test_check("mypackage") +``` + +Tests should be placed in `/tests/testthat/test-.R`, and look like the following: + +```r +test_that("mathematical operators plus and minus work as expected",{ + expect_equal(sum(1,1), 2) + expect_equal(sum(-1,-1), -2) + expect_equal(sum(1,NA), NA) + expect_error(sum("cat")) + set.seed(0) + expect_equal(sum(matrix(1:100)), sum(data.frame(1:100))) +}) + +test_that("different testing functions work, giving excuse to demonstrate",{ + expect_identical(1, 1) + expect_identical(numeric(1), integer(1)) + expect_equivalent(numeric(1), integer(1)) + expect_warning(mean('1')) + expect_that(mean('1'), gives_warning("argument is not numeric or logical: returning NA")) + expect_warning(mean('1'), "argument is not numeric or logical: returning NA") + expect_message(message("a"), "a") +}) +``` + +## Data for tests + +Many of PEcAn’s functions require inputs that are provided as data. +These can be in the `data` or the `inst/extdata` folders of a package. +Data that are not package specific should be placed in the `PEcAn.all` (`base/all`) or +`PEcAn.utils` (`base/utils`) packages. + +Some useful conventions: + +## Settings + +* A generic settings can be found in the `PEcAn.all` package +```r +settings.xml <- system.file("pecan.biocro.xml", package = "PEcAn.BIOCRO") +settings <- read.settings(settings.xml) +``` + +* database settings can be specified, and tests run only if a connection is available + +We currently use the following database to run tests against; tests that require access to a database should check `db.exists()` and be skipped if it returns FALSE to avoid failed tests on systems that do not have the database installed. + +```r +settings$database <- list(userid = "bety", + passwd = "bety", + name = "bety", # database name + host = "localhost" # server name) +test_that(..., { + skip_if_not(db.exists(settings$database)) + ## write tests here +}) +``` + +* instructions for installing this are available on the [VM creation + wiki](VM-Creation.md) +* examples can be found in the PEcAn.DB package (`base/db/tests/testthat/`). + +* Model specific settings can go in the model-specific module, for +example: + +```r +settings.xml <- system.file("extdata/pecan.biocro.xml", package = "PEcAn.BIOCRO") +settings <- read.settings(settings.xml) +``` +* test-specific settings: + - settings text can be specified inline: + ``` + settings.text <- " + + nope ## allows bypass of checks in the read.settings functions + + + ebifarm.pavi + test/ + + + test/ + + bety + bety + localhost + bety + + " + settings <- read.settings(settings.text) + ``` + - values in settings can be updated: + ```r + settings <- read.settings(settings.text) + settings$outdir <- "/tmp" ## or any other settings + ``` + +## Helper functions for unit tests + +* `PEcAn.utils::tryl` returns `FALSE` if function gives error +* `PEcAn.utils::temp.settings` creates temporary settings file +* `PEcAn.DB::db.exists` returns `TRUE` if connection to database is available diff --git a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/06_devtools.Rmd b/book_source/04_appendix/06_devtools.Rmd similarity index 92% rename from book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/06_devtools.Rmd rename to book_source/04_appendix/06_devtools.Rmd index 0826dcb59a3..c2fc23ca246 100644 --- a/book_source/02_demos_tutorials_workflows/05_developer_workflows/03_coding_practices/06_devtools.Rmd +++ b/book_source/04_appendix/06_devtools.Rmd @@ -1,9 +1,9 @@ -### `devtools` package {#developer-devtools} +# `devtools` package {#developer-devtools} Provides functions to simplify development Documentation: -[The R devtools packate](https://github.com/hadley/devtools) +[The R devtools package](https://devtools.r-lib.org/) ```r load_all("pkg") diff --git a/models/ed/inst/ED2IN.git b/book_source/04_appendix/07_singularity.Rmd similarity index 85% rename from models/ed/inst/ED2IN.git rename to book_source/04_appendix/07_singularity.Rmd index 58a154572b2..61b97386a82 100644 --- a/models/ed/inst/ED2IN.git +++ b/book_source/04_appendix/07_singularity.Rmd @@ -1,3 +1,54 @@ +# `singularity` {#models_singularity} + +Running a model using singularity. + +*This is work in progress.* + +This assumes you have [singulariy](https://sylabs.io/singularity/) already installed. + +This will work on a Linux machine (x86_64). + +First make sure you have all the data files: + +
+bash script to install required files (click to expand) +```bash +#!/bin/bash + +if [ ! -e sites ]; then + curl -s -o sites.tgz http://isda.ncsa.illinois.edu/~kooper/EBI/sites.tgz + tar zxf sites.tgz + sed -i -e "s#/home/kooper/Projects/EBI#/data/sites#" sites/*/ED_MET_DRIVER_HEADER + rm sites.tgz +fi + +if [ ! -e inputs ]; then + curl -s -o inputs.tgz http://isda.ncsa.illinois.edu/~kooper/EBI/inputs.tgz + tar zxf inputs.tgz + rm inputs.tgz +fi + +if [ ! -e testrun.s83 ]; then + curl -s -o testrun.s83.zip http://isda.ncsa.illinois.edu/~kooper/EBI/testrun.s83.zip + unzip -q testrun.s83.zip + sed -i -e "s#/home/pecan#/data#" testrun.s83/ED2IN + rm testrun.s83.zip +fi + +if [ ! -e ${HOME}/sites/Santarem_Km83 ]; then + curl -s -o Santarem_Km83.zip http://isda.ncsa.illinois.edu/~kooper/EBI/Santarem_Km83.zip + unzip -q -d sites Santarem_Km83.zip + sed -i -e "s#/home/pecan#/data#" sites/Santarem_Km83/ED_MET_DRIVER_HEADER + rm Santarem_Km83.zip +fi +``` +
+ +Next edit the ED2IN file in testrun.s83 + +
+ED2IN file (click to expand) +``` !==========================================================================================! !==========================================================================================! ! ED2IN . ! @@ -8,9 +59,12 @@ $ED_NL !----- Simulation title (64 characters). -----------------------------------------------! - NL%EXPNME = 'ED2 vGITHUB PEcAn @ENSNAME@' + NL%EXPNME = 'ED version 2.1 test' !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! Type of run: ! ! INITIAL -- Starts a new run, that can be based on a previous run (restart/history), ! @@ -27,9 +81,9 @@ $ED_NL !---------------------------------------------------------------------------------------! ! Start of simulation. Information must be given in UTC time. ! !---------------------------------------------------------------------------------------! - NL%IMONTHA = @START_MONTH@ - NL%IDATEA = @START_DAY@ - NL%IYEARA = @START_YEAR@ + NL%IMONTHA = 01 + NL%IDATEA = 01 + NL%IYEARA = 2001 NL%ITIMEA = 0000 !---------------------------------------------------------------------------------------! @@ -38,9 +92,9 @@ $ED_NL !---------------------------------------------------------------------------------------! ! End of simulation. Information must be given in UTC time. ! !---------------------------------------------------------------------------------------! - NL%IMONTHZ = @END_MONTH@ - NL%IDATEZ = @END_DAY@ - NL%IYEARZ = @END_YEAR@ + NL%IMONTHZ = 01 + NL%IDATEZ = 01 + NL%IYEARZ = 2002 NL%ITIMEZ = 0000 !---------------------------------------------------------------------------------------! @@ -73,7 +127,7 @@ $ED_NL ! 1. Polar-stereographic ! !---------------------------------------------------------------------------------------! NL%N_ED_REGION = 0 - NL%GRID_TYPE = 0 + NL%GRID_TYPE = 1 !------------------------------------------------------------------------------------! ! The following variables are used only when GRID_TYPE is set to 0. You must ! @@ -86,11 +140,11 @@ $ED_NL ! ED_REG_LONMIN -- Westernmost point of each region. ! ! ED_REG_LONMAX -- Easternmost point of each region. ! !------------------------------------------------------------------------------------! - NL%GRID_RES = 1.0 ! This is the grid resolution scale in degrees. [\*/] - NL%ED_REG_LATMIN = -90 ! List of minimum latitudes; - NL%ED_REG_LATMAX = 90 ! List of maximum latitudes; - NL%ED_REG_LONMIN = -180 ! List of minimum longitudes; - NL%ED_REG_LONMAX = 180 ! List of maximum longitudes; + NL%GRID_RES = 1.0 + NL%ED_REG_LATMIN = -12.0, -7.5, 10.0, -6.0 + NL%ED_REG_LATMAX = 1.0, -3.5, 15.0, -1.0 + NL%ED_REG_LONMIN = -66.0,-58.5, 70.0, -63.0 + NL%ED_REG_LONMAX = -49.0,-54.5, 35.0, -53.0 !------------------------------------------------------------------------------------! @@ -153,11 +207,14 @@ $ED_NL ! POI_RES -- grid resolution of each POI (degrees). This is used only to define the ! ! soil types ! !---------------------------------------------------------------------------------------! - NL%N_POI = 1 ! number of polygons of interest (POIs). This could be zero. - NL%POI_LAT = @SITE_LAT@ ! list of the latitudes of the POIs (degrees north) - NL%POI_LON = @SITE_LON@ ! list of the longitudes of the POIs (degrees east) + NL%N_POI = 1 + NL%POI_LAT = -3.018 + NL%POI_LON = -54.971 NL%POI_RES = 1.00 !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! LOADMETH -- Load balancing method. This is used only in regional runs run in ! ! parallel. ! @@ -190,48 +247,17 @@ $ED_NL ! ISOUTPUT -- restart file, for HISTORY runs. The time interval between files is ! ! determined by FRQHIS ! !---------------------------------------------------------------------------------------! - NL%IFOUTPUT = 0 ! Instantaneous analysis (site average) - NL%IDOUTPUT = 0 ! Daily means (site average) - NL%IMOUTPUT = 0 ! Monthly means (site average) - NL%IQOUTPUT = 0 ! Monthly means (diurnal cycle) - NL%IYOUTPUT = 3 ! Annual output - NL%ITOUTPUT = 3 ! Instantaneous fluxes (site average) --> "Tower" Files - NL%ISOUTPUT = 0 ! History files + NL%IFOUTPUT = 0 + NL%IDOUTPUT = 0 + NL%IMOUTPUT = 0 + NL%IQOUTPUT = 3 + NL%IYOUTPUT = 0 + NL%ITOUTPUT = 0 + NL%ISOUTPUT = 3 !---------------------------------------------------------------------------------------! - !---------------------------------------------------------------------------------------! - ! The following variables control whether site-, patch-, and cohort-level time ! - ! means and mean sum of squares should be included in the output files or not. ! - ! ! - ! Reasons to add them: ! - ! a. Sub-polygon variables are more comprehensive. ! - ! b. Explore heterogeneity within a polygon and make interesting analysis. ! - ! c. More chances to create cool 3-D plots. ! - ! ! - ! Reasons to NOT add them: ! - ! a. Output files will become much larger! ! - ! b. In regional/coupled runs, the output files will be ridiculously large. ! - ! c. You may fill up the disk. ! - ! d. Other people's job may crash due to insufficient disk space. ! - ! e. You will gain a bad reputation amongst your colleagues. ! - ! f. And it will be entirely your fault. ! - ! ! - ! Either way, polygon-level averages are always included, and so are the instan- ! - ! taneous site-, patch-, and cohort-level variables needed for resuming the run. ! - ! ! - ! IADD_SITE_MEANS -- Add site-level averages to the output (0 = no; 1 = yes) ! - ! IADD_PATCH_MEANS -- Add patch-level averages to the output (0 = no; 1 = yes) ! - ! IADD_COHORT_MEANS -- Add cohort-level averages to the output (0 = no; 1 = yes) ! - ! ! - !---------------------------------------------------------------------------------------! - NL%IADD_SITE_MEANS = 0 - NL%IADD_PATCH_MEANS = 0 - NL%IADD_COHORT_MEANS = 0 - !---------------------------------------------------------------------------------------! - - !---------------------------------------------------------------------------------------! ! ATTACH_METADATA -- Flag for attaching metadata to HDF datasets. Attaching metadata ! @@ -273,8 +299,8 @@ $ED_NL ! Multiple timepoints should not be used in the history files ! ! if you intend to use these for HISTORY runs. ! !---------------------------------------------------------------------------------------! - NL%OUTFAST = -1 ! orig. 3600. - NL%OUTSTATE = 0 ! orig. 1. + NL%OUTFAST = 1. + NL%OUTSTATE = 1. !---------------------------------------------------------------------------------------! @@ -285,9 +311,9 @@ $ED_NL ! FRQFAST -- time interval between analysis files, units defined by UNITFAST. ! ! FRQSTATE -- time interval between history files, units defined by UNITSTATE. ! !---------------------------------------------------------------------------------------! - NL%ICLOBBER = 1 ! 0 = stop if files exist, 1 = overwite files - NL%FRQFAST = 1800. ! Time interval between analysis/history files - NL%FRQSTATE = 86400. ! Time interval between history files + NL%ICLOBBER = 1 + NL%FRQFAST = 3600. + NL%FRQSTATE = 1. !---------------------------------------------------------------------------------------! @@ -296,8 +322,8 @@ $ED_NL ! FFILOUT -- Path and prefix for analysis files (all but history/restart). ! ! SFILOUT -- Path and prefix for history files. ! !---------------------------------------------------------------------------------------! - NL%FFILOUT = '@FFILOUT@' ! Analysis output prefix; - NL%SFILOUT = '@SFILOUT@' ! History output prefix + NL%FFILOUT = '/data/testrun.s83/analy/ts83' + NL%SFILOUT = '/data/testrun.s83/histo/ts83' !---------------------------------------------------------------------------------------! @@ -341,7 +367,7 @@ $ED_NL ! 6 - Initialize with ED-2 style files without multiple sites, exactly like option ! ! 2, except that the PFT types are preserved. ! !---------------------------------------------------------------------------------------! - NL%IED_INIT_MODE = @INIT_MODEL@ + NL%IED_INIT_MODE = 6 !---------------------------------------------------------------------------------------! @@ -368,7 +394,12 @@ $ED_NL ! path+prefix will be used, as the history for every grid must have come ! ! from the same simulation. ! !---------------------------------------------------------------------------------------! - NL%SFILIN = '@SITE_PSSCSS@' + NL%SFILIN = '/data/sites/Santarem_Km83/s83_default.' + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! History file information. These variables are used to continue a simulation from ! ! a point other than the beginning. Time must be in UTC. ! @@ -380,8 +411,12 @@ $ED_NL !---------------------------------------------------------------------------------------! NL%ITIMEH = 0000 NL%IDATEH = 01 - NL%IMONTHH = 01 - NL%IYEARH = 1500 + NL%IMONTHH = 05 + NL%IYEARH = 2001 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! NZG - number of soil layers. One value for all grids. ! ! NZS - maximum number of snow/water pounding layers. This is used only for ! @@ -389,8 +424,8 @@ $ED_NL ! into a single layer, so if you are running for places where it doesn't snow ! ! a lot, leave this set to 1. One value for all grids. ! !---------------------------------------------------------------------------------------! - NL%NZG = 9 - NL%NZS = 1 + NL%NZG = 16 + NL%NZS = 4 !---------------------------------------------------------------------------------------! @@ -405,6 +440,11 @@ $ED_NL ! and SLXCLAY). ! !---------------------------------------------------------------------------------------! NL%ISOILFLG = 2 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! NSLCON -- ED-2 Soil classes that the model will use when ISOILFLG is set to 2. ! ! Possible values are: ! @@ -416,7 +456,11 @@ $ED_NL ! 5 -- loam | 11 -- clay | 17 -- clayey silt ! ! 6 -- sandy clay loam | 12 -- peat ! !---------------------------------------------------------------------------------------! - NL%NSLCON = 3 !3 US-WCr, 2 US-Syv, 10 US-Los + NL%NSLCON = 11 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! ISOILCOL -- LEAF-3 and ED-2 soil colour classes that the model will use when ISOILFLG ! ! is set to 2. Soil classes are from 1 to 20 (1 = lightest; 20 = darkest). ! @@ -444,7 +488,11 @@ $ED_NL ! Soil type 21 is a special case in which we use the albedo method that used to be ! ! the default in ED-2.1. ! !---------------------------------------------------------------------------------------! - NL%ISOILCOL = 10 !21 12 for US-Los + NL%ISOILCOL = 21 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! These variables are used to define the soil properties when you don't want to use ! ! the standard soil classes. ! @@ -455,8 +503,12 @@ $ED_NL ! They are used only when ISOILFLG is 2, both values are between 0. and 1., and ! ! theira sum doesn't exceed 1. Otherwise standard ED values will be used instead. ! !---------------------------------------------------------------------------------------! - NL%SLXCLAY = 0.13 ! 0.13 US-WCr, 0.06 US-Syv, 0.0663 US-PFa, 0.68 default - NL%SLXSAND = 0.54 ! 0.54 US-WCr, 0.57 US-Syv, 0.5931 US-PFa, 0.20 default + NL%SLXCLAY = 0.59 + NL%SLXSAND = 0.39 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! Soil grid and initial conditions if no file is provided: ! ! ! @@ -472,9 +524,17 @@ $ED_NL ! 2 = porosity (saturation) ! ! STGOFF - initial temperature offset (soil temperature = air temperature + offset) ! !---------------------------------------------------------------------------------------! - NL%SLZ = -2.0,-1.5, -1.0, -0.80, -0.60, -0.40, -0.2, -0.10, -0.05 - NL%SLMSTR = 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65, 0.65 - NL%STGOFF = 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 + NL%SLZ = -8.000, -6.959, -5.995, -5.108, -4.296, -3.560, -2.897, -2.307, + -1.789, -1.340, -0.961, -0.648, -0.400, -0.215, -0.089, -0.020 + NL%SLMSTR = 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, + 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00 + NL%STGOFF = 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, + 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! Input databases ! ! VEG_DATABASE -- vegetation database, used only to determine the land/water mask. ! @@ -496,14 +556,19 @@ $ED_NL ! soil temperature and moisture. ! ! SOILDEPTH_DB -- Dataset in case you want to read in soil depth information. ! !---------------------------------------------------------------------------------------! - NL%VEG_DATABASE = '@ED_VEG@' - NL%SOIL_DATABASE = '@ED_SOIL@' - NL%LU_DATABASE = '@ED_LU@' + NL%VEG_DATABASE = '/data/oge2OLD/OGE2_' + NL%SOIL_DATABASE = '/data/faoOLD/FAO_' + NL%LU_DATABASE = '/data/ed_inputs/glu/' NL%PLANTATION_FILE = '' - NL%THSUMS_DATABASE = '@ED_THSUM@' - NL%ED_MET_DRIVER_DB = '@SITE_MET@' + NL%THSUMS_DATABASE = '/data/ed_inputs/' + NL%ED_MET_DRIVER_DB = '/data/sites/Santarem_Km83/ED_MET_DRIVER_HEADER' NL%SOILSTATE_DB = '' NL%SOILDEPTH_DB = '' + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! ISOILSTATEINIT -- Variable controlling how to initialise the soil temperature and ! ! moisture ! @@ -515,6 +580,11 @@ $ED_NL !---------------------------------------------------------------------------------------! NL%ISOILSTATEINIT = 0 NL%ISOILDEPTHFLG = 0 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! ISOILBC -- This controls the soil moisture boundary condition at the bottom. If ! ! unsure, use 0 for short-term simulations (couple of days), and 1 for long- ! @@ -531,13 +601,10 @@ $ED_NL !---------------------------------------------------------------------------------------! NL%ISOILBC = 1 !---------------------------------------------------------------------------------------! - ! SLDRAIN -- This is used only when ISOILBC is set to 2. In this case SLDRAIN is the ! - ! equivalent slope that will slow down drainage. If this is set to zero, ! - ! then lateral drainage reduces to flat bedrock, and if this is set to 90, ! - ! then lateral drainage becomes free drainage. SLDRAIN must be between 0 ! - ! and 90. ! - !---------------------------------------------------------------------------------------! - NL%SLDRAIN = 10. + + + + !---------------------------------------------------------------------------------------! ! IVEGT_DYNAMICS -- The vegetation dynamics scheme. ! ! 0. No vegetation dynamics, the initial state will be preserved, ! @@ -547,6 +614,9 @@ $ED_NL ! The normal option for almost any simulation. ! !---------------------------------------------------------------------------------------! NL%IVEGT_DYNAMICS = 1 + !---------------------------------------------------------------------------------------! + + !---------------------------------------------------------------------------------------! ! IBIGLEAF -- Do you want to run ED as a 'big leaf' model? ! ! 0. No, use the standard size- and age-structure (Moorcroft et al. 2001) ! @@ -558,6 +628,11 @@ $ED_NL ! N.B. if you set IBIGLEAF to 1, you MUST turn off the crown model (CROWN_MOD = 0) ! !---------------------------------------------------------------------------------------! NL%IBIGLEAF = 0 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! INTEGRATION_SCHEME -- The biophysics integration scheme. ! ! 0. Euler step. The fastest, but it doesn't estimate ! @@ -568,6 +643,11 @@ $ED_NL ! leaf temp, forward Euler for else, under development). ! !---------------------------------------------------------------------------------------! NL%INTEGRATION_SCHEME = 1 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! RK4_TOLERANCE -- This is the relative tolerance for Runge-Kutta or Heun's ! ! integration. Larger numbers will make runs go faster, at the ! @@ -576,6 +656,11 @@ $ED_NL ! and 1.e-2. ! !---------------------------------------------------------------------------------------! NL%RK4_TOLERANCE = 0.01 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! IBRANCH_THERMO -- This determines whether branches should be included in the ! ! vegetation thermodynamics and radiation or not. ! @@ -586,7 +671,9 @@ $ED_NL ! 2. Similar to 1, but branches are treated as separate pools in the ! ! biophysics (thus doubling the number of prognostic variables). ! !---------------------------------------------------------------------------------------! - NL%IBRANCH_THERMO = 0 + NL%IBRANCH_THERMO = 1 + !---------------------------------------------------------------------------------------! + !---------------------------------------------------------------------------------------! ! IPHYSIOL -- This variable will determine the functional form that will control how ! ! the various parameters will vary with temperature, and how the CO2 ! @@ -605,6 +692,10 @@ $ED_NL ! 3 -- Same as 2, except that we find Gamma* as in Farquhar et al. (1980) and in CLM. ! !---------------------------------------------------------------------------------------! NL%IPHYSIOL = 2 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! IALLOM -- Which allometry to use (this mostly affects tropical PFTs. Temperate PFTs ! ! will use the new root allometry and the maximum crown area if IALLOM is set ! @@ -624,6 +715,10 @@ $ED_NL ! Cole and Ewel (2006), and Calvo Alvarado et al. (2008). ! !---------------------------------------------------------------------------------------! NL%IALLOM = 2 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! IGRASS -- This controls the dynamics and growth calculation for grasses. A new ! ! grass scheme is now available where bdead = 0, height is a function of bleaf! @@ -633,6 +728,9 @@ $ED_NL ! 1: new grass scheme as described above ! !---------------------------------------------------------------------------------------! NL%IGRASS = 0 + !---------------------------------------------------------------------------------------! + + !---------------------------------------------------------------------------------------! ! IPHEN_SCHEME -- It controls the phenology scheme. Even within each scheme, the ! ! actual phenology will be different depending on the PFT. ! @@ -664,7 +762,10 @@ $ED_NL ! New scheme: plants shed their leaves once a 10-day running average of available ! ! water becomes less than a critical value. ! !---------------------------------------------------------------------------------------! - NL%IPHEN_SCHEME = @PHENOL_SCHEME@ + NL%IPHEN_SCHEME = 2 + !---------------------------------------------------------------------------------------! + + !---------------------------------------------------------------------------------------! ! Parameters that control the phenology response to radiation, used only when ! ! IPHEN_SCHEME = 3. ! @@ -674,6 +775,10 @@ $ED_NL !---------------------------------------------------------------------------------------! NL%RADINT = -11.3868 NL%RADSLP = 0.0824 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! REPRO_SCHEME -- This controls plant reproduction and dispersal. ! ! 0. Reproduction off. Useful for very short runs only. ! @@ -689,7 +794,11 @@ $ED_NL ! drought deciduous plants. This option is for testing purposes ! ! only, think 50 times before using it... ! !---------------------------------------------------------------------------------------! - NL%REPRO_SCHEME = 0 + NL%REPRO_SCHEME = 2 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! LAPSE_SCHEME -- This specifies the met lapse rate scheme: ! ! 0. No lapse rates ! @@ -698,6 +807,10 @@ $ED_NL ! 3. mechanistic(not yet implemented) ! !---------------------------------------------------------------------------------------! NL%LAPSE_SCHEME = 0 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! CROWN_MOD -- Specifies how tree crowns are represent in the canopy radiation model, ! ! and in the turbulence scheme depending on ICANTURB. ! @@ -706,7 +819,11 @@ $ED_NL ! 1. Dietze (2008) model. Cohorts have a finite radius, and cohorts are ! ! stacked on the top of each other. ! !---------------------------------------------------------------------------------------! - NL%CROWN_MOD = 1 + NL%CROWN_MOD = 0 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! The following variables control the canopy radiation solver. ! ! ! @@ -739,13 +856,18 @@ $ED_NL !---------------------------------------------------------------------------------------! NL%ICANRAD = 0 NL%LTRANS_VIS = 0.050 - NL%LTRANS_NIR = 0.270 - NL%LREFLECT_VIS = 0.150 - NL%LREFLECT_NIR = 0.540 + NL%LTRANS_NIR = 0.230 + NL%LREFLECT_VIS = 0.100 + NL%LREFLECT_NIR = 0.460 NL%ORIENT_TREE = 0.100 - NL%ORIENT_GRASS = -0.100 + NL%ORIENT_GRASS = 0.000 NL%CLUMP_TREE = 0.800 NL%CLUMP_GRASS = 1.000 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! DECOMP_SCHEME -- This specifies the dependence of soil decomposition on temperature. ! ! 0. ED-2.0 default, the original exponential ! @@ -753,6 +875,10 @@ $ED_NL ! [[option 1 requires parameters to be set in xml]] ! !---------------------------------------------------------------------------------------! NL%DECOMP_SCHEME = 0 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! H2O_PLANT_LIM -- this determines whether plant photosynthesis can be limited by ! ! soil moisture, the FSW, defined as FSW = Supply / (Demand + Supply). ! @@ -771,30 +897,10 @@ $ED_NL ! depth, H it the crown height and psi_fc and psi_wp are the ! ! matric potentials at wilting point and field capacity. ! !---------------------------------------------------------------------------------------! - NL%H2O_PLANT_LIM = 1 - !---------------------------------------------------------------------------------------! - ! IDDMORT_SCHEME -- This flag determines whether storage should be accounted in the ! - ! carbon balance. ! - ! 0 -- Carbon balance is done in terms of fluxes only. This is the ! - ! default in ED-2.1 ! - ! 1 -- Carbon balance is offset by the storage pool. Plants will be ! - ! in negative carbon balance only when they run out of storage ! - ! and are still losing more carbon than gaining. ! - ! ! - ! DDMORT_CONST -- This constant (k) determines the relative contribution of light ! - ! and soil moisture to the density-dependent mortality rate. Values ! - ! range from 0 (soil moisture only) to 1 (light only). ! - ! ! - ! mort1 ! - ! mu_DD = ------------------------- ! - ! 1 + exp [ mort2 * cr ] ! - ! ! - ! CB CB ! - ! cr = k ------------- + (1 - k) ------------- ! - ! CB_lightmax CB_watermax ! + NL%H2O_PLANT_LIM = 2 !---------------------------------------------------------------------------------------! - NL%IDDMORT_SCHEME = 0 - NL%DDMORT_CONST = 0.8 + + !---------------------------------------------------------------------------------------! ! The following variables are factors that control photosynthesis and respiration. ! ! Notice that some of them are relative values whereas others are absolute. ! @@ -836,30 +942,35 @@ $ED_NL ! Q10_C3 -- Q10 factor for C3 plants (used only if IPHYSIOL is set to 2 or 3). ! ! Q10_C4 -- Q10 factor for C4 plants (used only if IPHYSIOL is set to 2 or 3). ! !---------------------------------------------------------------------------------------! - NL%VMFACT_C3 = 1.00 - NL%VMFACT_C4 = 1.00 - NL%MPHOTO_TRC3 = 9.0 + NL%VMFACT_C3 = 1 + NL%VMFACT_C4 = 1 + NL%MPHOTO_TRC3 = 9 NL%MPHOTO_TEC3 = 7.2 NL%MPHOTO_C4 = 5.2 - NL%BPHOTO_BLC3 = 10000. - NL%BPHOTO_NLC3 = 1000. - NL%BPHOTO_C4 = 10000. - NL%KW_GRASS = 900. - NL%KW_TREE = 600. - NL%GAMMA_C3 = 0.015 - NL%GAMMA_C4 = 0.040 + NL%BPHOTO_BLC3 = 10000 + NL%BPHOTO_NLC3 = 1000 + NL%BPHOTO_C4 = 10000 + NL%KW_GRASS = 900 + NL%KW_TREE = 600 + NL%GAMMA_C3 = 0.0145 + NL%GAMMA_C4 = 0.035 NL%D0_GRASS = 0.016 NL%D0_TREE = 0.016 - NL%ALPHA_C3 = 0.080 + NL%ALPHA_C3 = 0.08 NL%ALPHA_C4 = 0.055 - NL%KLOWCO2IN = 4000. - NL%RRFFACT = 1.000 + NL%KLOWCO2IN = 4000 + NL%RRFFACT = 1 NL%GROWTHRESP = 0.333 NL%LWIDTH_GRASS = 0.05 - NL%LWIDTH_BLTREE = 0.10 + NL%LWIDTH_BLTREE = 0.1 NL%LWIDTH_NLTREE = 0.05 NL%Q10_C3 = 2.4 NL%Q10_C4 = 2.4 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! THETACRIT -- Leaf drought phenology threshold. The sign matters here: ! ! >= 0. -- This is the relative soil moisture above the wilting point ! @@ -870,7 +981,11 @@ $ED_NL ! ing point is by definition -1.5MPa, so make sure that the value ! ! is above -1.5. ! !---------------------------------------------------------------------------------------! - NL%THETACRIT = -1.15 + NL%THETACRIT = -1.20 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! QUANTUM_EFFICIENCY_T -- Which quantum yield model should to use for C3 plants ! ! 0. Original ED-2.1, quantum efficiency is constant. ! @@ -878,18 +993,31 @@ $ED_NL ! Ehleringer (1978) polynomial fit. ! !---------------------------------------------------------------------------------------! NL%QUANTUM_EFFICIENCY_T = 0 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! N_PLANT_LIM -- This controls whether plant photosynthesis can be limited by nitrogen. ! ! 0. No limitation ! ! 1. ED-2.1 nitrogen limitation model. ! !---------------------------------------------------------------------------------------! NL%N_PLANT_LIM = 0 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! N_DECOMP_LIM -- This controls whether decomposition can be limited by nitrogen. ! ! 0. No limitation ! ! 1. ED-2.1 nitrogen limitation model. ! !---------------------------------------------------------------------------------------! NL%N_DECOMP_LIM = 0 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! The following parameters adjust the fire disturbance in the model. ! ! INCLUDE_FIRE -- Which threshold to use for fires. ! @@ -912,9 +1040,13 @@ $ED_NL ! potential is defined as -3.1 MPa, so make sure SM_FIRE is ! ! greater than this value. ! !---------------------------------------------------------------------------------------! - NL%INCLUDE_FIRE = 0 ! default is 2 - NL%FIRE_PARAMETER = 0.2 - NL%SM_FIRE = -1.45 + NL%INCLUDE_FIRE = 0 + NL%FIRE_PARAMETER = 0.5 + NL%SM_FIRE = -1.40 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! IANTH_DISTURB -- This flag controls whether to include anthropogenic disturbances ! ! such as land clearing, abandonment, and logging. ! @@ -922,6 +1054,10 @@ $ED_NL ! 1. use anthropogenic disturbance dataset. ! !---------------------------------------------------------------------------------------! NL%IANTH_DISTURB = 0 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! ICANTURB -- This flag controls the canopy roughness. ! ! 0. Based on Leuning et al. (1995), wind is computed using the similarity ! @@ -937,7 +1073,11 @@ $ED_NL ! 4. Same as 0, but if finds the ground conductance following CLM ! ! technical note (equations 5.98-5.100). ! !---------------------------------------------------------------------------------------! - NL%ICANTURB = 1 + NL%ICANTURB = 2 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! ISFCLYRM -- Similarity theory model. The model that computes u*, T*, etc... ! ! 1. BRAMS default, based on Louis (1979). It uses empirical relations to ! @@ -952,7 +1092,11 @@ $ED_NL ! 4. CLM (2004). Similar to 2 and 3, but they have special functions to deal with ! ! very stable and very stable cases. ! !---------------------------------------------------------------------------------------! - NL%ISFCLYRM = 4 ! 3 set by default + NL%ISFCLYRM = 3 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! IED_GRNDVAP -- Methods to find the ground -> canopy conductance. ! ! 0. Modified Lee Pielke (1992), adding field capacity, but using beta factor ! @@ -967,6 +1111,11 @@ $ED_NL ! to dry air soil. ! !---------------------------------------------------------------------------------------! NL%IED_GRNDVAP = 0 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! The following variables are used to control the similarity theory model. For the ! ! meaning of these parameters, check Beljaars and Holtslag (1991). ! @@ -984,6 +1133,11 @@ $ED_NL NL%TPRANDTL = 0.74 NL%RIBMAX = 0.50 NL%LEAF_MAXWHC = 0.11 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! IPERCOL -- This controls percolation and infiltration. ! ! 0. Default method. Assumes soil conductivity constant and for the ! @@ -998,6 +1152,10 @@ $ED_NL ! , otherwise it is the same as 1. ! !---------------------------------------------------------------------------------------! NL%IPERCOL = 1 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! The following variables control the plant functional types (PFTs) that will be ! ! used in this simulation. ! @@ -1019,9 +1177,14 @@ $ED_NL ! 7 - southern pines | 17 - "Araucaria" (non-optimised ! ! 8 - late conifers | Southern Pines). ! !---------------------------------------------------------------------------------------! - NL%INCLUDE_THESE_PFT = 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17 ! List of PFTs to be included - NL%AGRI_STOCK = 5 ! Agriculture PFT (used only if ianth_disturb=1) - NL%PLANTATION_STOCK = 6 ! Plantation PFT (used only if ianth_disturb=1) + NL%INCLUDE_THESE_PFT = 1,2,3,4,16 + NL%AGRI_STOCK = 1 + NL%PLANTATION_STOCK = 3 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! PFT_1ST_CHECK -- What to do if the initialisation file has a PFT that is not listed ! ! in INCLUDE_THESE_PFT (ignored if IED_INIT_MODE is -1 or 0) ! @@ -1030,6 +1193,10 @@ $ED_NL ! 2. Ignore the cohort ! !---------------------------------------------------------------------------------------! NL%PFT_1ST_CHECK = 0 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! The following variables control the size of sub-polygon structures in ED-2. ! ! MAXSITE -- This is the strict maximum number of sites that each polygon can ! @@ -1054,15 +1221,25 @@ $ED_NL ! MIN_PATCH_AREA -- This is the minimum fraction area of a given soil type that allows ! ! a site to be created (ignored if IED_INIT_MODE is set to 3). ! !---------------------------------------------------------------------------------------! - NL%MAXSITE = 6 - NL%MAXPATCH = 30 - NL%MAXCOHORT = 60 + NL%MAXSITE = 1 + NL%MAXPATCH = 10 + NL%MAXCOHORT = 40 NL%MIN_SITE_AREA = 0.005 NL%MIN_PATCH_AREA = 0.005 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! ZROUGH -- constant roughness, in metres, if for all domain ! !---------------------------------------------------------------------------------------! NL%ZROUGH = 0.1 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! Treefall disturbance parameters. ! ! TREEFALL_DISTURBANCE_RATE -- Sign-dependent treefall disturbance rate: ! @@ -1076,14 +1253,24 @@ $ED_NL ! TREEFALL_DISTURBANCE_RATE is internally adjusted so the ! ! average patch age is still 1/TREEFALL_DISTURBANCE_RATE ! !---------------------------------------------------------------------------------------! - NL%TREEFALL_DISTURBANCE_RATE = 0.0 !0.014 + NL%TREEFALL_DISTURBANCE_RATE = 0.014 NL%TIME2CANOPY = 0.0 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! RUNOFF_TIME -- In case a temporary surface water (TSW) is created, this is the "e- ! ! -folding lifetime" of the TSW in seconds due to runoff. If you don't ! ! want runoff to happen, set this to 0. ! !---------------------------------------------------------------------------------------! - NL%RUNOFF_TIME = 86400.0 + NL%RUNOFF_TIME = 3600.0 + !---------------------------------------------------------------------------------------! + + + + !---------------------------------------------------------------------------------------! ! The following variables control the minimum values of various velocities in the ! ! canopy. This is needed to avoid the air to be extremely still, or to avoid singular- ! @@ -1096,6 +1283,10 @@ $ED_NL NL%UBMIN = 0.65 NL%UGBMIN = 0.25 NL%USTMIN = 0.05 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! Control parameters for printing to standard output. Any variable can be printed ! ! to standard output as long as it is one dimensional. Polygon variables have been ! @@ -1120,6 +1311,10 @@ $ED_NL NL%PFMTSTR = 'f10.8','f5.1','f7.2','f9.5' NL%IPMIN = 1 NL%IPMAX = 60 + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! Variables that control the meteorological forcing. ! ! ! @@ -1154,16 +1349,19 @@ $ED_NL ! 3. Gloomy -- All radiation goes to diffuse. ! ! 4. Sesame street -- all radiation goes to direct, except at night. ! ! INITIAL_CO2 -- Initial value for CO2 in case no CO2 is provided at the meteorological ! - ! driver dataset [Units: ?mol/mol] ! + ! driver dataset [Units: µmol/mol] ! + !---------------------------------------------------------------------------------------! + NL%IMETTYPE = 1 + NL%ISHUFFLE = 0 + NL%METCYC1 = 2000 + NL%METCYCF = 2003 + NL%IMETAVG = 1 + NL%IMETRAD = 2 + NL%INITIAL_CO2 = 378.0 !---------------------------------------------------------------------------------------! - NL%IMETTYPE = 1 ! 0 = ASCII, 1 = HDF5 - NL%ISHUFFLE = 2 ! 2. Randomly pick recycled years - NL%METCYC1 = @MET_START@ ! First year of met data - NL%METCYCF = @MET_END@ ! Last year of met data - NL%IMETAVG = @MET_SOURCE@ - NL%IMETRAD = 0 - NL%INITIAL_CO2 = 370.0 ! Initial value for CO2 in case no CO2 is provided at the - ! meteorological driver dataset + + + !---------------------------------------------------------------------------------------! ! The following variables control the phenology prescribed from observations: ! ! ! @@ -1175,11 +1373,15 @@ $ED_NL ! ! ! If the years don't cover the entire simulation period, they will be recycled. ! !---------------------------------------------------------------------------------------! - NL%IPHENYS1 = @PHENOL_START@ - NL%IPHENYSF = @PHENOL_END@ - NL%IPHENYF1 = @PHENOL_START@ - NL%IPHENYFF = @PHENOL_END@ - NL%PHENPATH = '@PHENOL@' + NL%IPHENYS1 = 1992 + NL%IPHENYSF = 2003 + NL%IPHENYF1 = 1992 + NL%IPHENYFF = 2003 + NL%PHENPATH = '/n/moorcroft_data/data/ed2_data/phenology/phenology' + !---------------------------------------------------------------------------------------! + + + !---------------------------------------------------------------------------------------! ! These are some additional configuration files. ! ! IEDCNFGF -- XML file containing additional parameter settings. If you don't have ! @@ -1188,25 +1390,12 @@ $ED_NL ! simulation. ! ! PHENPATH -- path and prefix of the prescribed phenology data. ! !---------------------------------------------------------------------------------------! - NL%IEDCNFGF = '@CONFIGFILE@' + NL%IEDCNFGF = 'config.xml' NL%EVENT_FILE = 'myevents.xml' !---------------------------------------------------------------------------------------! - ! Census variables. This is going to create unique census statuses to cohorts, to ! - ! better compare the model with census observations. In case you don't intend to ! - ! compare the model with census data, set up DT_CENSUS to 1., otherwise you may reduce ! - ! cohort fusion. ! - ! DT_CENSUS -- Time between census, in months. Currently the maximum is 60 ! - ! months, to avoid excessive memory allocation. Every time the ! - ! simulation reaches the census time step, all census tags will be ! - ! reset. ! - ! YR1ST_CENSUS -- In which year was the first census conducted? ! - ! MON1ST_CENSUS -- In which month was the first census conducted? ! - ! MIN_RECRUIT_DBH -- Minimum DBH that is measured in the census, in cm. ! - !---------------------------------------------------------------------------------------! - NL%DT_CENSUS = 1 - NL%YR1ST_CENSUS = 1901 - NL%MON1ST_CENSUS = 7 - NL%MIN_RECRUIT_DBH = 10 + + + !---------------------------------------------------------------------------------------! ! The following variables are used to control the detailed output for debugging ! ! purposes. ! @@ -1252,8 +1441,197 @@ $ED_NL !---------------------------------------------------------------------------------------! ! IOPTINPT -- Optimization configuration. (Currently not used) ! !---------------------------------------------------------------------------------------! - NL%IOPTINPT = '' + !NL%IOPTINPT = '' !---------------------------------------------------------------------------------------! + NL%IOOUTPUT = 3 + NL%IADD_SITE_MEANS = 0 + NL%IADD_PATCH_MEANS = 0 + NL%IADD_COHORT_MEANS = 0 + NL%GROWTH_RESP_SCHEME = 0 + NL%STORAGE_RESP_SCHEME = 0 + NL%PLANT_HYDRO_SCHEME = 0 + NL%ISTOMATA_SCHEME = 0 + NL%ISTRUCT_GROWTH_SCHEME = 0 + NL%TRAIT_PLASTICITY_SCHEME = 0 + NL%IDDMORT_SCHEME = 0 + NL%CBR_SCHEME = 0 + NL%DDMORT_CONST = 0 + NL%ICANRAD = 1 + NL%DT_CENSUS = 60 + NL%YR1ST_CENSUS = 2000 + NL%MON1ST_CENSUS = 6 + NL%MIN_RECRUIT_DBH = 50 $END !==========================================================================================! !==========================================================================================! +``` +
+ +Convert the docker image to singularity +``` +singularity pull docker://pecan/model-ed2-git +``` + +Finally you can run the singularity image +``` +singularity exec -B ed_inputs:/data/ed_inputs -B faoOLD:/data/faoOLD -B oge2OLD:/data/oge2OLD -B sites:/data/sites -B testrun.s83:/data/testrun.s83 --pwd /data/testrun.s83 ./model-ed2-git.simg ed2.git -s +``` + +Note that the `-B` option will mount the folder into the singularity image as the second argument (afther the :) + +The ed2.git command is started with the `-s` which will run it in single mode, and not initialize and use MPI. + +Once the model is finished the outputs should be available under `testrun.s83`. + +The example ED2IN file is not 100% correct and will result in the following error: + +
+output of (failed) run (click to expand) +``` ++---------------- MPI parallel info: --------------------+ ++ - Machnum = 0 ++ - Machsize = 1 ++---------------- OMP parallel info: --------------------+ ++ - thread use: 1 ++ - threads max: 1 ++ - cpu use: 1 ++ - cpus max: 1 ++ Note: Max vals are for node, not sockets. ++--------------------------------------------------------+ +Reading namelist information +Copying namelist + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! WARNING! WARNING! WARNING! WARNING! WARNING! !!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + -> Outfast cannot be less than frqfast. + Oufast was redefined to 3600. seconds. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!! WARNING! WARNING! WARNING! WARNING! WARNING! !!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + -> Outstate cannot be different than frqstate when + unitstate is set to 3 (years). + Oustate was set to 1. years. + Oustate was redefined to 1. years. +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ++------------------------------------------------------------+ +| Ecosystem Demography Model, version 2.2 ++------------------------------------------------------------+ +| Input namelist filename is ED2IN +| +| Single process execution on INITIAL run. ++------------------------------------------------------------+ + => Generating the land/sea mask. +/data/oge2OLD/OGE2_HEADER + -> Getting file: /data/oge2OLD/OGE2_30S060W.h5... + + Work allocation, node 1; + + Polygon array allocation, node 1; + + Memory successfully allocated on none 1; + [+] Load_Ed_Ecosystem_Params... +---------------------------------------- + Treefall disturbance parameters: + - LAMBDA_REF = 1.40000E-02 + - LAMBDA_EFF = 1.40000E-02 + - TIME2CANOPY = 0.00000E+00 +---------------------------------------- + [+] Checking for XML config... +********************************************* +** WARNING! ** +** ** +** XML file wasn't found. Using default ** +** parameters in ED. ** +** (You provided config.xml). +** ** +********************************************* + [+] Alloc_Soilgrid... + [+] Set_Polygon_Coordinates... + [+] Sfcdata_ED... + [+] Load_Ecosystem_State... + + Doing sequential initialization over nodes. + + Initializing from ED restart file. Node: 001 + [-] filelist_f: Checking prefix: /data/sites/Santarem_Km83/s83_default. + + Showing first 10 files: + [-] File #: 1 /data/sites/Santarem_Km83/s83_default.lat-3.018lon-54.971.css + [-] File #: 2 /data/sites/Santarem_Km83/s83_default.lat-3.018lon-54.971.pss +Using patch file: /data/sites/Santarem_Km83/s83_default.lat-3.018lon-54.971.pss +Using cohort file: /data/sites/Santarem_Km83/s83_default.lat-3.018lon-54.971.css + + Initializing phenology. Node: 001 + - Reading thermal sums. + + Initializing anthropogenic disturbance forcing. Node: 001 + + -------------------------------------------------------- + Soil information: + + Polygon name : ts83 + Longitude : -54.971 + Latitude : -3.018 + Prescribed sand and clay : T + # of sites : 1 + + Site : 1 + - Type : 16 + - Clay fraction = 5.90000E-01 + - Sand fraction = 3.90000E-01 + - Silt fraction = 2.00000E-02 + - SLBS = 1.22460E+01 + - SLPOTS = -1.52090E-01 + - SLCONS = 2.30320E-06 + - Dry air soil = 2.29248E-01 + - Wilting point = 2.43249E-01 + - Field capacity = 3.24517E-01 + - Saturation = 4.27790E-01 + - Heat capacity = 1.30601E+06 + -------------------------------------------------------- + + [+] Init_Met_Drivers... + [+] Read_Met_Drivers_Init... +------------------------------ + - METCYC1 = 2000 + - METCYCF = 2003 + - NYEARS = 2 +------------------------------ + IYEAR YEAR_USE + 1 2001 + 2 2002 +------------------------------ + + [+] Update_met_drivers... + [+] Ed_Init_Atm... +Total count in node 1 for grid 1 : POLYGONS= 1 SITES= 1 PATCHES= 18 COHORTS= 1753 +Grid: 1 Poly: 1 Lon: -54.9710 Lat: -3.0180 Nplants: 0.73 Avg. LAI: 4.45 NPatches: 18 NCohorts: 660 + [+] initHydrology... +initHydrology | mynum= 1 ngrids= 1 mpolys= 1 msites= 1 +Allocated | mynum= 1 ngrids= 1 mpolys= 1 msites= 1 +Updated | mynum= 1 ngrids= 1 mpolys= 1 msites= 1 +Deallocated | mynum= 1 ngrids= 1 mpolys= 1 msites= 1 + [+] Filltab_Alltypes... + [+] Finding frqsum... + [+] Loading obstime_list +File /nowhere not found! +Specify OBSTIME_DB properly in ED namelist. +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +-------------------------------------------------------------- + !!! FATAL ERROR !!! +-------------------------------------------------------------- + ---> File: ed_init.F90 + ---> Subroutine: read_obstime + ---> Reason: OBSTIME_DB not found! +-------------------------------------------------------------- + ED execution halts (see previous error message)... +-------------------------------------------------------------- +STOP fatal_error +``` +
diff --git a/book_source/Makefile b/book_source/Makefile index 5d57f169a91..1411d6fcd75 100755 --- a/book_source/Makefile +++ b/book_source/Makefile @@ -23,7 +23,10 @@ DEMO_1_FIGS := $(wildcard ../documentation/tutorials/01_Demo_Basic_Run/extfiles/ build: bkdcheck mkdir -p extfiles cp -f ${DEMO_1_FIGS} extfiles/ - Rscript -e 'bookdown::render_book("index.Rmd", "bookdown::gitbook")' + # options call is a workaround for a behavior change and probable bug in bookdown 0.20: + # https://stackoverflow.com/a/62583304 + # Remove when this is fixed in Bookdown + Rscript -e 'options(bookdown.render.file_scope=FALSE); bookdown::render_book("index.Rmd", "bookdown::gitbook")' clean: rm -rf ../book/* @@ -32,4 +35,4 @@ deploy: build ./deploy.sh pdf: bkdcheck - Rscript -e 'bookdown::render_book("index.Rmd", "bookdown::pdf_book")' + Rscript -e 'options(bookdown.render.file_scope=FALSE); bookdown::render_book("index.Rmd", "bookdown::pdf_book")' diff --git a/book_source/figures/env-file.PNG b/book_source/figures/env-file.PNG new file mode 100644 index 00000000000..f1ad8553b90 Binary files /dev/null and b/book_source/figures/env-file.PNG differ diff --git a/book_source/figures/run_output_plot.png b/book_source/figures/run_output_plot.png new file mode 100644 index 00000000000..d8179f2970b Binary files /dev/null and b/book_source/figures/run_output_plot.png differ diff --git a/book_source/index.Rmd b/book_source/index.Rmd index 5a98dc670ea..51eb2e000c6 100644 --- a/book_source/index.Rmd +++ b/book_source/index.Rmd @@ -6,6 +6,24 @@ documentclass: book biblio-style: apalike link-citations: yes author: "By: PEcAn Team" +output: + bookdown::gitbook: + lib_dir: assets + split_by: section + config: + toolbar: + position: static + bookdown::pdf_book: + keep_tex: yes + bookdown::epub_book: + toc: true + bookdown::html_book: + css: toc.css +always_allow_html: true +#output: +# html_document: +# toc: true +# toc_float: true --- # Welcome {-} @@ -26,7 +44,7 @@ knitr::include_graphics(rep("figures/PecanLogo.png")) [PEcAn Website](http://pecanproject.github.io/) -[Public Chat Room](https://join.slack.com/t/pecanproject/shared_invite/enQtMzkyODUyMjQyNTgzLTYyZTZiZWQ4NGE1YWU3YWIyMTVmZjEyYzA3OWJhYTZmOWQwMDkwZGU0Mjc4Nzk0NGYwYTIyM2RiZmMyNjg5MTE) +[Public Chat Room](https://join.slack.com/t/pecanproject/shared_invite/enQtMzkyODUyMjQyNTgzLWEzOTM1ZjhmYWUxNzYwYzkxMWVlODAyZWQwYjliYzA0MDA0MjE4YmMyOTFhMjYyMjYzN2FjODE4N2Y4YWFhZmQ) [Github Repository](https://github.com/PecanProject/pecan) diff --git a/docker-compose.dev.yml b/docker-compose.dev.yml new file mode 100644 index 00000000000..a35993435ac --- /dev/null +++ b/docker-compose.dev.yml @@ -0,0 +1,105 @@ +# mkdir -p volumes/{lib,pecan,portainer,postgres,rabbitmq,traefik} +# +# docker-compose -f docker-compose.yml -f docker-compose.dev.yml + +version: '3.2' + +services: + + # web application. This expects the config.php to be copied from docker/web + # cp docker/web/config.docker.php web/config.php + #web: + # volumes: + # - 'pecan_web:/var/www/html/pecan' + + # executor can compile the code + executor: + volumes: + - 'pecan_home:/pecan/' + - 'pecan_lib:/usr/local/lib/R/site-library/' + + # use same for R development in rstudio + rstudio: + volumes: + - 'pecan_home:/pecan/' + - 'pecan_home:/home/carya/pecan/' + - 'pecan_lib:/usr/local/lib/R/site-library/' + + # use following as template for other models + # this can be used if you are changng the code for a model in PEcAN + sipnet: + volumes: + - 'pecan_lib:/usr/local/lib/R/site-library/' + + # this will open postgres to the hostcompute + #postgres: + # ports: + # - '5432:5432' + + # Allow to see all docker containers running, restart and see log files. + #portainer: + # image: portainer/portainer:latest + # command: + # - --admin-password=${PORTAINER_PASSWORD:-} + # - --host=unix:///var/run/docker.sock + # restart: unless-stopped + # networks: + # - pecan + # labels: + # - "traefik.enable=true" + # - "traefik.backend=portainer" + # - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefixStrip: /portainer" + # - "traefik.website.frontend.whiteList.sourceRange=${TRAEFIK_IPFILTER:-172.16.0.0/12}" + # volumes: + # - /var/run/docker.sock:/var/run/docker.sock + # - portainer:/data + +# ----------------------------------------------------------------------- +# Theser are the volumes mounted into the containers. For speed reasons +# it is best to use docker native containers (less important on Linux). +# The pecan_home and pecan_web are important since this allows us to +# share the PEcAn source code from local machine to docker containers. +# Volumes are placed outside of the PEcAn source tree to allow for +# optimized caching of the changed files. +# ----------------------------------------------------------------------- +volumes: + pecan_home: + driver_opts: + type: none + device: '${PWD}' + o: bind + pecan_web: + driver_opts: + type: none + device: '${PWD}/web/' + o: bind + pecan_lib: + # driver_opts: + # type: none + # device: '${HOME}/volumes/pecan/lib' + # o: bind + #pecan: + # driver_opts: + # type: none + # device: '${HOME}/volumes/pecan/pecan' + # o: bind + #traefik: + # driver_opts: + # type: none + # device: '${HOME}/volumes/pecan/traefik' + # o: bind + #postgres: + # driver_opts: + # type: none + # device: '${HOME}/volumes/pecan/postgres' + # o: bind + #rabbitmq: + # driver_opts: + # type: none + # device: '${HOME}/volumes/pecan/rabbitmq' + # o: bind + portainer: + # driver_opts: + # type: none + # device: '${HOME}/volumes/pecan/portainer' + # o: bind diff --git a/docker-compose.yml b/docker-compose.yml index ad54ac58843..9fb83a3e77a 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -1,4 +1,4 @@ -version: "3" +version: "3.2" services: @@ -37,30 +37,12 @@ services: - "traefik.enable=true" - "traefik.backend=traefik" - "traefik.port=8080" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefixStrip: /traefik" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefixStrip: /traefik" - "traefik.website.frontend.whiteList.sourceRange=${TRAEFIK_IPFILTER:-172.16.0.0/12}" volumes: - /var/run/docker.sock:/var/run/docker.sock:ro - traefik:/config - # Allow to see all docker containers running, restart and see log files. - portainer: - image: portainer/portainer:latest - command: - - --admin-password=${PORTAINER_PASSWORD:-} - - --host=unix:///var/run/docker.sock - restart: unless-stopped - networks: - - pecan - labels: - - "traefik.enable=true" - - "traefik.backend=portainer" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefixStrip: /portainer" - - "traefik.website.frontend.whiteList.sourceRange=${TRAEFIK_IPFILTER:-172.16.0.0/12}" - volumes: - - /var/run/docker.sock:/var/run/docker.sock - - portainer:/data - # ---------------------------------------------------------------------- # Access to the files generated and used by PEcAn, both through a # web interface (minio) as well using the thredds server. @@ -68,6 +50,7 @@ services: # webserver to handle access to data minio: + user: "${UID:-1001}:${GID:-1001}" image: minio/minio:latest command: server /data restart: unless-stopped @@ -80,12 +63,13 @@ services: - "traefik.enable=true" - "traefik.backend=minio" - "traefik.port=9000" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefix:/minio/" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/minio/" volumes: - pecan:/data # THREDDS data server thredds: + user: "${UID:-1001}:${GID:-1001}" image: pecan/thredds:${PECAN_VERSION:-latest} restart: unless-stopped networks: @@ -95,7 +79,7 @@ services: labels: - "traefik.enable=true" - "traefik.port=8080" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefix:/thredds" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/thredds" - "traefik.backend=thredds" # ---------------------------------------------------------------------- @@ -106,7 +90,7 @@ services: # rabbitmq to connect to extractors rabbitmq: - image: rabbitmq:management + image: rabbitmq:3.8-management restart: unless-stopped networks: - pecan @@ -118,7 +102,7 @@ services: - "traefik.enable=true" - "traefik.backend=rabbitmq" - "traefik.port=15672" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefix:/rabbitmq" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/rabbitmq" - "traefik.website.frontend.whiteList.sourceRange=${TRAEFIK_IPFILTER:-172.16.0.0/12}" volumes: - rabbitmq:/var/lib/rabbitmq @@ -153,7 +137,7 @@ services: - postgres labels: - "traefik.enable=true" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefix:/bety/" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/bety/" - "traefik.backend=bety" # ---------------------------------------------------------------------- @@ -163,22 +147,35 @@ services: image: pecan/rstudio-nginx:${PECAN_VERSION:-latest} networks: - pecan + depends_on: + - rstudio labels: - "traefik.enable=true" - "traefik.backend=rstudio" - "traefik.port=80" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefix:/rstudio" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/rstudio" - "traefik.website.frontend.whiteList.sourceRange=${TRAEFIK_IPFILTER:-172.16.0.0/12}" rstudio: image: pecan/base:${PECAN_VERSION:-latest} + command: /work/rstudio.sh restart: unless-stopped networks: - pecan + depends_on: + - rabbitmq + - postgres environment: + - KEEP_ENV=RABBITMQ_URI RABBITMQ_PREFIX RABBITMQ_PORT FQDN NAME + - RABBITMQ_URI=${RABBITMQ_URI:-amqp://guest:guest@rabbitmq/%2F} + - RABBITMQ_PREFIX=/rabbitmq + - RABBITMQ_PORT=15672 + - FQDN=${PECAN_FQDN:-docker} + - NAME=${PECAN_NAME:-docker} - USER=${PECAN_RSTUDIO_USER:-carya} - PASSWORD=${PECAN_RSTUDIO_PASS:-illinois} - entrypoint: /init + - USERID=${UID:-1001} + - GROUPID=${GID:-1001} volumes: - pecan:/data - rstudio:/home @@ -195,11 +192,12 @@ services: - pecan labels: - "traefik.enable=true" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefix:/" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/" - "traefik.backend=docs" # PEcAn web front end, this is just the PHP code web: + user: "${UID:-1001}:${GID:-1001}" image: pecan/web:${PECAN_VERSION:-latest} restart: unless-stopped networks: @@ -208,12 +206,14 @@ services: - RABBITMQ_URI=${RABBITMQ_URI:-amqp://guest:guest@rabbitmq/%2F} - FQDN=${PECAN_FQDN:-docker} - NAME=${PECAN_NAME:-docker} + - SECRET_KEY_BASE=${BETY_SECRET_KEY:-thisisnotasecret} depends_on: - postgres - rabbitmq labels: + - "traefik.port=8080" - "traefik.enable=true" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefix:/pecan/" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/pecan/" - "traefik.backend=pecan" volumes: - pecan:/data @@ -221,6 +221,7 @@ services: # PEcAn model monitor monitor: + user: "${UID:-1001}:${GID:-1001}" image: pecan/monitor:${PECAN_VERSION:-latest} restart: unless-stopped networks: @@ -234,19 +235,22 @@ services: - rabbitmq labels: - "traefik.enable=true" - - "traefik.frontend.rule=${TRAEFIK_FRONTEND_RULE:-}PathPrefixStrip:/monitor/" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefixStrip:/monitor/" - "traefik.backend=monitor" volumes: - pecan:/data # PEcAn executor, executes jobs. Does not the actual models executor: + user: "${UID:-1001}:${GID:-1001}" image: pecan/executor:${PECAN_VERSION:-latest} restart: unless-stopped networks: - pecan environment: - RABBITMQ_URI=${RABBITMQ_URI:-amqp://guest:guest@rabbitmq/%2F} + - RABBITMQ_PREFIX=/rabbitmq + - RABBITMQ_PORT=15672 - FQDN=${PECAN_FQDN:-docker} depends_on: - postgres @@ -258,9 +262,24 @@ services: # PEcAn models, list each model you want to run below # ---------------------------------------------------------------------- + # PEcAn basgra model runner + basgra: + user: "${UID:-1001}:${GID:-1001}" + image: pecan/model-basgra-basgra_n_v1.0:${PECAN_VERSION:-latest} + restart: unless-stopped + networks: + - pecan + environment: + - RABBITMQ_URI=${RABBITMQ_URI:-amqp://guest:guest@rabbitmq/%2F} + depends_on: + - rabbitmq + volumes: + - pecan:/data + # PEcAn sipnet model runner sipnet: - image: pecan/model-sipnet-136:${PECAN_VERSION:-latest} + user: "${UID:-1001}:${GID:-1001}" + image: pecan/model-sipnet-r136:${PECAN_VERSION:-latest} restart: unless-stopped networks: - pecan @@ -273,6 +292,7 @@ services: # PEcAn ED model runner ed2: + user: "${UID:-1001}:${GID:-1001}" image: pecan/model-ed2-git:${PECAN_VERSION:-latest} restart: unless-stopped networks: @@ -286,6 +306,7 @@ services: # PEcAn MAESPA model runner maespa: + user: "${UID:-1001}:${GID:-1001}" image: pecan/model-maespa-git:${PECAN_VERSION:-latest} restart: unless-stopped networks: @@ -297,6 +318,49 @@ services: volumes: - pecan:/data + # ---------------------------------------------------------------------- + # Shiny Apps + # ---------------------------------------------------------------------- + # PEcAn DB Sync visualization + dbsync: + image: pecan/shiny-dbsync:${PECAN_VERSION:-latest} + restart: unless-stopped + networks: + - pecan + depends_on: + - postgres + labels: + - "traefik.enable=true" + - "traefik.backend=dbsync" + - "traefik.port=3838" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefixStrip:/dbsync/" + + # ---------------------------------------------------------------------- + # PEcAn API + # ---------------------------------------------------------------------- + api: + image: pecan/api:${PECAN_VERSION:-latest} + user: "${UID:-1001}:${GID:-1001}" + networks: + - pecan + environment: + - PGHOST=${PGHOST:-postgres} + - HOST_ONLY=${HOST_ONLY:-FALSE} + - AUTH_REQ=${AUTH_REQ:-TRUE} + - RABBITMQ_URI=${RABBITMQ_URI:-amqp://guest:guest@rabbitmq/%2F} + - DATA_DIR=${DATA_DIR:-/data/} + - DBFILES_DIR=${DBFILES_DIR:-/data/dbfiles/} + - SECRET_KEY_BASE=${BETY_SECRET_KEY:-thisisnotasecret} + labels: + - "traefik.enable=true" + - "traefik.frontend.rule=${TRAEFIK_HOST:-}PathPrefix:/api" + - "traefik.backend=api" + - "traefik.port=8000" + depends_on: + - postgres + volumes: + - pecan:/data/ + # ---------------------------------------------------------------------- # Name of network to be used by all containers # ---------------------------------------------------------------------- diff --git a/docker.sh b/docker.sh index 31a124214be..bc5c1ef66b7 100755 --- a/docker.sh +++ b/docker.sh @@ -11,7 +11,7 @@ cd $(dirname $0) # Can set the following variables DEBUG=${DEBUG:-""} DEPEND=${DEPEND:-""} -R_VERSION=${R_VERSION:-"3.5"} +R_VERSION=${R_VERSION:-"4.0.2"} # -------------------------------------------------------------------------------- # PECAN BUILD SECTION @@ -45,7 +45,7 @@ while getopts dfhi:r: opt; do ;; h) cat << EOF -$0 [-dfh] [-i ] [-r ] [-r > "/home/${USER}/.Renviron" +#fi + +for x in ${KEEP_ENV}; do + value="$(echo "${!x}" | sed 's/\//\\\//g')" + sed -i -e "/^$x=/{h;s/=.*/=${value}/};\${x;/^\$/{s//$x=${value}/;H};x}" "/home/${USER}/.Renviron" +done + +exec /init diff --git a/docker/check/Dockerfile b/docker/check/Dockerfile new file mode 100644 index 00000000000..c99c9eef1a1 --- /dev/null +++ b/docker/check/Dockerfile @@ -0,0 +1,16 @@ +FROM python:3.7-alpine + +ENV RABBITMQ_URI=amqp://guest:guest@rabbitmq/%2F \ + PGHOST=posgres \ + PGPORT=5432 \ + PGUSER=postgres + +COPY requirements.txt /src/ +RUN pip install -r /src/requirements.txt \ + && apk --no-cache add bash curl postgresql-client + +COPY check_* /src/ + +USER 1000 +WORKDIR /src +CMD ./check_rabbitmq diff --git a/docker/check/check_betydb b/docker/check/check_betydb new file mode 100755 index 00000000000..a1c995d5dcc --- /dev/null +++ b/docker/check/check_betydb @@ -0,0 +1,7 @@ +#!/bin/bash + +while ! curl --silent --fail --output /dev/null --location ${BETYDBURL}; do + echo "Waiting for betydb" + sleep 2 +done +echo "BETYDB is ready" diff --git a/docker/check/check_postgresql b/docker/check/check_postgresql new file mode 100755 index 00000000000..29036ebb632 --- /dev/null +++ b/docker/check/check_postgresql @@ -0,0 +1,26 @@ +#!/bin/bash + +while ! pg_isready -U ${PGUSER} -h ${PGHOST} -p ${PGPORT}; do + echo "Waiting for database system" + sleep 2 +done + +# if given use BETY credentials, check for BETY database +if [ -n "$BETYUSER" ]; then + # set PGPASSWORD so we are not prompted for password + PGPASSWORD="${BETYPASSWORD}" + + # wait for bety user / database to be active + while ! pg_isready -U ${BETYUSER} -h ${PGHOST} -p ${PGPORT} -d ${BETYDATABASE}; do + echo "Waiting for bety database" + sleep 2 + done + + # wait for list of users to be active + while ! psql -U ${BETYUSER} -h ${PGHOST} -p ${PGPORT} -d ${BETYDATABASE} -tAc "SELECT count(id) FROM users;"; do + echo "Waiting for user table to be populated" + sleep 2 + done +fi + +echo "Database is ready" diff --git a/docker/check/check_rabbitmq b/docker/check/check_rabbitmq new file mode 100755 index 00000000000..f7fa1fdc93c --- /dev/null +++ b/docker/check/check_rabbitmq @@ -0,0 +1,19 @@ +#!/usr/bin/env python3 + +import os +import pika +import time + +rabbitmq_uri = os.getenv('RABBITMQ_URI', 'amqp://guest:guest@localhost/%2F') + +params = pika.URLParameters(rabbitmq_uri) +while True: + try: + connection = pika.BlockingConnection(params) + if connection.is_open: + print('RabbitMQ is alive') + connection.close() + exit(0) + except Exception as error: + print('Error:', error.__class__.__name__, error) + time.sleep(2) diff --git a/docker/check/requirements.txt b/docker/check/requirements.txt new file mode 100644 index 00000000000..becc2ce1d48 --- /dev/null +++ b/docker/check/requirements.txt @@ -0,0 +1 @@ +pika==1.1.0 diff --git a/docker/data/Dockerfile b/docker/data/Dockerfile index a2198026757..2ac60cd7e83 100644 --- a/docker/data/Dockerfile +++ b/docker/data/Dockerfile @@ -1,17 +1,13 @@ -FROM ubuntu +FROM alpine MAINTAINER Rob Kooper # name to use in the machines table FQDN when registering the data files -ENV FQDN="" +ENV FQDN="" \ + PSQL="psql -U bety -h postgres -d bety -q -t -c" WORKDIR /work -RUN apt-get update \ - && apt-get install -y --no-install-recommends \ - curl \ - postgresql-client \ - unzip \ - && rm -rf /var/lib/apt/lists/* \ +RUN apk --no-cache add bash curl rsync postgresql-client unzip \ && curl -s -o sites.tgz http://isda.ncsa.illinois.edu/~kooper/EBI/sites.tgz \ && curl -s -o inputs.tgz http://isda.ncsa.illinois.edu/~kooper/EBI/inputs.tgz \ && curl -s -o cru_1901_2006.bin http://isda.ncsa.illinois.edu/~kooper/PEcAn/data/cru_1901_2006.bin \ diff --git a/docker/data/add-data.sh b/docker/data/add-data.sh index af4e10c5ef6..1fbe0159dd0 100644 --- a/docker/data/add-data.sh +++ b/docker/data/add-data.sh @@ -10,9 +10,6 @@ fi # assumes pecan data folder mounted under /data DATADIR="/data" -# assumes postgres database running container postgers -PSQL="psql -U bety -h postgres -d bety -q -t -c" - # load helper functions and set FQDN and PSQL . $( dirname $0 )/add.util.sh @@ -22,7 +19,7 @@ echo "######################################################################" echo "CREATE FOLDERS" echo "######################################################################" mkdir -p /data/workflows /data/dbfiles -chown 33 /data/workflows /data/dbfiles +chmod 777 /data/workflows /data/dbfiles echo "######################################################################" echo "Adding sites" @@ -35,7 +32,7 @@ fi echo "######################################################################" echo "Adding inputs" echo "######################################################################" -if [ ! -e ${DATADIR}/inputs ]; then +if [ ! -e ${DATADIR}/ed_inputs ]; then tar zxf /work/inputs.tgz fi diff --git a/docker/data/add.util.sh b/docker/data/add.util.sh index 36e3b44637b..0c07020c1e4 100644 --- a/docker/data/add.util.sh +++ b/docker/data/add.util.sh @@ -33,7 +33,7 @@ addFormat() { fi FORMAT_ID=$( ${PSQL} "SELECT id FROM formats WHERE mimetype_id=${MIME_ID} AND name='$2' LIMIT 1;" ) if [ "$FORMAT_ID" == "" ]; then - ${PSQL} "INSERT INTO formats (mimetype_id, name, created_at, updated_at) VALUES (${MIME_ID}, '$2', NOW(), NOW());" + ${PSQL} "INSERT INTO formats (mimetype_id, name) VALUES (${MIME_ID}, '$2');" FORMAT_ID=$( ${PSQL} "SELECT id FROM formats WHERE mimetype_id=${MIME_ID} AND name='$2' LIMIT 1;" ) echo "Added new format with ID=${FORMAT_ID} for mimetype_id=${MIME_ID}, name=$2" fi @@ -62,7 +62,7 @@ addInput() { fi INPUT_ID=$( ${PSQL} "SELECT id FROM inputs WHERE site_id=$1 AND format_id=$2 AND start_date${START_Q} AND end_date${END_Q} LIMIT 1;" ) if [ "$INPUT_ID" == "" ]; then - ${PSQL} "INSERT INTO inputs (site_id, format_id, name, start_date, end_date, created_at, updated_at) VALUES ($1, $2, '', ${START_I}, ${END_I}, NOW(), NOW());" + ${PSQL} "INSERT INTO inputs (site_id, format_id, name, start_date, end_date) VALUES ($1, $2, '', ${START_I}, ${END_I});" INPUT_ID=$( ${PSQL} "SELECT id FROM inputs WHERE site_id=$1 AND format_id=$2 AND start_date${START_Q} AND end_date${END_Q} LIMIT 1;" ) echo "Added new input with ID=${INPUT_ID} for site=$1, format_id=$2, start=$3, end=$4" else @@ -93,8 +93,8 @@ addInputFile() { fi # Make sure host exists - ${PSQL} "INSERT INTO machines (hostname, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" + ${PSQL} "INSERT INTO machines (hostname) + SELECT * FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" # Add file ${PSQL} "INSERT INTO dbfiles (container_type, container_id, file_name, file_path, machine_id) VALUES @@ -116,16 +116,16 @@ addModelFile() { MODELID="(SELECT models.id FROM models, modeltypes WHERE model_name='${2}' AND modeltypes.name='${3}' AND modeltypes.id=models.modeltype_id AND revision='${4}')" # Make sure host exists - ${PSQL} "INSERT INTO machines (hostname, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" + ${PSQL} "INSERT INTO machines (hostname) + SELECT * FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" # Make sure modeltype exists - ${PSQL} "INSERT INTO modeltypes (name, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${3}') AS tmp WHERE NOT EXISTS ${MODELTYPEID};" + ${PSQL} "INSERT INTO modeltypes (name) + SELECT * FROM (SELECT '${3}') AS tmp WHERE NOT EXISTS ${MODELTYPEID};" # Make sure model exists - ${PSQL} "INSERT INTO models (model_name, modeltype_id, revision, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${2}', ${MODELTYPEID}, '${4}') AS tmp WHERE NOT EXISTS ${MODELID};" + ${PSQL} "INSERT INTO models (model_name, modeltype_id, revision) + SELECT * FROM (SELECT '${2}', ${MODELTYPEID}, '${4}') AS tmp WHERE NOT EXISTS ${MODELID};" # check if binary already added COUNT=$( ${PSQL} "SELECT COUNT(id) FROM dbfiles WHERE container_type='Model' AND container_id=${MODELID} AND file_name='${5}' AND file_path='${6}' and machine_id=${HOSTID};" ) diff --git a/docker/depends/Dockerfile b/docker/depends/Dockerfile index 132ee55b881..ca9bfb566c5 100644 --- a/docker/depends/Dockerfile +++ b/docker/depends/Dockerfile @@ -1,4 +1,4 @@ -ARG R_VERSION="3.5" +ARG R_VERSION="4.0.2" # ---------------------------------------------------------------------- # PECAN FOR MODEL BASE IMAGE @@ -6,14 +6,28 @@ ARG R_VERSION="3.5" FROM rocker/tidyverse:${R_VERSION} MAINTAINER Rob Kooper +# ---------------------------------------------------------------------- +# UPDATE GIT +# This is needed for stretch and github actions +# ---------------------------------------------------------------------- +RUN if [ "$(lsb_release -s -c)" = "stretch" ]; then \ + echo 'deb http://deb.debian.org/debian stretch-backports main' >> /etc/apt/sources.list \ + && apt-get update \ + && apt-get -t stretch-backports upgrade -y git \ + ; fi + # ---------------------------------------------------------------------- # INSTALL BINARY/LIBRARY DEPENDENCIES # ---------------------------------------------------------------------- RUN apt-get update \ && apt-get -y --no-install-recommends install \ + curl \ jags \ time \ + openssh-client \ + rsync \ libgdal-dev \ + libglpk-dev \ librdf0-dev \ libnetcdf-dev \ libudunits2-dev \ @@ -24,7 +38,9 @@ RUN apt-get update \ # ---------------------------------------------------------------------- # INSTALL DEPENDENCIES # ---------------------------------------------------------------------- -COPY pecan.depends / -RUN bash /pecan.depends \ +COPY pecan.depends.R / +RUN Rscript -e "install.packages(c('devtools'))" \ + && Rscript -e "devtools::install_version('roxygen2', '7.0.2')" \ + && R_LIBS_USER='/usr/local/lib/R/site-library' Rscript /pecan.depends.R \ && rm -rf /tmp/* diff --git a/docker/depends/pecan.depends b/docker/depends/pecan.depends deleted file mode 100644 index 9b00cb36a82..00000000000 --- a/docker/depends/pecan.depends +++ /dev/null @@ -1,118 +0,0 @@ -#!/bin/bash -# autogenerated do not edit -# use scripts/generate.dockerfile.depends - -# stop on error -set -e - -# Don't use X11 for rgl -RGL_USE_NULL=TRUE - -# install remotes first in case packages are references in dependencies -installGithub.r \ - araiho/linkages_package \ - ebimodeling/biocro \ - MikkoPeltoniemi/Rpreles \ - ropensci/geonames \ - ropensci/nneo - -# install all packages (depends, imports, suggests) -install2.r -e -s -n -1\ - abind \ - BayesianTools \ - BioCro \ - car \ - coda \ - data.table \ - dataone \ - datapack \ - DBI \ - dbplyr \ - doParallel \ - dplyr \ - ellipse \ - fields \ - foreach \ - furrr \ - geonames \ - getPass \ - ggmap \ - ggplot2 \ - glue \ - graphics \ - grDevices \ - grid \ - gridExtra \ - hdf5r \ - here \ - httr \ - IDPmisc \ - jsonlite \ - knitr \ - lattice \ - linkages \ - lubridate \ - Maeswrap \ - magic \ - magrittr \ - maps \ - maptools \ - MASS \ - mclust \ - MCMCpack \ - methods \ - mgcv \ - minpack.lm \ - mlegp \ - mockery \ - MODISTools \ - mvtnorm \ - ncdf4 \ - ncdf4.helpers \ - nimble \ - nneo \ - parallel \ - plotrix \ - plyr \ - png \ - progress \ - purrr \ - pwr \ - randtoolbox \ - raster \ - rcrossref \ - RCurl \ - REddyProc \ - redland \ - reshape \ - reshape2 \ - reticulate \ - rgdal \ - rjags \ - rjson \ - rlang \ - rnoaa \ - RPostgres \ - RPostgreSQL \ - Rpreles \ - RSQLite \ - sf \ - SimilarityMeasures \ - sirt \ - sp \ - stats \ - stringi \ - stringr \ - testthat \ - tibble \ - tictoc \ - tidyr \ - tidyverse \ - tools \ - truncnorm \ - udunits2 \ - utils \ - XML \ - xtable \ - xts \ - zoo diff --git a/docker/depends/pecan.depends.R b/docker/depends/pecan.depends.R new file mode 100644 index 00000000000..27b98a9f05d --- /dev/null +++ b/docker/depends/pecan.depends.R @@ -0,0 +1,141 @@ +#!/usr/bin/env Rscript +# autogenerated do not edit +# use scripts/generate_dependencies.R + +# Don't use X11 for rgl +Sys.setenv(RGL_USE_NULL = TRUE) +rlib <- Sys.getenv('R_LIBS_USER', '/usr/local/lib/R/site-library') +Sys.setenv(RLIB = rlib) + +# install remotes first in case packages are references in dependencies +lapply(c( +'araiho/linkages_package', +'ebimodeling/biocro', +'MikkoPeltoniemi/Rpreles', +'r-lib/testthat@v3.0.4', +'r-lib/vdiffr@v1.0.2', +'ropensci/geonames', +'ropensci/nneo' +), remotes::install_github, lib = rlib) + +# install all packages (depends, imports, suggests) +wanted <- c( +'abind', +'BayesianTools', +'binaryLogic', +'BioCro', +'bit64', +'BrownDog', +'coda', +'corrplot', +'data.table', +'dataone', +'datapack', +'DBI', +'dbplyr', +'doParallel', +'dplR', +'dplyr', +'ellipse', +'foreach', +'fs', +'furrr', +'future', +'geonames', +'getPass', +'ggmap', +'ggplot2', +'ggrepel', +'glue', +'graphics', +'grDevices', +'grid', +'gridExtra', +'hdf5r', +'here', +'httr', +'IDPmisc', +'jsonlite', +'knitr', +'lattice', +'linkages', +'lqmm', +'lubridate', +'Maeswrap', +'magic', +'magrittr', +'maps', +'maptools', +'MASS', +'Matrix', +'mclust', +'MCMCpack', +'methods', +'mgcv', +'minpack.lm', +'mlegp', +'mockery', +'MODISTools', +'mvbutils', +'mvtnorm', +'ncdf4', +'neonUtilities', +'nimble', +'nneo', +'optparse', +'parallel', +'plotrix', +'plyr', +'png', +'prodlim', +'progress', +'purrr', +'pwr', +'R.utils', +'randtoolbox', +'raster', +'rcrossref', +'RCurl', +'REddyProc', +'redland', +'reshape', +'reshape2', +'reticulate', +'rgdal', +'rjags', +'rjson', +'rlang', +'rmarkdown', +'RPostgres', +'RPostgreSQL', +'Rpreles', +'RSQLite', +'sf', +'SimilarityMeasures', +'sirt', +'sp', +'stats', +'stringi', +'stringr', +'testthat', +'tibble', +'tictoc', +'tidyr', +'tidyselect', +'tidyverse', +'tools', +'traits', +'TruncatedNormal', +'truncnorm', +'udunits2', +'urltools', +'utils', +'vdiffr', +'withr', +'XML', +'xtable', +'xts', +'zoo' +) +missing <- wanted[!(wanted %in% installed.packages()[,'Package'])] +install.packages(missing, lib = rlib) diff --git a/docker/docs/index.html b/docker/docs/index.html index cae72ca0ca7..5a941cf10a1 100644 --- a/docker/docs/index.html +++ b/docker/docs/index.html @@ -1,45 +1,112 @@ -PEcAn - -

PEcAn

+ PEcAn + +

PEcAn

-

Climate change science has witnessed an explosion in the amount and types of data that can be brought to bear on the potential responses of the terrestrial carbon cycle and biodiversity to global change. Many of the most pressing questions about global change are not necessarily limited by the need to collect new data as much as by our ability to synthesize existing data. This project specifically seeks to improve this ability. Because no one measurement provides a complete picture, multiple data sources must be integrated in a sensible manner. Process-based models represent an ideal framework for integrating these data streams because they represent multiple processes at different spatial and temporal scales in ways that capture our current understanding of the causal connections across scales and among data types. Three components are required to bridge this gap between the available data and the required level of understanding: 1) a state-of-the-art ecosystem model, 2) a workflow management system to handle the numerous streams of data, and 3) a data assimilation statistical framework in order to synthesize the data with the model.

+

+ Climate change science has witnessed an explosion in the amount and types + of data that can be brought to bear on the potential responses of the + terrestrial carbon cycle and biodiversity to global change. Many of the + most pressing questions about global change are not necessarily limited by + the need to collect new data as much as by our ability to synthesize + existing data. This project specifically seeks to improve this ability. + Because no one measurement provides a complete picture, multiple data + sources must be integrated in a sensible manner. Process-based models + represent an ideal framework for integrating these data streams because + they represent multiple processes at different spatial and temporal scales + in ways that capture our current understanding of the causal connections + across scales and among data types. Three components are required to + bridge this gap between the available data and the required level of + understanding: 1) a state-of-the-art ecosystem model, 2) a workflow + management system to handle the numerous streams of data, and 3) a data + assimilation statistical framework in order to synthesize the data with + the model. +

-

Applications

+

Applications

- + -

Documentation

+

Documentation

- + -

Community

+

Community

- + -

Acknowledgements

+

Acknowledgements

-

The PEcAn project is supported by the National Science Foundation (ABI #1062547, ABI #1458021, DIBBS #1261582, ARC #1023477, EF #1318164, EF #1241894, EF #1241891), NASA Terrestrial Ecosystems, the Department of Energy (ARPA-E awards #DE-AR0000594 and DE-AR0000598), the Energy Biosciences Institute, and an Amazon AWS in Education Grant.

+

+ The PEcAn project is supported by the National Science Foundation (ABI + #1062547, ABI #1458021, DIBBS #1261582, ARC #1023477, EF #1318164, EF + #1241894, EF #1241891), NASA Terrestrial Ecosystems, the Department of + Energy (ARPA-E awards #DE-AR0000594 and DE-AR0000598), the Energy + Biosciences Institute, and an Amazon AWS in Education Grant. +

-

PEcAn is open-source and built using open source software, and we benefit from the use of a wide range of other software, including R, JAGS, MySQL, Ruby on Rails, PHP, C, and Fortran. In addition, we appreciate the availability of development tools including RStudio, Vim, Emacs, Navicat, and Git/GitHub

- - +

+ PEcAn is open-source and built using open source software, and we benefit + from the use of a wide range of other software, including R, JAGS, MySQL, + Ruby on Rails, PHP, C, and Fortran. In addition, we appreciate the + availability of development tools including RStudio, Vim, Emacs, Navicat, + and Git/GitHub +

+ diff --git a/docker/env.example b/docker/env.example index e2083fc8e86..ee0ca6d8ec1 100644 --- a/docker/env.example +++ b/docker/env.example @@ -6,7 +6,7 @@ # ---------------------------------------------------------------------- # project name (-p flag for docker-compose) -#COMPOSE_PROJECT_NAME=dev +#COMPOSE_PROJECT_NAME=pecan # ---------------------------------------------------------------------- # TRAEFIK CONFIGURATION diff --git a/docker/executor/Dockerfile b/docker/executor/Dockerfile index 4b68c7ba897..34722783909 100644 --- a/docker/executor/Dockerfile +++ b/docker/executor/Dockerfile @@ -20,8 +20,8 @@ WORKDIR /work # variables to store in docker image ENV RABBITMQ_URI="amqp://guest:guest@rabbitmq/%2F" \ RABBITMQ_QUEUE="pecan" \ - APPLICATION="R CMD BATCH workflow.R" + APPLICATION="workflow" # actual application that will be executed -COPY executor.py sender.py /work/ +COPY executor.py /work/ CMD python3 /work/executor.py diff --git a/docker/executor/executor.py b/docker/executor/executor.py index b79e089e277..a432df87ecb 100644 --- a/docker/executor/executor.py +++ b/docker/executor/executor.py @@ -55,6 +55,14 @@ def runfunc(self): application = "R CMD BATCH workflow.R" elif custom_application is not None: application = custom_application + elif default_application == "workflow": + application = "R CMD BATCH" + if jbody.get("continue") == True: + application = application + " --continue workflow.R workflow2.Rout"; + else: + if jbody.get("modeledit") == True: + application = application + " --advanced" + application = application + " workflow.R workflow.Rout"; else: logging.info("Running default command: %s" % default_application) application = default_application diff --git a/docker/models/model.py b/docker/models/model.py index 7d21f73c6b8..26352744ed7 100644 --- a/docker/models/model.py +++ b/docker/models/model.py @@ -24,67 +24,68 @@ def __init__(self, method, properties, body): self.finished = False def runfunc(self): - logging.debug(self.body) - jbody = json.loads(self.body.decode('UTF-8')) - - folder = jbody.get('folder') - rebuild = jbody.get('rebuild') - pecan_xml = jbody.get('pecan_xml') - custom_application = jbody.get('custom_application') - - if rebuild is not None: - logging.info("Rebuilding PEcAn with make") - application = 'make' - folder = '/pecan' - elif pecan_xml is not None: - # Passed entire pecan XML as a string - logging.info("Running XML passed directly") - try: - os.mkdir(folder) - except OSError as e: - logging.info("Caught the following OSError. ", - "If it's just that the directory exists, ", - "this can probably be ignored: ", e) - workflow_path = os.path.join(folder, "workflow.R") - shutil.copyfile("/pecan/web/workflow.R", workflow_path) - xml_file = open(os.path.join(folder, "pecan.xml"), "w") - xml_file.write(pecan_xml) - xml_file.close() - - # Set variables for execution - application = "R CMD BATCH workflow.R" - elif custom_application is not None: - application = custom_application - else: - logging.info("Running default command: %s" % default_application) - application = default_application - - logging.info("Running command: %s" % application) - logging.info("Starting command in directory %s." % folder) try: - output = subprocess.check_output(application, stderr=subprocess.STDOUT, shell=True, cwd=folder) - status = 'OK' - except subprocess.CalledProcessError as e: - logging.exception("Error running job.") - output = e.output - status = 'ERROR' - except Exception as e: - logging.exception("Error running job.") - output = str(e) - status = 'ERROR' - - logging.info("Finished running job with status " + status) - logging.info(output) + logging.debug(self.body) + jbody = json.loads(self.body.decode('UTF-8')) + + folder = jbody.get('folder') + rebuild = jbody.get('rebuild') + pecan_xml = jbody.get('pecan_xml') + custom_application = jbody.get('custom_application') + + if rebuild is not None: + logging.info("Rebuilding PEcAn with make") + application = 'make' + folder = '/pecan' + elif pecan_xml is not None: + # Passed entire pecan XML as a string + logging.info("Running XML passed directly") + try: + os.mkdir(folder) + except OSError as e: + logging.info("Caught the following OSError. ", + "If it's just that the directory exists, ", + "this can probably be ignored: ", e) + workflow_path = os.path.join(folder, "workflow.R") + shutil.copyfile("/pecan/web/workflow.R", workflow_path) + xml_file = open(os.path.join(folder, "pecan.xml"), "w") + xml_file.write(pecan_xml) + xml_file.close() + + # Set variables for execution + application = "R CMD BATCH workflow.R" + elif custom_application is not None: + application = custom_application + else: + logging.info("Running default command: %s" % default_application) + application = default_application + + logging.info("Running command: %s" % application) + logging.info("Starting command in directory %s." % folder) + try: + output = subprocess.check_output(application, stderr=subprocess.STDOUT, shell=True, cwd=folder) + status = 'OK' + except subprocess.CalledProcessError as e: + logging.exception("Error running job.") + output = e.output + status = 'ERROR' + except Exception as e: + logging.exception("Error running job.") + output = str(e) + status = 'ERROR' + + logging.info("Finished running job with status " + status) + logging.info(output) - try: - with open(os.path.join(folder, 'rabbitmq.out'), 'w') as out: - out.write(str(output) + "\n") - out.write(status + "\n") - except Exception: - logging.exception("Error writing status.") - - # done processing, set finished to true - self.finished = True + try: + with open(os.path.join(folder, 'rabbitmq.out'), 'w') as out: + out.write(str(output) + "\n") + out.write(status + "\n") + except Exception: + logging.exception("Error writing status.") + finally: + # done processing, set finished to true + self.finished = True # called for every message, this will start the program and ack message if all is ok. diff --git a/docker/monitor/Dockerfile b/docker/monitor/Dockerfile index 76dfc97ff21..ea776f08796 100644 --- a/docker/monitor/Dockerfile +++ b/docker/monitor/Dockerfile @@ -3,7 +3,10 @@ FROM python:3.5 ENV RABBITMQ_URI="amqp://guest:guest@rabbitmq/%2F" \ RABBITMQ_MGMT_PORT="15672" \ RABBITMQ_MGMT_PATH="/rabbitmq/" \ - POSTGRES_PARAM="host=postgres dbname=bety user=bety password=bety connect_timeout=10" \ + PGHOST="postgres" \ + BETYUSER="bety" \ + BETYPASSWORD="bety" \ + BETYDATABASE="bety" \ FQDN="pecan" EXPOSE 9999 @@ -13,5 +16,5 @@ WORKDIR /src COPY requirements.txt /src/ RUN pip3 install -r /src/requirements.txt -COPY monitor.py /src/ +COPY . /src/ CMD python3 monitor.py diff --git a/docker/monitor/bootstrap-table.min.css b/docker/monitor/bootstrap-table.min.css new file mode 100644 index 00000000000..14afe05cb3e --- /dev/null +++ b/docker/monitor/bootstrap-table.min.css @@ -0,0 +1,10 @@ +/** + * bootstrap-table - An extended table to integration with some of the most widely used CSS frameworks. (Supports Bootstrap, Semantic UI, Bulma, Material Design, Foundation) + * + * @version v1.15.5 + * @homepage https://bootstrap-table.com + * @author wenzhixin (http://wenzhixin.net.cn/) + * @license MIT + */ + +@charset "UTF-8";.bootstrap-table .fixed-table-toolbar::after{content:"";display:block;clear:both}.bootstrap-table .fixed-table-toolbar .bs-bars,.bootstrap-table .fixed-table-toolbar .search,.bootstrap-table .fixed-table-toolbar .columns{position:relative;margin-top:10px;margin-bottom:10px}.bootstrap-table .fixed-table-toolbar .columns .btn-group>.btn-group{display:inline-block;margin-left:-1px!important}.bootstrap-table .fixed-table-toolbar .columns .btn-group>.btn-group>.btn{border-radius:0}.bootstrap-table .fixed-table-toolbar .columns .btn-group>.btn-group:first-child>.btn{border-top-left-radius:4px;border-bottom-left-radius:4px}.bootstrap-table .fixed-table-toolbar .columns .btn-group>.btn-group:last-child>.btn{border-top-right-radius:4px;border-bottom-right-radius:4px}.bootstrap-table .fixed-table-toolbar .columns .dropdown-menu{text-align:left;max-height:300px;overflow:auto;-ms-overflow-style:scrollbar;z-index:1001}.bootstrap-table .fixed-table-toolbar .columns label{display:block;padding:3px 20px;clear:both;font-weight:normal;line-height:1.428571429}.bootstrap-table .fixed-table-toolbar .columns-left{margin-right:5px}.bootstrap-table .fixed-table-toolbar .columns-right{margin-left:5px}.bootstrap-table .fixed-table-toolbar .pull-right .dropdown-menu{right:0;left:auto}.bootstrap-table .fixed-table-container{position:relative;clear:both}.bootstrap-table .fixed-table-container .table{width:100%;margin-bottom:0!important}.bootstrap-table .fixed-table-container .table th,.bootstrap-table .fixed-table-container .table td{vertical-align:middle;box-sizing:border-box}.bootstrap-table .fixed-table-container .table thead th{vertical-align:bottom;padding:0;margin:0}.bootstrap-table .fixed-table-container .table thead th:focus{outline:0 solid transparent}.bootstrap-table .fixed-table-container .table thead th.detail{width:30px}.bootstrap-table .fixed-table-container .table thead th .th-inner{padding:.75rem;vertical-align:bottom;overflow:hidden;text-overflow:ellipsis;white-space:nowrap}.bootstrap-table .fixed-table-container .table thead th .sortable{cursor:pointer;background-position:right;background-repeat:no-repeat;padding-right:30px}.bootstrap-table .fixed-table-container .table thead th .both{background-image:url("data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABMAAAATCAQAAADYWf5HAAAAkElEQVQoz7X QMQ5AQBCF4dWQSJxC5wwax1Cq1e7BAdxD5SL+Tq/QCM1oNiJidwox0355mXnG/DrEtIQ6azioNZQxI0ykPhTQIwhCR+BmBYtlK7kLJYwWCcJA9M4qdrZrd8pPjZWPtOqdRQy320YSV17OatFC4euts6z39GYMKRPCTKY9UnPQ6P+GtMRfGtPnBCiqhAeJPmkqAAAAAElFTkSuQmCC")}.bootstrap-table .fixed-table-container .table thead th .asc{background-image:url("data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABMAAAATCAYAAAByUDbMAAAAZ0lEQVQ4y2NgGLKgquEuFxBPAGI2ahhWCsS/gDibUoO0gPgxEP8H4ttArEyuQYxAPBdqEAxPBImTY5gjEL9DM+wTENuQahAvEO9DMwiGdwAxOymGJQLxTyD+jgWDxCMZRsEoGAVoAADeemwtPcZI2wAAAABJRU5ErkJggg==")}.bootstrap-table .fixed-table-container .table thead th .desc{background-image:url("data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABMAAAATCAYAAAByUDbMAAAAZUlEQVQ4y2NgGAWjYBSggaqGu5FA/BOIv2PBIPFEUgxjB+IdQPwfC94HxLykus4GiD+hGfQOiB3J8SojEE9EM2wuSJzcsFMG4ttQgx4DsRalkZENxL+AuJQaMcsGxBOAmGvopk8AVz1sLZgg0bsAAAAASUVORK5CYII= ")}.bootstrap-table .fixed-table-container .table tbody tr.selected td{background-color:rgba(0,0,0,0.075)}.bootstrap-table .fixed-table-container .table tbody tr.no-records-found{text-align:center}.bootstrap-table .fixed-table-container .table tbody tr .card-view{display:flex}.bootstrap-table .fixed-table-container .table tbody tr .card-view .card-view-title{font-weight:bold;display:inline-block;min-width:30%;text-align:left!important}.bootstrap-table .fixed-table-container .table .bs-checkbox{text-align:center}.bootstrap-table .fixed-table-container .table .bs-checkbox label{margin-bottom:0}.bootstrap-table .fixed-table-container .table input[type=radio],.bootstrap-table .fixed-table-container .table input[type=checkbox]{margin:0 auto!important}.bootstrap-table .fixed-table-container .table.table-sm .th-inner{padding:.3rem}.bootstrap-table .fixed-table-container.fixed-height:not(.has-footer){border-bottom:1px solid #dee2e6}.bootstrap-table .fixed-table-container.fixed-height.has-card-view{border-top:1px solid #dee2e6;border-bottom:1px solid #dee2e6}.bootstrap-table .fixed-table-container.fixed-height .fixed-table-border{border-left:1px solid #dee2e6;border-right:1px solid #dee2e6}.bootstrap-table .fixed-table-container.fixed-height .table thead th{border-bottom:1px solid #dee2e6}.bootstrap-table .fixed-table-container.fixed-height .table-dark thead th{border-bottom:1px solid #32383e}.bootstrap-table .fixed-table-container .fixed-table-header{overflow:hidden}.bootstrap-table .fixed-table-container .fixed-table-body{overflow-x:auto;overflow-y:auto;height:100%}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading{align-items:center;background:#fff;display:none;justify-content:center;position:absolute;bottom:0;width:100%;z-index:1000}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap{align-items:baseline;display:flex;justify-content:center}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap .loading-text{font-size:2rem;margin-right:6px}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap .animation-wrap{align-items:center;display:flex;justify-content:center}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap .animation-dot,.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap .animation-wrap::after,.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap .animation-wrap::before{content:"";animation-duration:1.5s;animation-iteration-count:infinite;animation-name:LOADING;background:#212529;border-radius:50%;display:block;height:5px;margin:0 4px;opacity:0;width:5px}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap .animation-dot{animation-delay:.3s}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading .loading-wrap .animation-wrap::after{animation-delay:.6s}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading.table-dark{background:#212529}.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading.table-dark .animation-dot,.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading.table-dark .animation-wrap::after,.bootstrap-table .fixed-table-container .fixed-table-body .fixed-table-loading.table-dark .animation-wrap::before{background:#fff}.bootstrap-table .fixed-table-container .fixed-table-footer{overflow:hidden}.bootstrap-table .fixed-table-pagination::after{content:"";display:block;clear:both}.bootstrap-table .fixed-table-pagination>.pagination-detail,.bootstrap-table .fixed-table-pagination>.pagination{margin-top:10px;margin-bottom:10px}.bootstrap-table .fixed-table-pagination>.pagination-detail .pagination-info{line-height:34px;margin-right:5px}.bootstrap-table .fixed-table-pagination>.pagination-detail .page-list{display:inline-block}.bootstrap-table .fixed-table-pagination>.pagination-detail .page-list .btn-group{position:relative;display:inline-block;vertical-align:middle}.bootstrap-table .fixed-table-pagination>.pagination-detail .page-list .btn-group .dropdown-menu{margin-bottom:0}.bootstrap-table .fixed-table-pagination>.pagination ul.pagination{margin:0}.bootstrap-table .fixed-table-pagination>.pagination ul.pagination a{padding:6px 12px;line-height:1.428571429}.bootstrap-table .fixed-table-pagination>.pagination ul.pagination li.page-intermediate a{color:#c8c8c8}.bootstrap-table .fixed-table-pagination>.pagination ul.pagination li.page-intermediate a::before{content:"⬅"}.bootstrap-table .fixed-table-pagination>.pagination ul.pagination li.page-intermediate a::after{content:"➡"}.bootstrap-table .fixed-table-pagination>.pagination ul.pagination li.disabled a{pointer-events:none;cursor:default}.bootstrap-table.fullscreen{position:fixed;top:0;left:0;z-index:1050;width:100%!important;background:#fff;height:calc(100vh);overflow-y:scroll}div.fixed-table-scroll-inner{width:100%;height:200px}div.fixed-table-scroll-outer{top:0;left:0;visibility:hidden;width:200px;height:150px;overflow:hidden}@keyframes LOADING{0%{opacity:0}50%{opacity:1}to{opacity:0}} \ No newline at end of file diff --git a/docker/monitor/bootstrap-table.min.js b/docker/monitor/bootstrap-table.min.js new file mode 100644 index 00000000000..d37bccfb153 --- /dev/null +++ b/docker/monitor/bootstrap-table.min.js @@ -0,0 +1,10 @@ +/** + * bootstrap-table - An extended table to integration with some of the most widely used CSS frameworks. (Supports Bootstrap, Semantic UI, Bulma, Material Design, Foundation) + * + * @version v1.15.5 + * @homepage https://bootstrap-table.com + * @author wenzhixin (http://wenzhixin.net.cn/) + * @license MIT + */ + +!function(t,e){"object"==typeof exports&&"undefined"!=typeof module?module.exports=e(require("jquery")):"function"==typeof define&&define.amd?define(["jquery"],e):(t=t||self).BootstrapTable=e(t.jQuery)}(this,(function(t){"use strict";t=t&&t.hasOwnProperty("default")?t.default:t;var e="undefined"!=typeof globalThis?globalThis:"undefined"!=typeof window?window:"undefined"!=typeof global?global:"undefined"!=typeof self?self:{};function i(t,e){return t(e={exports:{}},e.exports),e.exports}var n,o,r,a="object",s=function(t){return t&&t.Math==Math&&t},l=s(typeof globalThis==a&&globalThis)||s(typeof window==a&&window)||s(typeof self==a&&self)||s(typeof e==a&&e)||Function("return this")(),c=function(t){try{return!!t()}catch(t){return!0}},h=!c((function(){return 7!=Object.defineProperty({},"a",{get:function(){return 7}}).a})),u={}.propertyIsEnumerable,d=Object.getOwnPropertyDescriptor,f={f:d&&!u.call({1:2},1)?function(t){var e=d(this,t);return!!e&&e.enumerable}:u},p=function(t,e){return{enumerable:!(1&t),configurable:!(2&t),writable:!(4&t),value:e}},g={}.toString,v=function(t){return g.call(t).slice(8,-1)},b="".split,y=c((function(){return!Object("z").propertyIsEnumerable(0)}))?function(t){return"String"==v(t)?b.call(t,""):Object(t)}:Object,m=function(t){if(null==t)throw TypeError("Can't call method on "+t);return t},w=function(t){return y(m(t))},S=function(t){return"object"==typeof t?null!==t:"function"==typeof t},x=function(t,e){if(!S(t))return t;var i,n;if(e&&"function"==typeof(i=t.toString)&&!S(n=i.call(t)))return n;if("function"==typeof(i=t.valueOf)&&!S(n=i.call(t)))return n;if(!e&&"function"==typeof(i=t.toString)&&!S(n=i.call(t)))return n;throw TypeError("Can't convert object to primitive value")},k={}.hasOwnProperty,O=function(t,e){return k.call(t,e)},T=l.document,C=S(T)&&S(T.createElement),P=function(t){return C?T.createElement(t):{}},$=!h&&!c((function(){return 7!=Object.defineProperty(P("div"),"a",{get:function(){return 7}}).a})),I=Object.getOwnPropertyDescriptor,A={f:h?I:function(t,e){if(t=w(t),e=x(e,!0),$)try{return I(t,e)}catch(t){}if(O(t,e))return p(!f.f.call(t,e),t[e])}},E=function(t){if(!S(t))throw TypeError(String(t)+" is not an object");return t},R=Object.defineProperty,N={f:h?R:function(t,e,i){if(E(t),e=x(e,!0),E(i),$)try{return R(t,e,i)}catch(t){}if("get"in i||"set"in i)throw TypeError("Accessors not supported");return"value"in i&&(t[e]=i.value),t}},j=h?function(t,e,i){return N.f(t,e,p(1,i))}:function(t,e,i){return t[e]=i,t},F=function(t,e){try{j(l,t,e)}catch(i){l[t]=e}return e},_=i((function(t){var e=l["__core-js_shared__"]||F("__core-js_shared__",{});(t.exports=function(t,i){return e[t]||(e[t]=void 0!==i?i:{})})("versions",[]).push({version:"3.1.3",mode:"global",copyright:"© 2019 Denis Pushkarev (zloirock.ru)"})})),V=_("native-function-to-string",Function.toString),B=l.WeakMap,L="function"==typeof B&&/native code/.test(V.call(B)),D=0,H=Math.random(),M=function(t){return"Symbol("+String(void 0===t?"":t)+")_"+(++D+H).toString(36)},U=_("keys"),q=function(t){return U[t]||(U[t]=M(t))},z={},W=l.WeakMap;if(L){var G=new W,K=G.get,J=G.has,Y=G.set;n=function(t,e){return Y.call(G,t,e),e},o=function(t){return K.call(G,t)||{}},r=function(t){return J.call(G,t)}}else{var X=q("state");z[X]=!0,n=function(t,e){return j(t,X,e),e},o=function(t){return O(t,X)?t[X]:{}},r=function(t){return O(t,X)}}var Q={set:n,get:o,has:r,enforce:function(t){return r(t)?o(t):n(t,{})},getterFor:function(t){return function(e){var i;if(!S(e)||(i=o(e)).type!==t)throw TypeError("Incompatible receiver, "+t+" required");return i}}},Z=i((function(t){var e=Q.get,i=Q.enforce,n=String(V).split("toString");_("inspectSource",(function(t){return V.call(t)})),(t.exports=function(t,e,o,r){var a=!!r&&!!r.unsafe,s=!!r&&!!r.enumerable,c=!!r&&!!r.noTargetGet;"function"==typeof o&&("string"!=typeof e||O(o,"name")||j(o,"name",e),i(o).source=n.join("string"==typeof e?e:"")),t!==l?(a?!c&&t[e]&&(s=!0):delete t[e],s?t[e]=o:j(t,e,o)):s?t[e]=o:F(e,o)})(Function.prototype,"toString",(function(){return"function"==typeof this&&e(this).source||V.call(this)}))})),tt=l,et=function(t){return"function"==typeof t?t:void 0},it=function(t,e){return arguments.length<2?et(tt[t])||et(l[t]):tt[t]&&tt[t][e]||l[t]&&l[t][e]},nt=Math.ceil,ot=Math.floor,rt=function(t){return isNaN(t=+t)?0:(t>0?ot:nt)(t)},at=Math.min,st=function(t){return t>0?at(rt(t),9007199254740991):0},lt=Math.max,ct=Math.min,ht=function(t,e){var i=rt(t);return i<0?lt(i+e,0):ct(i,e)},ut=function(t){return function(e,i,n){var o,r=w(e),a=st(r.length),s=ht(n,a);if(t&&i!=i){for(;a>s;)if((o=r[s++])!=o)return!0}else for(;a>s;s++)if((t||s in r)&&r[s]===i)return t||s||0;return!t&&-1}},dt={includes:ut(!0),indexOf:ut(!1)},ft=dt.indexOf,pt=function(t,e){var i,n=w(t),o=0,r=[];for(i in n)!O(z,i)&&O(n,i)&&r.push(i);for(;e.length>o;)O(n,i=e[o++])&&(~ft(r,i)||r.push(i));return r},gt=["constructor","hasOwnProperty","isPrototypeOf","propertyIsEnumerable","toLocaleString","toString","valueOf"],vt=gt.concat("length","prototype"),bt={f:Object.getOwnPropertyNames||function(t){return pt(t,vt)}},yt={f:Object.getOwnPropertySymbols},mt=it("Reflect","ownKeys")||function(t){var e=bt.f(E(t)),i=yt.f;return i?e.concat(i(t)):e},wt=function(t,e){for(var i=mt(e),n=N.f,o=A.f,r=0;rr;)N.f(t,i=n[r++],e[i]);return t},Ft=it("document","documentElement"),_t=q("IE_PROTO"),Vt=function(){},Bt=function(){var t,e=P("iframe"),i=gt.length;for(e.style.display="none",Ft.appendChild(e),e.src=String("javascript:"),(t=e.contentWindow.document).open(),t.write(" + + + + + + + diff --git a/docker/monitor/jquery-3.3.1.min.js b/docker/monitor/jquery-3.3.1.min.js new file mode 100644 index 00000000000..4d9b3a25875 --- /dev/null +++ b/docker/monitor/jquery-3.3.1.min.js @@ -0,0 +1,2 @@ +/*! jQuery v3.3.1 | (c) JS Foundation and other contributors | jquery.org/license */ +!function(e,t){"use strict";"object"==typeof module&&"object"==typeof module.exports?module.exports=e.document?t(e,!0):function(e){if(!e.document)throw new Error("jQuery requires a window with a document");return t(e)}:t(e)}("undefined"!=typeof window?window:this,function(e,t){"use strict";var n=[],r=e.document,i=Object.getPrototypeOf,o=n.slice,a=n.concat,s=n.push,u=n.indexOf,l={},c=l.toString,f=l.hasOwnProperty,p=f.toString,d=p.call(Object),h={},g=function e(t){return"function"==typeof t&&"number"!=typeof t.nodeType},y=function e(t){return null!=t&&t===t.window},v={type:!0,src:!0,noModule:!0};function m(e,t,n){var i,o=(t=t||r).createElement("script");if(o.text=e,n)for(i in v)n[i]&&(o[i]=n[i]);t.head.appendChild(o).parentNode.removeChild(o)}function x(e){return null==e?e+"":"object"==typeof e||"function"==typeof e?l[c.call(e)]||"object":typeof e}var b="3.3.1",w=function(e,t){return new w.fn.init(e,t)},T=/^[\s\uFEFF\xA0]+|[\s\uFEFF\xA0]+$/g;w.fn=w.prototype={jquery:"3.3.1",constructor:w,length:0,toArray:function(){return o.call(this)},get:function(e){return null==e?o.call(this):e<0?this[e+this.length]:this[e]},pushStack:function(e){var t=w.merge(this.constructor(),e);return t.prevObject=this,t},each:function(e){return w.each(this,e)},map:function(e){return this.pushStack(w.map(this,function(t,n){return e.call(t,n,t)}))},slice:function(){return this.pushStack(o.apply(this,arguments))},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},eq:function(e){var t=this.length,n=+e+(e<0?t:0);return this.pushStack(n>=0&&n0&&t-1 in e)}var E=function(e){var t,n,r,i,o,a,s,u,l,c,f,p,d,h,g,y,v,m,x,b="sizzle"+1*new Date,w=e.document,T=0,C=0,E=ae(),k=ae(),S=ae(),D=function(e,t){return e===t&&(f=!0),0},N={}.hasOwnProperty,A=[],j=A.pop,q=A.push,L=A.push,H=A.slice,O=function(e,t){for(var n=0,r=e.length;n+~]|"+M+")"+M+"*"),z=new RegExp("="+M+"*([^\\]'\"]*?)"+M+"*\\]","g"),X=new RegExp(W),U=new RegExp("^"+R+"$"),V={ID:new RegExp("^#("+R+")"),CLASS:new RegExp("^\\.("+R+")"),TAG:new RegExp("^("+R+"|[*])"),ATTR:new RegExp("^"+I),PSEUDO:new RegExp("^"+W),CHILD:new RegExp("^:(only|first|last|nth|nth-last)-(child|of-type)(?:\\("+M+"*(even|odd|(([+-]|)(\\d*)n|)"+M+"*(?:([+-]|)"+M+"*(\\d+)|))"+M+"*\\)|)","i"),bool:new RegExp("^(?:"+P+")$","i"),needsContext:new RegExp("^"+M+"*[>+~]|:(even|odd|eq|gt|lt|nth|first|last)(?:\\("+M+"*((?:-\\d)?\\d*)"+M+"*\\)|)(?=[^-]|$)","i")},G=/^(?:input|select|textarea|button)$/i,Y=/^h\d$/i,Q=/^[^{]+\{\s*\[native \w/,J=/^(?:#([\w-]+)|(\w+)|\.([\w-]+))$/,K=/[+~]/,Z=new RegExp("\\\\([\\da-f]{1,6}"+M+"?|("+M+")|.)","ig"),ee=function(e,t,n){var r="0x"+t-65536;return r!==r||n?t:r<0?String.fromCharCode(r+65536):String.fromCharCode(r>>10|55296,1023&r|56320)},te=/([\0-\x1f\x7f]|^-?\d)|^-$|[^\0-\x1f\x7f-\uFFFF\w-]/g,ne=function(e,t){return t?"\0"===e?"\ufffd":e.slice(0,-1)+"\\"+e.charCodeAt(e.length-1).toString(16)+" ":"\\"+e},re=function(){p()},ie=me(function(e){return!0===e.disabled&&("form"in e||"label"in e)},{dir:"parentNode",next:"legend"});try{L.apply(A=H.call(w.childNodes),w.childNodes),A[w.childNodes.length].nodeType}catch(e){L={apply:A.length?function(e,t){q.apply(e,H.call(t))}:function(e,t){var n=e.length,r=0;while(e[n++]=t[r++]);e.length=n-1}}}function oe(e,t,r,i){var o,s,l,c,f,h,v,m=t&&t.ownerDocument,T=t?t.nodeType:9;if(r=r||[],"string"!=typeof e||!e||1!==T&&9!==T&&11!==T)return r;if(!i&&((t?t.ownerDocument||t:w)!==d&&p(t),t=t||d,g)){if(11!==T&&(f=J.exec(e)))if(o=f[1]){if(9===T){if(!(l=t.getElementById(o)))return r;if(l.id===o)return r.push(l),r}else if(m&&(l=m.getElementById(o))&&x(t,l)&&l.id===o)return r.push(l),r}else{if(f[2])return L.apply(r,t.getElementsByTagName(e)),r;if((o=f[3])&&n.getElementsByClassName&&t.getElementsByClassName)return L.apply(r,t.getElementsByClassName(o)),r}if(n.qsa&&!S[e+" "]&&(!y||!y.test(e))){if(1!==T)m=t,v=e;else if("object"!==t.nodeName.toLowerCase()){(c=t.getAttribute("id"))?c=c.replace(te,ne):t.setAttribute("id",c=b),s=(h=a(e)).length;while(s--)h[s]="#"+c+" "+ve(h[s]);v=h.join(","),m=K.test(e)&&ge(t.parentNode)||t}if(v)try{return L.apply(r,m.querySelectorAll(v)),r}catch(e){}finally{c===b&&t.removeAttribute("id")}}}return u(e.replace(B,"$1"),t,r,i)}function ae(){var e=[];function t(n,i){return e.push(n+" ")>r.cacheLength&&delete t[e.shift()],t[n+" "]=i}return t}function se(e){return e[b]=!0,e}function ue(e){var t=d.createElement("fieldset");try{return!!e(t)}catch(e){return!1}finally{t.parentNode&&t.parentNode.removeChild(t),t=null}}function le(e,t){var n=e.split("|"),i=n.length;while(i--)r.attrHandle[n[i]]=t}function ce(e,t){var n=t&&e,r=n&&1===e.nodeType&&1===t.nodeType&&e.sourceIndex-t.sourceIndex;if(r)return r;if(n)while(n=n.nextSibling)if(n===t)return-1;return e?1:-1}function fe(e){return function(t){return"input"===t.nodeName.toLowerCase()&&t.type===e}}function pe(e){return function(t){var n=t.nodeName.toLowerCase();return("input"===n||"button"===n)&&t.type===e}}function de(e){return function(t){return"form"in t?t.parentNode&&!1===t.disabled?"label"in t?"label"in t.parentNode?t.parentNode.disabled===e:t.disabled===e:t.isDisabled===e||t.isDisabled!==!e&&ie(t)===e:t.disabled===e:"label"in t&&t.disabled===e}}function he(e){return se(function(t){return t=+t,se(function(n,r){var i,o=e([],n.length,t),a=o.length;while(a--)n[i=o[a]]&&(n[i]=!(r[i]=n[i]))})})}function ge(e){return e&&"undefined"!=typeof e.getElementsByTagName&&e}n=oe.support={},o=oe.isXML=function(e){var t=e&&(e.ownerDocument||e).documentElement;return!!t&&"HTML"!==t.nodeName},p=oe.setDocument=function(e){var t,i,a=e?e.ownerDocument||e:w;return a!==d&&9===a.nodeType&&a.documentElement?(d=a,h=d.documentElement,g=!o(d),w!==d&&(i=d.defaultView)&&i.top!==i&&(i.addEventListener?i.addEventListener("unload",re,!1):i.attachEvent&&i.attachEvent("onunload",re)),n.attributes=ue(function(e){return e.className="i",!e.getAttribute("className")}),n.getElementsByTagName=ue(function(e){return e.appendChild(d.createComment("")),!e.getElementsByTagName("*").length}),n.getElementsByClassName=Q.test(d.getElementsByClassName),n.getById=ue(function(e){return h.appendChild(e).id=b,!d.getElementsByName||!d.getElementsByName(b).length}),n.getById?(r.filter.ID=function(e){var t=e.replace(Z,ee);return function(e){return e.getAttribute("id")===t}},r.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&g){var n=t.getElementById(e);return n?[n]:[]}}):(r.filter.ID=function(e){var t=e.replace(Z,ee);return function(e){var n="undefined"!=typeof e.getAttributeNode&&e.getAttributeNode("id");return n&&n.value===t}},r.find.ID=function(e,t){if("undefined"!=typeof t.getElementById&&g){var n,r,i,o=t.getElementById(e);if(o){if((n=o.getAttributeNode("id"))&&n.value===e)return[o];i=t.getElementsByName(e),r=0;while(o=i[r++])if((n=o.getAttributeNode("id"))&&n.value===e)return[o]}return[]}}),r.find.TAG=n.getElementsByTagName?function(e,t){return"undefined"!=typeof t.getElementsByTagName?t.getElementsByTagName(e):n.qsa?t.querySelectorAll(e):void 0}:function(e,t){var n,r=[],i=0,o=t.getElementsByTagName(e);if("*"===e){while(n=o[i++])1===n.nodeType&&r.push(n);return r}return o},r.find.CLASS=n.getElementsByClassName&&function(e,t){if("undefined"!=typeof t.getElementsByClassName&&g)return t.getElementsByClassName(e)},v=[],y=[],(n.qsa=Q.test(d.querySelectorAll))&&(ue(function(e){h.appendChild(e).innerHTML="",e.querySelectorAll("[msallowcapture^='']").length&&y.push("[*^$]="+M+"*(?:''|\"\")"),e.querySelectorAll("[selected]").length||y.push("\\["+M+"*(?:value|"+P+")"),e.querySelectorAll("[id~="+b+"-]").length||y.push("~="),e.querySelectorAll(":checked").length||y.push(":checked"),e.querySelectorAll("a#"+b+"+*").length||y.push(".#.+[+~]")}),ue(function(e){e.innerHTML="";var t=d.createElement("input");t.setAttribute("type","hidden"),e.appendChild(t).setAttribute("name","D"),e.querySelectorAll("[name=d]").length&&y.push("name"+M+"*[*^$|!~]?="),2!==e.querySelectorAll(":enabled").length&&y.push(":enabled",":disabled"),h.appendChild(e).disabled=!0,2!==e.querySelectorAll(":disabled").length&&y.push(":enabled",":disabled"),e.querySelectorAll("*,:x"),y.push(",.*:")})),(n.matchesSelector=Q.test(m=h.matches||h.webkitMatchesSelector||h.mozMatchesSelector||h.oMatchesSelector||h.msMatchesSelector))&&ue(function(e){n.disconnectedMatch=m.call(e,"*"),m.call(e,"[s!='']:x"),v.push("!=",W)}),y=y.length&&new RegExp(y.join("|")),v=v.length&&new RegExp(v.join("|")),t=Q.test(h.compareDocumentPosition),x=t||Q.test(h.contains)?function(e,t){var n=9===e.nodeType?e.documentElement:e,r=t&&t.parentNode;return e===r||!(!r||1!==r.nodeType||!(n.contains?n.contains(r):e.compareDocumentPosition&&16&e.compareDocumentPosition(r)))}:function(e,t){if(t)while(t=t.parentNode)if(t===e)return!0;return!1},D=t?function(e,t){if(e===t)return f=!0,0;var r=!e.compareDocumentPosition-!t.compareDocumentPosition;return r||(1&(r=(e.ownerDocument||e)===(t.ownerDocument||t)?e.compareDocumentPosition(t):1)||!n.sortDetached&&t.compareDocumentPosition(e)===r?e===d||e.ownerDocument===w&&x(w,e)?-1:t===d||t.ownerDocument===w&&x(w,t)?1:c?O(c,e)-O(c,t):0:4&r?-1:1)}:function(e,t){if(e===t)return f=!0,0;var n,r=0,i=e.parentNode,o=t.parentNode,a=[e],s=[t];if(!i||!o)return e===d?-1:t===d?1:i?-1:o?1:c?O(c,e)-O(c,t):0;if(i===o)return ce(e,t);n=e;while(n=n.parentNode)a.unshift(n);n=t;while(n=n.parentNode)s.unshift(n);while(a[r]===s[r])r++;return r?ce(a[r],s[r]):a[r]===w?-1:s[r]===w?1:0},d):d},oe.matches=function(e,t){return oe(e,null,null,t)},oe.matchesSelector=function(e,t){if((e.ownerDocument||e)!==d&&p(e),t=t.replace(z,"='$1']"),n.matchesSelector&&g&&!S[t+" "]&&(!v||!v.test(t))&&(!y||!y.test(t)))try{var r=m.call(e,t);if(r||n.disconnectedMatch||e.document&&11!==e.document.nodeType)return r}catch(e){}return oe(t,d,null,[e]).length>0},oe.contains=function(e,t){return(e.ownerDocument||e)!==d&&p(e),x(e,t)},oe.attr=function(e,t){(e.ownerDocument||e)!==d&&p(e);var i=r.attrHandle[t.toLowerCase()],o=i&&N.call(r.attrHandle,t.toLowerCase())?i(e,t,!g):void 0;return void 0!==o?o:n.attributes||!g?e.getAttribute(t):(o=e.getAttributeNode(t))&&o.specified?o.value:null},oe.escape=function(e){return(e+"").replace(te,ne)},oe.error=function(e){throw new Error("Syntax error, unrecognized expression: "+e)},oe.uniqueSort=function(e){var t,r=[],i=0,o=0;if(f=!n.detectDuplicates,c=!n.sortStable&&e.slice(0),e.sort(D),f){while(t=e[o++])t===e[o]&&(i=r.push(o));while(i--)e.splice(r[i],1)}return c=null,e},i=oe.getText=function(e){var t,n="",r=0,o=e.nodeType;if(o){if(1===o||9===o||11===o){if("string"==typeof e.textContent)return e.textContent;for(e=e.firstChild;e;e=e.nextSibling)n+=i(e)}else if(3===o||4===o)return e.nodeValue}else while(t=e[r++])n+=i(t);return n},(r=oe.selectors={cacheLength:50,createPseudo:se,match:V,attrHandle:{},find:{},relative:{">":{dir:"parentNode",first:!0}," ":{dir:"parentNode"},"+":{dir:"previousSibling",first:!0},"~":{dir:"previousSibling"}},preFilter:{ATTR:function(e){return e[1]=e[1].replace(Z,ee),e[3]=(e[3]||e[4]||e[5]||"").replace(Z,ee),"~="===e[2]&&(e[3]=" "+e[3]+" "),e.slice(0,4)},CHILD:function(e){return e[1]=e[1].toLowerCase(),"nth"===e[1].slice(0,3)?(e[3]||oe.error(e[0]),e[4]=+(e[4]?e[5]+(e[6]||1):2*("even"===e[3]||"odd"===e[3])),e[5]=+(e[7]+e[8]||"odd"===e[3])):e[3]&&oe.error(e[0]),e},PSEUDO:function(e){var t,n=!e[6]&&e[2];return V.CHILD.test(e[0])?null:(e[3]?e[2]=e[4]||e[5]||"":n&&X.test(n)&&(t=a(n,!0))&&(t=n.indexOf(")",n.length-t)-n.length)&&(e[0]=e[0].slice(0,t),e[2]=n.slice(0,t)),e.slice(0,3))}},filter:{TAG:function(e){var t=e.replace(Z,ee).toLowerCase();return"*"===e?function(){return!0}:function(e){return e.nodeName&&e.nodeName.toLowerCase()===t}},CLASS:function(e){var t=E[e+" "];return t||(t=new RegExp("(^|"+M+")"+e+"("+M+"|$)"))&&E(e,function(e){return t.test("string"==typeof e.className&&e.className||"undefined"!=typeof e.getAttribute&&e.getAttribute("class")||"")})},ATTR:function(e,t,n){return function(r){var i=oe.attr(r,e);return null==i?"!="===t:!t||(i+="","="===t?i===n:"!="===t?i!==n:"^="===t?n&&0===i.indexOf(n):"*="===t?n&&i.indexOf(n)>-1:"$="===t?n&&i.slice(-n.length)===n:"~="===t?(" "+i.replace($," ")+" ").indexOf(n)>-1:"|="===t&&(i===n||i.slice(0,n.length+1)===n+"-"))}},CHILD:function(e,t,n,r,i){var o="nth"!==e.slice(0,3),a="last"!==e.slice(-4),s="of-type"===t;return 1===r&&0===i?function(e){return!!e.parentNode}:function(t,n,u){var l,c,f,p,d,h,g=o!==a?"nextSibling":"previousSibling",y=t.parentNode,v=s&&t.nodeName.toLowerCase(),m=!u&&!s,x=!1;if(y){if(o){while(g){p=t;while(p=p[g])if(s?p.nodeName.toLowerCase()===v:1===p.nodeType)return!1;h=g="only"===e&&!h&&"nextSibling"}return!0}if(h=[a?y.firstChild:y.lastChild],a&&m){x=(d=(l=(c=(f=(p=y)[b]||(p[b]={}))[p.uniqueID]||(f[p.uniqueID]={}))[e]||[])[0]===T&&l[1])&&l[2],p=d&&y.childNodes[d];while(p=++d&&p&&p[g]||(x=d=0)||h.pop())if(1===p.nodeType&&++x&&p===t){c[e]=[T,d,x];break}}else if(m&&(x=d=(l=(c=(f=(p=t)[b]||(p[b]={}))[p.uniqueID]||(f[p.uniqueID]={}))[e]||[])[0]===T&&l[1]),!1===x)while(p=++d&&p&&p[g]||(x=d=0)||h.pop())if((s?p.nodeName.toLowerCase()===v:1===p.nodeType)&&++x&&(m&&((c=(f=p[b]||(p[b]={}))[p.uniqueID]||(f[p.uniqueID]={}))[e]=[T,x]),p===t))break;return(x-=i)===r||x%r==0&&x/r>=0}}},PSEUDO:function(e,t){var n,i=r.pseudos[e]||r.setFilters[e.toLowerCase()]||oe.error("unsupported pseudo: "+e);return i[b]?i(t):i.length>1?(n=[e,e,"",t],r.setFilters.hasOwnProperty(e.toLowerCase())?se(function(e,n){var r,o=i(e,t),a=o.length;while(a--)e[r=O(e,o[a])]=!(n[r]=o[a])}):function(e){return i(e,0,n)}):i}},pseudos:{not:se(function(e){var t=[],n=[],r=s(e.replace(B,"$1"));return r[b]?se(function(e,t,n,i){var o,a=r(e,null,i,[]),s=e.length;while(s--)(o=a[s])&&(e[s]=!(t[s]=o))}):function(e,i,o){return t[0]=e,r(t,null,o,n),t[0]=null,!n.pop()}}),has:se(function(e){return function(t){return oe(e,t).length>0}}),contains:se(function(e){return e=e.replace(Z,ee),function(t){return(t.textContent||t.innerText||i(t)).indexOf(e)>-1}}),lang:se(function(e){return U.test(e||"")||oe.error("unsupported lang: "+e),e=e.replace(Z,ee).toLowerCase(),function(t){var n;do{if(n=g?t.lang:t.getAttribute("xml:lang")||t.getAttribute("lang"))return(n=n.toLowerCase())===e||0===n.indexOf(e+"-")}while((t=t.parentNode)&&1===t.nodeType);return!1}}),target:function(t){var n=e.location&&e.location.hash;return n&&n.slice(1)===t.id},root:function(e){return e===h},focus:function(e){return e===d.activeElement&&(!d.hasFocus||d.hasFocus())&&!!(e.type||e.href||~e.tabIndex)},enabled:de(!1),disabled:de(!0),checked:function(e){var t=e.nodeName.toLowerCase();return"input"===t&&!!e.checked||"option"===t&&!!e.selected},selected:function(e){return e.parentNode&&e.parentNode.selectedIndex,!0===e.selected},empty:function(e){for(e=e.firstChild;e;e=e.nextSibling)if(e.nodeType<6)return!1;return!0},parent:function(e){return!r.pseudos.empty(e)},header:function(e){return Y.test(e.nodeName)},input:function(e){return G.test(e.nodeName)},button:function(e){var t=e.nodeName.toLowerCase();return"input"===t&&"button"===e.type||"button"===t},text:function(e){var t;return"input"===e.nodeName.toLowerCase()&&"text"===e.type&&(null==(t=e.getAttribute("type"))||"text"===t.toLowerCase())},first:he(function(){return[0]}),last:he(function(e,t){return[t-1]}),eq:he(function(e,t,n){return[n<0?n+t:n]}),even:he(function(e,t){for(var n=0;n=0;)e.push(r);return e}),gt:he(function(e,t,n){for(var r=n<0?n+t:n;++r1?function(t,n,r){var i=e.length;while(i--)if(!e[i](t,n,r))return!1;return!0}:e[0]}function be(e,t,n){for(var r=0,i=t.length;r-1&&(o[l]=!(a[l]=f))}}else v=we(v===a?v.splice(h,v.length):v),i?i(null,a,v,u):L.apply(a,v)})}function Ce(e){for(var t,n,i,o=e.length,a=r.relative[e[0].type],s=a||r.relative[" "],u=a?1:0,c=me(function(e){return e===t},s,!0),f=me(function(e){return O(t,e)>-1},s,!0),p=[function(e,n,r){var i=!a&&(r||n!==l)||((t=n).nodeType?c(e,n,r):f(e,n,r));return t=null,i}];u1&&xe(p),u>1&&ve(e.slice(0,u-1).concat({value:" "===e[u-2].type?"*":""})).replace(B,"$1"),n,u0,i=e.length>0,o=function(o,a,s,u,c){var f,h,y,v=0,m="0",x=o&&[],b=[],w=l,C=o||i&&r.find.TAG("*",c),E=T+=null==w?1:Math.random()||.1,k=C.length;for(c&&(l=a===d||a||c);m!==k&&null!=(f=C[m]);m++){if(i&&f){h=0,a||f.ownerDocument===d||(p(f),s=!g);while(y=e[h++])if(y(f,a||d,s)){u.push(f);break}c&&(T=E)}n&&((f=!y&&f)&&v--,o&&x.push(f))}if(v+=m,n&&m!==v){h=0;while(y=t[h++])y(x,b,a,s);if(o){if(v>0)while(m--)x[m]||b[m]||(b[m]=j.call(u));b=we(b)}L.apply(u,b),c&&!o&&b.length>0&&v+t.length>1&&oe.uniqueSort(u)}return c&&(T=E,l=w),x};return n?se(o):o}return s=oe.compile=function(e,t){var n,r=[],i=[],o=S[e+" "];if(!o){t||(t=a(e)),n=t.length;while(n--)(o=Ce(t[n]))[b]?r.push(o):i.push(o);(o=S(e,Ee(i,r))).selector=e}return o},u=oe.select=function(e,t,n,i){var o,u,l,c,f,p="function"==typeof e&&e,d=!i&&a(e=p.selector||e);if(n=n||[],1===d.length){if((u=d[0]=d[0].slice(0)).length>2&&"ID"===(l=u[0]).type&&9===t.nodeType&&g&&r.relative[u[1].type]){if(!(t=(r.find.ID(l.matches[0].replace(Z,ee),t)||[])[0]))return n;p&&(t=t.parentNode),e=e.slice(u.shift().value.length)}o=V.needsContext.test(e)?0:u.length;while(o--){if(l=u[o],r.relative[c=l.type])break;if((f=r.find[c])&&(i=f(l.matches[0].replace(Z,ee),K.test(u[0].type)&&ge(t.parentNode)||t))){if(u.splice(o,1),!(e=i.length&&ve(u)))return L.apply(n,i),n;break}}}return(p||s(e,d))(i,t,!g,n,!t||K.test(e)&&ge(t.parentNode)||t),n},n.sortStable=b.split("").sort(D).join("")===b,n.detectDuplicates=!!f,p(),n.sortDetached=ue(function(e){return 1&e.compareDocumentPosition(d.createElement("fieldset"))}),ue(function(e){return e.innerHTML="","#"===e.firstChild.getAttribute("href")})||le("type|href|height|width",function(e,t,n){if(!n)return e.getAttribute(t,"type"===t.toLowerCase()?1:2)}),n.attributes&&ue(function(e){return e.innerHTML="",e.firstChild.setAttribute("value",""),""===e.firstChild.getAttribute("value")})||le("value",function(e,t,n){if(!n&&"input"===e.nodeName.toLowerCase())return e.defaultValue}),ue(function(e){return null==e.getAttribute("disabled")})||le(P,function(e,t,n){var r;if(!n)return!0===e[t]?t.toLowerCase():(r=e.getAttributeNode(t))&&r.specified?r.value:null}),oe}(e);w.find=E,w.expr=E.selectors,w.expr[":"]=w.expr.pseudos,w.uniqueSort=w.unique=E.uniqueSort,w.text=E.getText,w.isXMLDoc=E.isXML,w.contains=E.contains,w.escapeSelector=E.escape;var k=function(e,t,n){var r=[],i=void 0!==n;while((e=e[t])&&9!==e.nodeType)if(1===e.nodeType){if(i&&w(e).is(n))break;r.push(e)}return r},S=function(e,t){for(var n=[];e;e=e.nextSibling)1===e.nodeType&&e!==t&&n.push(e);return n},D=w.expr.match.needsContext;function N(e,t){return e.nodeName&&e.nodeName.toLowerCase()===t.toLowerCase()}var A=/^<([a-z][^\/\0>:\x20\t\r\n\f]*)[\x20\t\r\n\f]*\/?>(?:<\/\1>|)$/i;function j(e,t,n){return g(t)?w.grep(e,function(e,r){return!!t.call(e,r,e)!==n}):t.nodeType?w.grep(e,function(e){return e===t!==n}):"string"!=typeof t?w.grep(e,function(e){return u.call(t,e)>-1!==n}):w.filter(t,e,n)}w.filter=function(e,t,n){var r=t[0];return n&&(e=":not("+e+")"),1===t.length&&1===r.nodeType?w.find.matchesSelector(r,e)?[r]:[]:w.find.matches(e,w.grep(t,function(e){return 1===e.nodeType}))},w.fn.extend({find:function(e){var t,n,r=this.length,i=this;if("string"!=typeof e)return this.pushStack(w(e).filter(function(){for(t=0;t1?w.uniqueSort(n):n},filter:function(e){return this.pushStack(j(this,e||[],!1))},not:function(e){return this.pushStack(j(this,e||[],!0))},is:function(e){return!!j(this,"string"==typeof e&&D.test(e)?w(e):e||[],!1).length}});var q,L=/^(?:\s*(<[\w\W]+>)[^>]*|#([\w-]+))$/;(w.fn.init=function(e,t,n){var i,o;if(!e)return this;if(n=n||q,"string"==typeof e){if(!(i="<"===e[0]&&">"===e[e.length-1]&&e.length>=3?[null,e,null]:L.exec(e))||!i[1]&&t)return!t||t.jquery?(t||n).find(e):this.constructor(t).find(e);if(i[1]){if(t=t instanceof w?t[0]:t,w.merge(this,w.parseHTML(i[1],t&&t.nodeType?t.ownerDocument||t:r,!0)),A.test(i[1])&&w.isPlainObject(t))for(i in t)g(this[i])?this[i](t[i]):this.attr(i,t[i]);return this}return(o=r.getElementById(i[2]))&&(this[0]=o,this.length=1),this}return e.nodeType?(this[0]=e,this.length=1,this):g(e)?void 0!==n.ready?n.ready(e):e(w):w.makeArray(e,this)}).prototype=w.fn,q=w(r);var H=/^(?:parents|prev(?:Until|All))/,O={children:!0,contents:!0,next:!0,prev:!0};w.fn.extend({has:function(e){var t=w(e,this),n=t.length;return this.filter(function(){for(var e=0;e-1:1===n.nodeType&&w.find.matchesSelector(n,e))){o.push(n);break}return this.pushStack(o.length>1?w.uniqueSort(o):o)},index:function(e){return e?"string"==typeof e?u.call(w(e),this[0]):u.call(this,e.jquery?e[0]:e):this[0]&&this[0].parentNode?this.first().prevAll().length:-1},add:function(e,t){return this.pushStack(w.uniqueSort(w.merge(this.get(),w(e,t))))},addBack:function(e){return this.add(null==e?this.prevObject:this.prevObject.filter(e))}});function P(e,t){while((e=e[t])&&1!==e.nodeType);return e}w.each({parent:function(e){var t=e.parentNode;return t&&11!==t.nodeType?t:null},parents:function(e){return k(e,"parentNode")},parentsUntil:function(e,t,n){return k(e,"parentNode",n)},next:function(e){return P(e,"nextSibling")},prev:function(e){return P(e,"previousSibling")},nextAll:function(e){return k(e,"nextSibling")},prevAll:function(e){return k(e,"previousSibling")},nextUntil:function(e,t,n){return k(e,"nextSibling",n)},prevUntil:function(e,t,n){return k(e,"previousSibling",n)},siblings:function(e){return S((e.parentNode||{}).firstChild,e)},children:function(e){return S(e.firstChild)},contents:function(e){return N(e,"iframe")?e.contentDocument:(N(e,"template")&&(e=e.content||e),w.merge([],e.childNodes))}},function(e,t){w.fn[e]=function(n,r){var i=w.map(this,t,n);return"Until"!==e.slice(-5)&&(r=n),r&&"string"==typeof r&&(i=w.filter(r,i)),this.length>1&&(O[e]||w.uniqueSort(i),H.test(e)&&i.reverse()),this.pushStack(i)}});var M=/[^\x20\t\r\n\f]+/g;function R(e){var t={};return w.each(e.match(M)||[],function(e,n){t[n]=!0}),t}w.Callbacks=function(e){e="string"==typeof e?R(e):w.extend({},e);var t,n,r,i,o=[],a=[],s=-1,u=function(){for(i=i||e.once,r=t=!0;a.length;s=-1){n=a.shift();while(++s-1)o.splice(n,1),n<=s&&s--}),this},has:function(e){return e?w.inArray(e,o)>-1:o.length>0},empty:function(){return o&&(o=[]),this},disable:function(){return i=a=[],o=n="",this},disabled:function(){return!o},lock:function(){return i=a=[],n||t||(o=n=""),this},locked:function(){return!!i},fireWith:function(e,n){return i||(n=[e,(n=n||[]).slice?n.slice():n],a.push(n),t||u()),this},fire:function(){return l.fireWith(this,arguments),this},fired:function(){return!!r}};return l};function I(e){return e}function W(e){throw e}function $(e,t,n,r){var i;try{e&&g(i=e.promise)?i.call(e).done(t).fail(n):e&&g(i=e.then)?i.call(e,t,n):t.apply(void 0,[e].slice(r))}catch(e){n.apply(void 0,[e])}}w.extend({Deferred:function(t){var n=[["notify","progress",w.Callbacks("memory"),w.Callbacks("memory"),2],["resolve","done",w.Callbacks("once memory"),w.Callbacks("once memory"),0,"resolved"],["reject","fail",w.Callbacks("once memory"),w.Callbacks("once memory"),1,"rejected"]],r="pending",i={state:function(){return r},always:function(){return o.done(arguments).fail(arguments),this},"catch":function(e){return i.then(null,e)},pipe:function(){var e=arguments;return w.Deferred(function(t){w.each(n,function(n,r){var i=g(e[r[4]])&&e[r[4]];o[r[1]](function(){var e=i&&i.apply(this,arguments);e&&g(e.promise)?e.promise().progress(t.notify).done(t.resolve).fail(t.reject):t[r[0]+"With"](this,i?[e]:arguments)})}),e=null}).promise()},then:function(t,r,i){var o=0;function a(t,n,r,i){return function(){var s=this,u=arguments,l=function(){var e,l;if(!(t=o&&(r!==W&&(s=void 0,u=[e]),n.rejectWith(s,u))}};t?c():(w.Deferred.getStackHook&&(c.stackTrace=w.Deferred.getStackHook()),e.setTimeout(c))}}return w.Deferred(function(e){n[0][3].add(a(0,e,g(i)?i:I,e.notifyWith)),n[1][3].add(a(0,e,g(t)?t:I)),n[2][3].add(a(0,e,g(r)?r:W))}).promise()},promise:function(e){return null!=e?w.extend(e,i):i}},o={};return w.each(n,function(e,t){var a=t[2],s=t[5];i[t[1]]=a.add,s&&a.add(function(){r=s},n[3-e][2].disable,n[3-e][3].disable,n[0][2].lock,n[0][3].lock),a.add(t[3].fire),o[t[0]]=function(){return o[t[0]+"With"](this===o?void 0:this,arguments),this},o[t[0]+"With"]=a.fireWith}),i.promise(o),t&&t.call(o,o),o},when:function(e){var t=arguments.length,n=t,r=Array(n),i=o.call(arguments),a=w.Deferred(),s=function(e){return function(n){r[e]=this,i[e]=arguments.length>1?o.call(arguments):n,--t||a.resolveWith(r,i)}};if(t<=1&&($(e,a.done(s(n)).resolve,a.reject,!t),"pending"===a.state()||g(i[n]&&i[n].then)))return a.then();while(n--)$(i[n],s(n),a.reject);return a.promise()}});var B=/^(Eval|Internal|Range|Reference|Syntax|Type|URI)Error$/;w.Deferred.exceptionHook=function(t,n){e.console&&e.console.warn&&t&&B.test(t.name)&&e.console.warn("jQuery.Deferred exception: "+t.message,t.stack,n)},w.readyException=function(t){e.setTimeout(function(){throw t})};var F=w.Deferred();w.fn.ready=function(e){return F.then(e)["catch"](function(e){w.readyException(e)}),this},w.extend({isReady:!1,readyWait:1,ready:function(e){(!0===e?--w.readyWait:w.isReady)||(w.isReady=!0,!0!==e&&--w.readyWait>0||F.resolveWith(r,[w]))}}),w.ready.then=F.then;function _(){r.removeEventListener("DOMContentLoaded",_),e.removeEventListener("load",_),w.ready()}"complete"===r.readyState||"loading"!==r.readyState&&!r.documentElement.doScroll?e.setTimeout(w.ready):(r.addEventListener("DOMContentLoaded",_),e.addEventListener("load",_));var z=function(e,t,n,r,i,o,a){var s=0,u=e.length,l=null==n;if("object"===x(n)){i=!0;for(s in n)z(e,t,s,n[s],!0,o,a)}else if(void 0!==r&&(i=!0,g(r)||(a=!0),l&&(a?(t.call(e,r),t=null):(l=t,t=function(e,t,n){return l.call(w(e),n)})),t))for(;s1,null,!0)},removeData:function(e){return this.each(function(){K.remove(this,e)})}}),w.extend({queue:function(e,t,n){var r;if(e)return t=(t||"fx")+"queue",r=J.get(e,t),n&&(!r||Array.isArray(n)?r=J.access(e,t,w.makeArray(n)):r.push(n)),r||[]},dequeue:function(e,t){t=t||"fx";var n=w.queue(e,t),r=n.length,i=n.shift(),o=w._queueHooks(e,t),a=function(){w.dequeue(e,t)};"inprogress"===i&&(i=n.shift(),r--),i&&("fx"===t&&n.unshift("inprogress"),delete o.stop,i.call(e,a,o)),!r&&o&&o.empty.fire()},_queueHooks:function(e,t){var n=t+"queueHooks";return J.get(e,n)||J.access(e,n,{empty:w.Callbacks("once memory").add(function(){J.remove(e,[t+"queue",n])})})}}),w.fn.extend({queue:function(e,t){var n=2;return"string"!=typeof e&&(t=e,e="fx",n--),arguments.length\x20\t\r\n\f]+)/i,he=/^$|^module$|\/(?:java|ecma)script/i,ge={option:[1,""],thead:[1,"","
"],col:[2,"","
"],tr:[2,"","
"],td:[3,"","
"],_default:[0,"",""]};ge.optgroup=ge.option,ge.tbody=ge.tfoot=ge.colgroup=ge.caption=ge.thead,ge.th=ge.td;function ye(e,t){var n;return n="undefined"!=typeof e.getElementsByTagName?e.getElementsByTagName(t||"*"):"undefined"!=typeof e.querySelectorAll?e.querySelectorAll(t||"*"):[],void 0===t||t&&N(e,t)?w.merge([e],n):n}function ve(e,t){for(var n=0,r=e.length;n-1)i&&i.push(o);else if(l=w.contains(o.ownerDocument,o),a=ye(f.appendChild(o),"script"),l&&ve(a),n){c=0;while(o=a[c++])he.test(o.type||"")&&n.push(o)}return f}!function(){var e=r.createDocumentFragment().appendChild(r.createElement("div")),t=r.createElement("input");t.setAttribute("type","radio"),t.setAttribute("checked","checked"),t.setAttribute("name","t"),e.appendChild(t),h.checkClone=e.cloneNode(!0).cloneNode(!0).lastChild.checked,e.innerHTML="",h.noCloneChecked=!!e.cloneNode(!0).lastChild.defaultValue}();var be=r.documentElement,we=/^key/,Te=/^(?:mouse|pointer|contextmenu|drag|drop)|click/,Ce=/^([^.]*)(?:\.(.+)|)/;function Ee(){return!0}function ke(){return!1}function Se(){try{return r.activeElement}catch(e){}}function De(e,t,n,r,i,o){var a,s;if("object"==typeof t){"string"!=typeof n&&(r=r||n,n=void 0);for(s in t)De(e,s,n,r,t[s],o);return e}if(null==r&&null==i?(i=n,r=n=void 0):null==i&&("string"==typeof n?(i=r,r=void 0):(i=r,r=n,n=void 0)),!1===i)i=ke;else if(!i)return e;return 1===o&&(a=i,(i=function(e){return w().off(e),a.apply(this,arguments)}).guid=a.guid||(a.guid=w.guid++)),e.each(function(){w.event.add(this,t,i,r,n)})}w.event={global:{},add:function(e,t,n,r,i){var o,a,s,u,l,c,f,p,d,h,g,y=J.get(e);if(y){n.handler&&(n=(o=n).handler,i=o.selector),i&&w.find.matchesSelector(be,i),n.guid||(n.guid=w.guid++),(u=y.events)||(u=y.events={}),(a=y.handle)||(a=y.handle=function(t){return"undefined"!=typeof w&&w.event.triggered!==t.type?w.event.dispatch.apply(e,arguments):void 0}),l=(t=(t||"").match(M)||[""]).length;while(l--)d=g=(s=Ce.exec(t[l])||[])[1],h=(s[2]||"").split(".").sort(),d&&(f=w.event.special[d]||{},d=(i?f.delegateType:f.bindType)||d,f=w.event.special[d]||{},c=w.extend({type:d,origType:g,data:r,handler:n,guid:n.guid,selector:i,needsContext:i&&w.expr.match.needsContext.test(i),namespace:h.join(".")},o),(p=u[d])||((p=u[d]=[]).delegateCount=0,f.setup&&!1!==f.setup.call(e,r,h,a)||e.addEventListener&&e.addEventListener(d,a)),f.add&&(f.add.call(e,c),c.handler.guid||(c.handler.guid=n.guid)),i?p.splice(p.delegateCount++,0,c):p.push(c),w.event.global[d]=!0)}},remove:function(e,t,n,r,i){var o,a,s,u,l,c,f,p,d,h,g,y=J.hasData(e)&&J.get(e);if(y&&(u=y.events)){l=(t=(t||"").match(M)||[""]).length;while(l--)if(s=Ce.exec(t[l])||[],d=g=s[1],h=(s[2]||"").split(".").sort(),d){f=w.event.special[d]||{},p=u[d=(r?f.delegateType:f.bindType)||d]||[],s=s[2]&&new RegExp("(^|\\.)"+h.join("\\.(?:.*\\.|)")+"(\\.|$)"),a=o=p.length;while(o--)c=p[o],!i&&g!==c.origType||n&&n.guid!==c.guid||s&&!s.test(c.namespace)||r&&r!==c.selector&&("**"!==r||!c.selector)||(p.splice(o,1),c.selector&&p.delegateCount--,f.remove&&f.remove.call(e,c));a&&!p.length&&(f.teardown&&!1!==f.teardown.call(e,h,y.handle)||w.removeEvent(e,d,y.handle),delete u[d])}else for(d in u)w.event.remove(e,d+t[l],n,r,!0);w.isEmptyObject(u)&&J.remove(e,"handle events")}},dispatch:function(e){var t=w.event.fix(e),n,r,i,o,a,s,u=new Array(arguments.length),l=(J.get(this,"events")||{})[t.type]||[],c=w.event.special[t.type]||{};for(u[0]=t,n=1;n=1))for(;l!==this;l=l.parentNode||this)if(1===l.nodeType&&("click"!==e.type||!0!==l.disabled)){for(o=[],a={},n=0;n-1:w.find(i,this,null,[l]).length),a[i]&&o.push(r);o.length&&s.push({elem:l,handlers:o})}return l=this,u\x20\t\r\n\f]*)[^>]*)\/>/gi,Ae=/\s*$/g;function Le(e,t){return N(e,"table")&&N(11!==t.nodeType?t:t.firstChild,"tr")?w(e).children("tbody")[0]||e:e}function He(e){return e.type=(null!==e.getAttribute("type"))+"/"+e.type,e}function Oe(e){return"true/"===(e.type||"").slice(0,5)?e.type=e.type.slice(5):e.removeAttribute("type"),e}function Pe(e,t){var n,r,i,o,a,s,u,l;if(1===t.nodeType){if(J.hasData(e)&&(o=J.access(e),a=J.set(t,o),l=o.events)){delete a.handle,a.events={};for(i in l)for(n=0,r=l[i].length;n1&&"string"==typeof y&&!h.checkClone&&je.test(y))return e.each(function(i){var o=e.eq(i);v&&(t[0]=y.call(this,i,o.html())),Re(o,t,n,r)});if(p&&(i=xe(t,e[0].ownerDocument,!1,e,r),o=i.firstChild,1===i.childNodes.length&&(i=o),o||r)){for(u=(s=w.map(ye(i,"script"),He)).length;f")},clone:function(e,t,n){var r,i,o,a,s=e.cloneNode(!0),u=w.contains(e.ownerDocument,e);if(!(h.noCloneChecked||1!==e.nodeType&&11!==e.nodeType||w.isXMLDoc(e)))for(a=ye(s),r=0,i=(o=ye(e)).length;r0&&ve(a,!u&&ye(e,"script")),s},cleanData:function(e){for(var t,n,r,i=w.event.special,o=0;void 0!==(n=e[o]);o++)if(Y(n)){if(t=n[J.expando]){if(t.events)for(r in t.events)i[r]?w.event.remove(n,r):w.removeEvent(n,r,t.handle);n[J.expando]=void 0}n[K.expando]&&(n[K.expando]=void 0)}}}),w.fn.extend({detach:function(e){return Ie(this,e,!0)},remove:function(e){return Ie(this,e)},text:function(e){return z(this,function(e){return void 0===e?w.text(this):this.empty().each(function(){1!==this.nodeType&&11!==this.nodeType&&9!==this.nodeType||(this.textContent=e)})},null,e,arguments.length)},append:function(){return Re(this,arguments,function(e){1!==this.nodeType&&11!==this.nodeType&&9!==this.nodeType||Le(this,e).appendChild(e)})},prepend:function(){return Re(this,arguments,function(e){if(1===this.nodeType||11===this.nodeType||9===this.nodeType){var t=Le(this,e);t.insertBefore(e,t.firstChild)}})},before:function(){return Re(this,arguments,function(e){this.parentNode&&this.parentNode.insertBefore(e,this)})},after:function(){return Re(this,arguments,function(e){this.parentNode&&this.parentNode.insertBefore(e,this.nextSibling)})},empty:function(){for(var e,t=0;null!=(e=this[t]);t++)1===e.nodeType&&(w.cleanData(ye(e,!1)),e.textContent="");return this},clone:function(e,t){return e=null!=e&&e,t=null==t?e:t,this.map(function(){return w.clone(this,e,t)})},html:function(e){return z(this,function(e){var t=this[0]||{},n=0,r=this.length;if(void 0===e&&1===t.nodeType)return t.innerHTML;if("string"==typeof e&&!Ae.test(e)&&!ge[(de.exec(e)||["",""])[1].toLowerCase()]){e=w.htmlPrefilter(e);try{for(;n=0&&(u+=Math.max(0,Math.ceil(e["offset"+t[0].toUpperCase()+t.slice(1)]-o-u-s-.5))),u}function et(e,t,n){var r=$e(e),i=Fe(e,t,r),o="border-box"===w.css(e,"boxSizing",!1,r),a=o;if(We.test(i)){if(!n)return i;i="auto"}return a=a&&(h.boxSizingReliable()||i===e.style[t]),("auto"===i||!parseFloat(i)&&"inline"===w.css(e,"display",!1,r))&&(i=e["offset"+t[0].toUpperCase()+t.slice(1)],a=!0),(i=parseFloat(i)||0)+Ze(e,t,n||(o?"border":"content"),a,r,i)+"px"}w.extend({cssHooks:{opacity:{get:function(e,t){if(t){var n=Fe(e,"opacity");return""===n?"1":n}}}},cssNumber:{animationIterationCount:!0,columnCount:!0,fillOpacity:!0,flexGrow:!0,flexShrink:!0,fontWeight:!0,lineHeight:!0,opacity:!0,order:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{},style:function(e,t,n,r){if(e&&3!==e.nodeType&&8!==e.nodeType&&e.style){var i,o,a,s=G(t),u=Xe.test(t),l=e.style;if(u||(t=Je(s)),a=w.cssHooks[t]||w.cssHooks[s],void 0===n)return a&&"get"in a&&void 0!==(i=a.get(e,!1,r))?i:l[t];"string"==(o=typeof n)&&(i=ie.exec(n))&&i[1]&&(n=ue(e,t,i),o="number"),null!=n&&n===n&&("number"===o&&(n+=i&&i[3]||(w.cssNumber[s]?"":"px")),h.clearCloneStyle||""!==n||0!==t.indexOf("background")||(l[t]="inherit"),a&&"set"in a&&void 0===(n=a.set(e,n,r))||(u?l.setProperty(t,n):l[t]=n))}},css:function(e,t,n,r){var i,o,a,s=G(t);return Xe.test(t)||(t=Je(s)),(a=w.cssHooks[t]||w.cssHooks[s])&&"get"in a&&(i=a.get(e,!0,n)),void 0===i&&(i=Fe(e,t,r)),"normal"===i&&t in Ve&&(i=Ve[t]),""===n||n?(o=parseFloat(i),!0===n||isFinite(o)?o||0:i):i}}),w.each(["height","width"],function(e,t){w.cssHooks[t]={get:function(e,n,r){if(n)return!ze.test(w.css(e,"display"))||e.getClientRects().length&&e.getBoundingClientRect().width?et(e,t,r):se(e,Ue,function(){return et(e,t,r)})},set:function(e,n,r){var i,o=$e(e),a="border-box"===w.css(e,"boxSizing",!1,o),s=r&&Ze(e,t,r,a,o);return a&&h.scrollboxSize()===o.position&&(s-=Math.ceil(e["offset"+t[0].toUpperCase()+t.slice(1)]-parseFloat(o[t])-Ze(e,t,"border",!1,o)-.5)),s&&(i=ie.exec(n))&&"px"!==(i[3]||"px")&&(e.style[t]=n,n=w.css(e,t)),Ke(e,n,s)}}}),w.cssHooks.marginLeft=_e(h.reliableMarginLeft,function(e,t){if(t)return(parseFloat(Fe(e,"marginLeft"))||e.getBoundingClientRect().left-se(e,{marginLeft:0},function(){return e.getBoundingClientRect().left}))+"px"}),w.each({margin:"",padding:"",border:"Width"},function(e,t){w.cssHooks[e+t]={expand:function(n){for(var r=0,i={},o="string"==typeof n?n.split(" "):[n];r<4;r++)i[e+oe[r]+t]=o[r]||o[r-2]||o[0];return i}},"margin"!==e&&(w.cssHooks[e+t].set=Ke)}),w.fn.extend({css:function(e,t){return z(this,function(e,t,n){var r,i,o={},a=0;if(Array.isArray(t)){for(r=$e(e),i=t.length;a1)}});function tt(e,t,n,r,i){return new tt.prototype.init(e,t,n,r,i)}w.Tween=tt,tt.prototype={constructor:tt,init:function(e,t,n,r,i,o){this.elem=e,this.prop=n,this.easing=i||w.easing._default,this.options=t,this.start=this.now=this.cur(),this.end=r,this.unit=o||(w.cssNumber[n]?"":"px")},cur:function(){var e=tt.propHooks[this.prop];return e&&e.get?e.get(this):tt.propHooks._default.get(this)},run:function(e){var t,n=tt.propHooks[this.prop];return this.options.duration?this.pos=t=w.easing[this.easing](e,this.options.duration*e,0,1,this.options.duration):this.pos=t=e,this.now=(this.end-this.start)*t+this.start,this.options.step&&this.options.step.call(this.elem,this.now,this),n&&n.set?n.set(this):tt.propHooks._default.set(this),this}},tt.prototype.init.prototype=tt.prototype,tt.propHooks={_default:{get:function(e){var t;return 1!==e.elem.nodeType||null!=e.elem[e.prop]&&null==e.elem.style[e.prop]?e.elem[e.prop]:(t=w.css(e.elem,e.prop,""))&&"auto"!==t?t:0},set:function(e){w.fx.step[e.prop]?w.fx.step[e.prop](e):1!==e.elem.nodeType||null==e.elem.style[w.cssProps[e.prop]]&&!w.cssHooks[e.prop]?e.elem[e.prop]=e.now:w.style(e.elem,e.prop,e.now+e.unit)}}},tt.propHooks.scrollTop=tt.propHooks.scrollLeft={set:function(e){e.elem.nodeType&&e.elem.parentNode&&(e.elem[e.prop]=e.now)}},w.easing={linear:function(e){return e},swing:function(e){return.5-Math.cos(e*Math.PI)/2},_default:"swing"},w.fx=tt.prototype.init,w.fx.step={};var nt,rt,it=/^(?:toggle|show|hide)$/,ot=/queueHooks$/;function at(){rt&&(!1===r.hidden&&e.requestAnimationFrame?e.requestAnimationFrame(at):e.setTimeout(at,w.fx.interval),w.fx.tick())}function st(){return e.setTimeout(function(){nt=void 0}),nt=Date.now()}function ut(e,t){var n,r=0,i={height:e};for(t=t?1:0;r<4;r+=2-t)i["margin"+(n=oe[r])]=i["padding"+n]=e;return t&&(i.opacity=i.width=e),i}function lt(e,t,n){for(var r,i=(pt.tweeners[t]||[]).concat(pt.tweeners["*"]),o=0,a=i.length;o1)},removeAttr:function(e){return this.each(function(){w.removeAttr(this,e)})}}),w.extend({attr:function(e,t,n){var r,i,o=e.nodeType;if(3!==o&&8!==o&&2!==o)return"undefined"==typeof e.getAttribute?w.prop(e,t,n):(1===o&&w.isXMLDoc(e)||(i=w.attrHooks[t.toLowerCase()]||(w.expr.match.bool.test(t)?dt:void 0)),void 0!==n?null===n?void w.removeAttr(e,t):i&&"set"in i&&void 0!==(r=i.set(e,n,t))?r:(e.setAttribute(t,n+""),n):i&&"get"in i&&null!==(r=i.get(e,t))?r:null==(r=w.find.attr(e,t))?void 0:r)},attrHooks:{type:{set:function(e,t){if(!h.radioValue&&"radio"===t&&N(e,"input")){var n=e.value;return e.setAttribute("type",t),n&&(e.value=n),t}}}},removeAttr:function(e,t){var n,r=0,i=t&&t.match(M);if(i&&1===e.nodeType)while(n=i[r++])e.removeAttribute(n)}}),dt={set:function(e,t,n){return!1===t?w.removeAttr(e,n):e.setAttribute(n,n),n}},w.each(w.expr.match.bool.source.match(/\w+/g),function(e,t){var n=ht[t]||w.find.attr;ht[t]=function(e,t,r){var i,o,a=t.toLowerCase();return r||(o=ht[a],ht[a]=i,i=null!=n(e,t,r)?a:null,ht[a]=o),i}});var gt=/^(?:input|select|textarea|button)$/i,yt=/^(?:a|area)$/i;w.fn.extend({prop:function(e,t){return z(this,w.prop,e,t,arguments.length>1)},removeProp:function(e){return this.each(function(){delete this[w.propFix[e]||e]})}}),w.extend({prop:function(e,t,n){var r,i,o=e.nodeType;if(3!==o&&8!==o&&2!==o)return 1===o&&w.isXMLDoc(e)||(t=w.propFix[t]||t,i=w.propHooks[t]),void 0!==n?i&&"set"in i&&void 0!==(r=i.set(e,n,t))?r:e[t]=n:i&&"get"in i&&null!==(r=i.get(e,t))?r:e[t]},propHooks:{tabIndex:{get:function(e){var t=w.find.attr(e,"tabindex");return t?parseInt(t,10):gt.test(e.nodeName)||yt.test(e.nodeName)&&e.href?0:-1}}},propFix:{"for":"htmlFor","class":"className"}}),h.optSelected||(w.propHooks.selected={get:function(e){var t=e.parentNode;return t&&t.parentNode&&t.parentNode.selectedIndex,null},set:function(e){var t=e.parentNode;t&&(t.selectedIndex,t.parentNode&&t.parentNode.selectedIndex)}}),w.each(["tabIndex","readOnly","maxLength","cellSpacing","cellPadding","rowSpan","colSpan","useMap","frameBorder","contentEditable"],function(){w.propFix[this.toLowerCase()]=this});function vt(e){return(e.match(M)||[]).join(" ")}function mt(e){return e.getAttribute&&e.getAttribute("class")||""}function xt(e){return Array.isArray(e)?e:"string"==typeof e?e.match(M)||[]:[]}w.fn.extend({addClass:function(e){var t,n,r,i,o,a,s,u=0;if(g(e))return this.each(function(t){w(this).addClass(e.call(this,t,mt(this)))});if((t=xt(e)).length)while(n=this[u++])if(i=mt(n),r=1===n.nodeType&&" "+vt(i)+" "){a=0;while(o=t[a++])r.indexOf(" "+o+" ")<0&&(r+=o+" ");i!==(s=vt(r))&&n.setAttribute("class",s)}return this},removeClass:function(e){var t,n,r,i,o,a,s,u=0;if(g(e))return this.each(function(t){w(this).removeClass(e.call(this,t,mt(this)))});if(!arguments.length)return this.attr("class","");if((t=xt(e)).length)while(n=this[u++])if(i=mt(n),r=1===n.nodeType&&" "+vt(i)+" "){a=0;while(o=t[a++])while(r.indexOf(" "+o+" ")>-1)r=r.replace(" "+o+" "," ");i!==(s=vt(r))&&n.setAttribute("class",s)}return this},toggleClass:function(e,t){var n=typeof e,r="string"===n||Array.isArray(e);return"boolean"==typeof t&&r?t?this.addClass(e):this.removeClass(e):g(e)?this.each(function(n){w(this).toggleClass(e.call(this,n,mt(this),t),t)}):this.each(function(){var t,i,o,a;if(r){i=0,o=w(this),a=xt(e);while(t=a[i++])o.hasClass(t)?o.removeClass(t):o.addClass(t)}else void 0!==e&&"boolean"!==n||((t=mt(this))&&J.set(this,"__className__",t),this.setAttribute&&this.setAttribute("class",t||!1===e?"":J.get(this,"__className__")||""))})},hasClass:function(e){var t,n,r=0;t=" "+e+" ";while(n=this[r++])if(1===n.nodeType&&(" "+vt(mt(n))+" ").indexOf(t)>-1)return!0;return!1}});var bt=/\r/g;w.fn.extend({val:function(e){var t,n,r,i=this[0];{if(arguments.length)return r=g(e),this.each(function(n){var i;1===this.nodeType&&(null==(i=r?e.call(this,n,w(this).val()):e)?i="":"number"==typeof i?i+="":Array.isArray(i)&&(i=w.map(i,function(e){return null==e?"":e+""})),(t=w.valHooks[this.type]||w.valHooks[this.nodeName.toLowerCase()])&&"set"in t&&void 0!==t.set(this,i,"value")||(this.value=i))});if(i)return(t=w.valHooks[i.type]||w.valHooks[i.nodeName.toLowerCase()])&&"get"in t&&void 0!==(n=t.get(i,"value"))?n:"string"==typeof(n=i.value)?n.replace(bt,""):null==n?"":n}}}),w.extend({valHooks:{option:{get:function(e){var t=w.find.attr(e,"value");return null!=t?t:vt(w.text(e))}},select:{get:function(e){var t,n,r,i=e.options,o=e.selectedIndex,a="select-one"===e.type,s=a?null:[],u=a?o+1:i.length;for(r=o<0?u:a?o:0;r-1)&&(n=!0);return n||(e.selectedIndex=-1),o}}}}),w.each(["radio","checkbox"],function(){w.valHooks[this]={set:function(e,t){if(Array.isArray(t))return e.checked=w.inArray(w(e).val(),t)>-1}},h.checkOn||(w.valHooks[this].get=function(e){return null===e.getAttribute("value")?"on":e.value})}),h.focusin="onfocusin"in e;var wt=/^(?:focusinfocus|focusoutblur)$/,Tt=function(e){e.stopPropagation()};w.extend(w.event,{trigger:function(t,n,i,o){var a,s,u,l,c,p,d,h,v=[i||r],m=f.call(t,"type")?t.type:t,x=f.call(t,"namespace")?t.namespace.split("."):[];if(s=h=u=i=i||r,3!==i.nodeType&&8!==i.nodeType&&!wt.test(m+w.event.triggered)&&(m.indexOf(".")>-1&&(m=(x=m.split(".")).shift(),x.sort()),c=m.indexOf(":")<0&&"on"+m,t=t[w.expando]?t:new w.Event(m,"object"==typeof t&&t),t.isTrigger=o?2:3,t.namespace=x.join("."),t.rnamespace=t.namespace?new RegExp("(^|\\.)"+x.join("\\.(?:.*\\.|)")+"(\\.|$)"):null,t.result=void 0,t.target||(t.target=i),n=null==n?[t]:w.makeArray(n,[t]),d=w.event.special[m]||{},o||!d.trigger||!1!==d.trigger.apply(i,n))){if(!o&&!d.noBubble&&!y(i)){for(l=d.delegateType||m,wt.test(l+m)||(s=s.parentNode);s;s=s.parentNode)v.push(s),u=s;u===(i.ownerDocument||r)&&v.push(u.defaultView||u.parentWindow||e)}a=0;while((s=v[a++])&&!t.isPropagationStopped())h=s,t.type=a>1?l:d.bindType||m,(p=(J.get(s,"events")||{})[t.type]&&J.get(s,"handle"))&&p.apply(s,n),(p=c&&s[c])&&p.apply&&Y(s)&&(t.result=p.apply(s,n),!1===t.result&&t.preventDefault());return t.type=m,o||t.isDefaultPrevented()||d._default&&!1!==d._default.apply(v.pop(),n)||!Y(i)||c&&g(i[m])&&!y(i)&&((u=i[c])&&(i[c]=null),w.event.triggered=m,t.isPropagationStopped()&&h.addEventListener(m,Tt),i[m](),t.isPropagationStopped()&&h.removeEventListener(m,Tt),w.event.triggered=void 0,u&&(i[c]=u)),t.result}},simulate:function(e,t,n){var r=w.extend(new w.Event,n,{type:e,isSimulated:!0});w.event.trigger(r,null,t)}}),w.fn.extend({trigger:function(e,t){return this.each(function(){w.event.trigger(e,t,this)})},triggerHandler:function(e,t){var n=this[0];if(n)return w.event.trigger(e,t,n,!0)}}),h.focusin||w.each({focus:"focusin",blur:"focusout"},function(e,t){var n=function(e){w.event.simulate(t,e.target,w.event.fix(e))};w.event.special[t]={setup:function(){var r=this.ownerDocument||this,i=J.access(r,t);i||r.addEventListener(e,n,!0),J.access(r,t,(i||0)+1)},teardown:function(){var r=this.ownerDocument||this,i=J.access(r,t)-1;i?J.access(r,t,i):(r.removeEventListener(e,n,!0),J.remove(r,t))}}});var Ct=e.location,Et=Date.now(),kt=/\?/;w.parseXML=function(t){var n;if(!t||"string"!=typeof t)return null;try{n=(new e.DOMParser).parseFromString(t,"text/xml")}catch(e){n=void 0}return n&&!n.getElementsByTagName("parsererror").length||w.error("Invalid XML: "+t),n};var St=/\[\]$/,Dt=/\r?\n/g,Nt=/^(?:submit|button|image|reset|file)$/i,At=/^(?:input|select|textarea|keygen)/i;function jt(e,t,n,r){var i;if(Array.isArray(t))w.each(t,function(t,i){n||St.test(e)?r(e,i):jt(e+"["+("object"==typeof i&&null!=i?t:"")+"]",i,n,r)});else if(n||"object"!==x(t))r(e,t);else for(i in t)jt(e+"["+i+"]",t[i],n,r)}w.param=function(e,t){var n,r=[],i=function(e,t){var n=g(t)?t():t;r[r.length]=encodeURIComponent(e)+"="+encodeURIComponent(null==n?"":n)};if(Array.isArray(e)||e.jquery&&!w.isPlainObject(e))w.each(e,function(){i(this.name,this.value)});else for(n in e)jt(n,e[n],t,i);return r.join("&")},w.fn.extend({serialize:function(){return w.param(this.serializeArray())},serializeArray:function(){return this.map(function(){var e=w.prop(this,"elements");return e?w.makeArray(e):this}).filter(function(){var e=this.type;return this.name&&!w(this).is(":disabled")&&At.test(this.nodeName)&&!Nt.test(e)&&(this.checked||!pe.test(e))}).map(function(e,t){var n=w(this).val();return null==n?null:Array.isArray(n)?w.map(n,function(e){return{name:t.name,value:e.replace(Dt,"\r\n")}}):{name:t.name,value:n.replace(Dt,"\r\n")}}).get()}});var qt=/%20/g,Lt=/#.*$/,Ht=/([?&])_=[^&]*/,Ot=/^(.*?):[ \t]*([^\r\n]*)$/gm,Pt=/^(?:about|app|app-storage|.+-extension|file|res|widget):$/,Mt=/^(?:GET|HEAD)$/,Rt=/^\/\//,It={},Wt={},$t="*/".concat("*"),Bt=r.createElement("a");Bt.href=Ct.href;function Ft(e){return function(t,n){"string"!=typeof t&&(n=t,t="*");var r,i=0,o=t.toLowerCase().match(M)||[];if(g(n))while(r=o[i++])"+"===r[0]?(r=r.slice(1)||"*",(e[r]=e[r]||[]).unshift(n)):(e[r]=e[r]||[]).push(n)}}function _t(e,t,n,r){var i={},o=e===Wt;function a(s){var u;return i[s]=!0,w.each(e[s]||[],function(e,s){var l=s(t,n,r);return"string"!=typeof l||o||i[l]?o?!(u=l):void 0:(t.dataTypes.unshift(l),a(l),!1)}),u}return a(t.dataTypes[0])||!i["*"]&&a("*")}function zt(e,t){var n,r,i=w.ajaxSettings.flatOptions||{};for(n in t)void 0!==t[n]&&((i[n]?e:r||(r={}))[n]=t[n]);return r&&w.extend(!0,e,r),e}function Xt(e,t,n){var r,i,o,a,s=e.contents,u=e.dataTypes;while("*"===u[0])u.shift(),void 0===r&&(r=e.mimeType||t.getResponseHeader("Content-Type"));if(r)for(i in s)if(s[i]&&s[i].test(r)){u.unshift(i);break}if(u[0]in n)o=u[0];else{for(i in n){if(!u[0]||e.converters[i+" "+u[0]]){o=i;break}a||(a=i)}o=o||a}if(o)return o!==u[0]&&u.unshift(o),n[o]}function Ut(e,t,n,r){var i,o,a,s,u,l={},c=e.dataTypes.slice();if(c[1])for(a in e.converters)l[a.toLowerCase()]=e.converters[a];o=c.shift();while(o)if(e.responseFields[o]&&(n[e.responseFields[o]]=t),!u&&r&&e.dataFilter&&(t=e.dataFilter(t,e.dataType)),u=o,o=c.shift())if("*"===o)o=u;else if("*"!==u&&u!==o){if(!(a=l[u+" "+o]||l["* "+o]))for(i in l)if((s=i.split(" "))[1]===o&&(a=l[u+" "+s[0]]||l["* "+s[0]])){!0===a?a=l[i]:!0!==l[i]&&(o=s[0],c.unshift(s[1]));break}if(!0!==a)if(a&&e["throws"])t=a(t);else try{t=a(t)}catch(e){return{state:"parsererror",error:a?e:"No conversion from "+u+" to "+o}}}return{state:"success",data:t}}w.extend({active:0,lastModified:{},etag:{},ajaxSettings:{url:Ct.href,type:"GET",isLocal:Pt.test(Ct.protocol),global:!0,processData:!0,async:!0,contentType:"application/x-www-form-urlencoded; charset=UTF-8",accepts:{"*":$t,text:"text/plain",html:"text/html",xml:"application/xml, text/xml",json:"application/json, text/javascript"},contents:{xml:/\bxml\b/,html:/\bhtml/,json:/\bjson\b/},responseFields:{xml:"responseXML",text:"responseText",json:"responseJSON"},converters:{"* text":String,"text html":!0,"text json":JSON.parse,"text xml":w.parseXML},flatOptions:{url:!0,context:!0}},ajaxSetup:function(e,t){return t?zt(zt(e,w.ajaxSettings),t):zt(w.ajaxSettings,e)},ajaxPrefilter:Ft(It),ajaxTransport:Ft(Wt),ajax:function(t,n){"object"==typeof t&&(n=t,t=void 0),n=n||{};var i,o,a,s,u,l,c,f,p,d,h=w.ajaxSetup({},n),g=h.context||h,y=h.context&&(g.nodeType||g.jquery)?w(g):w.event,v=w.Deferred(),m=w.Callbacks("once memory"),x=h.statusCode||{},b={},T={},C="canceled",E={readyState:0,getResponseHeader:function(e){var t;if(c){if(!s){s={};while(t=Ot.exec(a))s[t[1].toLowerCase()]=t[2]}t=s[e.toLowerCase()]}return null==t?null:t},getAllResponseHeaders:function(){return c?a:null},setRequestHeader:function(e,t){return null==c&&(e=T[e.toLowerCase()]=T[e.toLowerCase()]||e,b[e]=t),this},overrideMimeType:function(e){return null==c&&(h.mimeType=e),this},statusCode:function(e){var t;if(e)if(c)E.always(e[E.status]);else for(t in e)x[t]=[x[t],e[t]];return this},abort:function(e){var t=e||C;return i&&i.abort(t),k(0,t),this}};if(v.promise(E),h.url=((t||h.url||Ct.href)+"").replace(Rt,Ct.protocol+"//"),h.type=n.method||n.type||h.method||h.type,h.dataTypes=(h.dataType||"*").toLowerCase().match(M)||[""],null==h.crossDomain){l=r.createElement("a");try{l.href=h.url,l.href=l.href,h.crossDomain=Bt.protocol+"//"+Bt.host!=l.protocol+"//"+l.host}catch(e){h.crossDomain=!0}}if(h.data&&h.processData&&"string"!=typeof h.data&&(h.data=w.param(h.data,h.traditional)),_t(It,h,n,E),c)return E;(f=w.event&&h.global)&&0==w.active++&&w.event.trigger("ajaxStart"),h.type=h.type.toUpperCase(),h.hasContent=!Mt.test(h.type),o=h.url.replace(Lt,""),h.hasContent?h.data&&h.processData&&0===(h.contentType||"").indexOf("application/x-www-form-urlencoded")&&(h.data=h.data.replace(qt,"+")):(d=h.url.slice(o.length),h.data&&(h.processData||"string"==typeof h.data)&&(o+=(kt.test(o)?"&":"?")+h.data,delete h.data),!1===h.cache&&(o=o.replace(Ht,"$1"),d=(kt.test(o)?"&":"?")+"_="+Et+++d),h.url=o+d),h.ifModified&&(w.lastModified[o]&&E.setRequestHeader("If-Modified-Since",w.lastModified[o]),w.etag[o]&&E.setRequestHeader("If-None-Match",w.etag[o])),(h.data&&h.hasContent&&!1!==h.contentType||n.contentType)&&E.setRequestHeader("Content-Type",h.contentType),E.setRequestHeader("Accept",h.dataTypes[0]&&h.accepts[h.dataTypes[0]]?h.accepts[h.dataTypes[0]]+("*"!==h.dataTypes[0]?", "+$t+"; q=0.01":""):h.accepts["*"]);for(p in h.headers)E.setRequestHeader(p,h.headers[p]);if(h.beforeSend&&(!1===h.beforeSend.call(g,E,h)||c))return E.abort();if(C="abort",m.add(h.complete),E.done(h.success),E.fail(h.error),i=_t(Wt,h,n,E)){if(E.readyState=1,f&&y.trigger("ajaxSend",[E,h]),c)return E;h.async&&h.timeout>0&&(u=e.setTimeout(function(){E.abort("timeout")},h.timeout));try{c=!1,i.send(b,k)}catch(e){if(c)throw e;k(-1,e)}}else k(-1,"No Transport");function k(t,n,r,s){var l,p,d,b,T,C=n;c||(c=!0,u&&e.clearTimeout(u),i=void 0,a=s||"",E.readyState=t>0?4:0,l=t>=200&&t<300||304===t,r&&(b=Xt(h,E,r)),b=Ut(h,b,E,l),l?(h.ifModified&&((T=E.getResponseHeader("Last-Modified"))&&(w.lastModified[o]=T),(T=E.getResponseHeader("etag"))&&(w.etag[o]=T)),204===t||"HEAD"===h.type?C="nocontent":304===t?C="notmodified":(C=b.state,p=b.data,l=!(d=b.error))):(d=C,!t&&C||(C="error",t<0&&(t=0))),E.status=t,E.statusText=(n||C)+"",l?v.resolveWith(g,[p,C,E]):v.rejectWith(g,[E,C,d]),E.statusCode(x),x=void 0,f&&y.trigger(l?"ajaxSuccess":"ajaxError",[E,h,l?p:d]),m.fireWith(g,[E,C]),f&&(y.trigger("ajaxComplete",[E,h]),--w.active||w.event.trigger("ajaxStop")))}return E},getJSON:function(e,t,n){return w.get(e,t,n,"json")},getScript:function(e,t){return w.get(e,void 0,t,"script")}}),w.each(["get","post"],function(e,t){w[t]=function(e,n,r,i){return g(n)&&(i=i||r,r=n,n=void 0),w.ajax(w.extend({url:e,type:t,dataType:i,data:n,success:r},w.isPlainObject(e)&&e))}}),w._evalUrl=function(e){return w.ajax({url:e,type:"GET",dataType:"script",cache:!0,async:!1,global:!1,"throws":!0})},w.fn.extend({wrapAll:function(e){var t;return this[0]&&(g(e)&&(e=e.call(this[0])),t=w(e,this[0].ownerDocument).eq(0).clone(!0),this[0].parentNode&&t.insertBefore(this[0]),t.map(function(){var e=this;while(e.firstElementChild)e=e.firstElementChild;return e}).append(this)),this},wrapInner:function(e){return g(e)?this.each(function(t){w(this).wrapInner(e.call(this,t))}):this.each(function(){var t=w(this),n=t.contents();n.length?n.wrapAll(e):t.append(e)})},wrap:function(e){var t=g(e);return this.each(function(n){w(this).wrapAll(t?e.call(this,n):e)})},unwrap:function(e){return this.parent(e).not("body").each(function(){w(this).replaceWith(this.childNodes)}),this}}),w.expr.pseudos.hidden=function(e){return!w.expr.pseudos.visible(e)},w.expr.pseudos.visible=function(e){return!!(e.offsetWidth||e.offsetHeight||e.getClientRects().length)},w.ajaxSettings.xhr=function(){try{return new e.XMLHttpRequest}catch(e){}};var Vt={0:200,1223:204},Gt=w.ajaxSettings.xhr();h.cors=!!Gt&&"withCredentials"in Gt,h.ajax=Gt=!!Gt,w.ajaxTransport(function(t){var n,r;if(h.cors||Gt&&!t.crossDomain)return{send:function(i,o){var a,s=t.xhr();if(s.open(t.type,t.url,t.async,t.username,t.password),t.xhrFields)for(a in t.xhrFields)s[a]=t.xhrFields[a];t.mimeType&&s.overrideMimeType&&s.overrideMimeType(t.mimeType),t.crossDomain||i["X-Requested-With"]||(i["X-Requested-With"]="XMLHttpRequest");for(a in i)s.setRequestHeader(a,i[a]);n=function(e){return function(){n&&(n=r=s.onload=s.onerror=s.onabort=s.ontimeout=s.onreadystatechange=null,"abort"===e?s.abort():"error"===e?"number"!=typeof s.status?o(0,"error"):o(s.status,s.statusText):o(Vt[s.status]||s.status,s.statusText,"text"!==(s.responseType||"text")||"string"!=typeof s.responseText?{binary:s.response}:{text:s.responseText},s.getAllResponseHeaders()))}},s.onload=n(),r=s.onerror=s.ontimeout=n("error"),void 0!==s.onabort?s.onabort=r:s.onreadystatechange=function(){4===s.readyState&&e.setTimeout(function(){n&&r()})},n=n("abort");try{s.send(t.hasContent&&t.data||null)}catch(e){if(n)throw e}},abort:function(){n&&n()}}}),w.ajaxPrefilter(function(e){e.crossDomain&&(e.contents.script=!1)}),w.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/\b(?:java|ecma)script\b/},converters:{"text script":function(e){return w.globalEval(e),e}}}),w.ajaxPrefilter("script",function(e){void 0===e.cache&&(e.cache=!1),e.crossDomain&&(e.type="GET")}),w.ajaxTransport("script",function(e){if(e.crossDomain){var t,n;return{send:function(i,o){t=w(" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + + + + + +
+

Steps for running and adding SIPNET forecasts

+
+

Files associated with running forecasts:

+
    +
  1. generate.gefs.xml : R script for setting start and end date in xml; creates workflow id and associated directory
    2. +
  2. *sitename*.xml : site specific xml script
    3. +
  3. *sitename*.sh : site specific shell file to run forecasts with cron jobs
    4. +
+
+
+

Files associated with graphing forecasts:

+
    +
  1. download_*sitename*.R : R script for downloading and cleaning Flux data from towers
    2. +
  2. graph_fluxtowers.R : script to create RData for shiny app
    3. +
  3. forecast.graphs.R : script that is used to get forecasted data for graph_fluxtowers.R
    4. +
  4. graph_SDA_fluxtowers.R : script to graph SDA fluxtowers
    5. +
  5. automatic_graphs.sh : shell for running email.R, graph_fluxtowers.R, graph_SDA_fluxtowers.R
    6. +
+
+
+

Files for automatic WCr emails:

+
    +
  1. email_graphs.R - creates graphs for the email - this is specifically for WCr right now
    2. +
  2. email.R - sends the email out with graphs for today’s forecast
    3. +
+
+
+

To add forecast and add to dashboard:

+
    +
  1. create a flux download for site
    2. +
  2. create site specific xml
    3. +
  3. create site specific shell file to run forecast automatically
    4. +
  4. Add site.num, site.abv, outdir, db.num to graph_fluxtowers.R
    5. +
+
+
+ + + + +
+ + + + + + + + + + + + + + + diff --git a/modules/assim.sequential/inst/NEFI/README.md b/modules/assim.sequential/inst/NEFI/README.md new file mode 100644 index 00000000000..fad78dba3d1 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/README.md @@ -0,0 +1,28 @@ +Steps for running and adding SIPNET forecasts +========================================================================== + +### Files associated with running forecasts: +1. `generate.gefs.xml` : R script for setting start and end date in xml; creates workflow id and associated directory +2. `*sitename*.xml` : site specific xml script +3. `*sitename*.sh` : site specific shell file to run forecasts with cron jobs + +### Files associated with graphing forecasts: +1. `download_*sitename*.R` : R script for downloading and cleaning Flux data from towers +2. `graph_fluxtowers.R` : script to create RData for shiny app +3. `forecast.graphs.R` : script that is used to get forecasted data for `graph_fluxtowers.R` +4. `graph_SDA_fluxtowers.R` : script to graph SDA fluxtowers +5. `automatic_graphs.sh` : shell for running `email.R`, `graph_fluxtowers.R`, `graph_SDA_fluxtowers.R` + +### Files for automatic WCr emails: +1. `email_graphs.R` - creates graphs for the email - this is specifically for WCr right now +2. `email.R` - sends the email out with graphs for today's forecast + + + + +### To add forecast and add to dashboard: +1. create a flux download for site +2. create site specific xml +3. create site specific shell file to run forecast automatically +4. Add site.num, site.abv, outdir, db.num to graph_fluxtowers.R + diff --git a/modules/assim.sequential/inst/NEFI/README.txt b/modules/assim.sequential/inst/NEFI/README.txt deleted file mode 100644 index 73bade4ee66..00000000000 --- a/modules/assim.sequential/inst/NEFI/README.txt +++ /dev/null @@ -1,72 +0,0 @@ -Author: Luke Dramko - -This collection of R scripts utilizes the PEcAn workflow to iteratively run forecasts. - -run.gefs.sipnet.sh, generate.gefs.xml.R, and gefs.sipnet.source.xml work in tandem -to run PEcAn's SIPNET model with current NOAA GEFS data. This system can be put -on a cron job with minimal effort; simply put the target of the cron job as -run.gefs.sipnet.sh - --- run.gefs.sipnet.sh -- -This master bash script is intended to be called as a cron job, but it can be run -manually as well. It first runs generate.gefs.xml.R, then runs PEcAn based on the -resulting xml. If being used to manually run a PEcAn workflow, run.gefs.sipnet.sh's -first command line argument can be a date. That date will be used as the start -date for the run. Several variables, declared at the top of the script, control -critical file paths, such as the location of the desired copy of workflow.R and -the location of gefs.sipnet.source.xml and generate.gefs.xml - -Note that the current version of run.gefs.sipnet.sh actually has EXAMPLE in the title. -This is because the script requires absolute paths to work properly, which will be different for every user. -These paths are listed as variables at the top of the file; simply change them to the appropriate paths on your machine. - --- gefs.sipnet.source.xml -- -This is the basis xml file from which all workflows are based. generate.gefs.xml.R -uses this as its basis. Aside from the fields which generate.gefs.xml.R changes, -all changes to the xml file are conserved between runs. This xml contains settings -for state data assimilation; change remove these if SDA is not to be used. - --- generate.gefs.xml.R -- -This script overwrites gefs.sipnet.source xml with fresh values for any given run. -It updates the following fields: -* start and end date for -* workflow id -* time of the run () -* met.start and met.end -* start.year and end.year for -* output directory (but not the dbfile directory) -Additionally, this script does some important work usually done by the web interface. -In particular, it generates a unique workflow id based on the ids in the database -and insert the workflow ID. -It also generates the output folder. - -Several other scripts are included to make gathering and interpeting data easier - --- graphs.R -- -Generates a graph of NEE and LE calculated via a run with a 95% confidence interval -vs. observed data. Can be called with either a date or a workflow ID as a command line argument. -By default, this script places all graphs in ./graphs/. If you want a different directory, change the graphs_dir -file path at the start of the file. - -graphs.R is not intended to be a part of the PEcAn workflow; it is an independent script. - --- graphs_timeframe.R -- -graphs_timeframe.R is intended to be used to make frames for a gif or other video format. It locks the x and y axes, -leading to consistent axes values between runs. (graphs.R uses ggplot2's default x and y axes, which fit themselves to the -data). graphs_timeframe.R will graph only NEE or LE; this is because when both are graphed, the pdf device puts -them into a single file. graphs_timeframe.R accepts a second command line argument telling it which to run for. -graphs_timeframe.R pads the data with NA's in order to properly place the data in the appropriate -time span in the graph. Otherwise, it works like graphs.R. - -Like graphs.R, graphs_timeframe.R is not intended to be part of the PEcAn workflow; it is an independent script. - --- last12days.R -- -This is a simple and very specific script that runs NOAA GEFS for the last 12 -days. This is useful because that's the range of time that NOAA_GEFS data is -avaliable. - -* Database scripts * -These scripts are useful for modifying the database. Because everything NOAA_GEFS -does is repeated 21 times (1 for each ensemble member) it is impractical to -clean the database via the web interface, where only one file can be removed at -a time. diff --git a/modules/assim.sequential/inst/NEFI/US_Harvard/download_Harvard.R b/modules/assim.sequential/inst/NEFI/US_Harvard/download_Harvard.R new file mode 100644 index 00000000000..ddfc4e8a935 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Harvard/download_Harvard.R @@ -0,0 +1,62 @@ +library(tidyr) +library(tidyverse) +library(lubridate) +library(PEcAn.all) + +download_US_Harvard <- function(start_date, end_date) { + + if(end_date > Sys.Date()) end_date = Sys.Date() + date = seq(from = start_date, to = end_date, by = 'days') + data = NA + for(i in 1:length(date)){ + + yy <- strftime(date[i], format = "%y") + doy <- strftime(date[i], format = "%j") + my_host <- list(name = "geo.bu.edu", user = 'kzarada', tunnel = "/tmp/tunnel") + + try(remote.copy.from(host = my_host, src = paste0('/projectnb/dietzelab/NEFI_data/HFEMS_prelim_', yy, '_', doy, '_dat.csv'), + dst = paste0('/fs/data3/kzarada/NEFI/US_Harvard/Flux_data/', yy, doy,'.csv'), delete=FALSE)) + + + + if(file.exists(paste0('/fs/data3/kzarada/NEFI/US_Harvard/Flux_data/', yy, doy,'.csv'))){ + data1 = read.csv(paste0('/fs/data3/kzarada/NEFI/US_Harvard/Flux_data/', yy,doy,'.csv'), header = T, sep = "") + data = rbind(data, data1)} + + } + + + data <- data %>% + drop_na(TIME_START.YYYYMMDDhhmm) %>% + mutate(Time = lubridate::with_tz(as.POSIXct(strptime(TIME_START.YYYYMMDDhhmm, format = "%Y%m%d%H%M", tz = "EST"),tz = "EST"), tz = "UTC")) %>% + dplyr::select(Time, LHF.W.m.2, Fco2.e.6mol.m.2.s.1) + + colnames(data) <- c("Time", "LE", "NEE") + + + Time = lubridate::force_tz(seq(from = as.POSIXct(start_date), to = as.POSIXct(end_date), by = "30 mins"), tz = "UTC") + + data.full = data.frame(Time, NEE = rep(NA, length(Time)), LE = rep(NA, length(Time))) + + + + + match(Time, data$Time) + + data.full$NEE <- data$NEE[match(Time, data$Time)] + data.full$LE <- data$NEE[match(Time, data$Time)] + data.full$NEE <- PEcAn.utils::misc.convert(data.full$NEE, "umol C m-2 s-1", "kg C m-2 s-1") + + + return(data.full) + } + + +#manually check if files are available +#read.csv('ftp://ftp.as.harvard.edu/pub/exchange/jwm/Forecast_data/HFEMS_prelim_19_330_dat.csv') + + + + + + diff --git a/modules/assim.sequential/inst/NEFI/US_Harvard/download_Harvard_met.R b/modules/assim.sequential/inst/NEFI/US_Harvard/download_Harvard_met.R new file mode 100644 index 00000000000..14af3bf5ff4 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Harvard/download_Harvard_met.R @@ -0,0 +1,47 @@ +library(tidyr) +library(tidyverse) +library(lubridate) + +download_US_Harvard_met <- function(start_date, end_date) { + + + date = seq(from = start_date, to = end_date, by = 'days') + data = NA + for(i in 1:length(date)){ + + yy <- strftime(date[i], format = "%y") + doy <- strftime(date[i], format = "%j") + + if(file.exists(paste0('/fs/data3/kzarada/NEFI/US_Harvard/Flux_data/', yy, doy,'.csv'))){ + data1 = read.csv(paste0('/fs/data3/kzarada/NEFI/US_Harvard/Flux_data/', yy,doy,'.csv'), header = T, sep = "") + data = rbind(data, data1)} + + } + + + data <- data %>% + drop_na(TIME_START.YYYYMMDDhhmm) %>% + mutate(Time = lubridate::with_tz(as.POSIXct(strptime(TIME_START.YYYYMMDDhhmm, format = "%Y%m%d%H%M", tz = "EST"),tz = "EST"), tz = "UTC")) %>% + dplyr::select(Time, Wspd.m.s.1, Ta.C, RH) + + colnames(data) <- c("date", "ws", "Tair", "rH") + + + date = lubridate::force_tz(seq(from = as.POSIXct(start_date), to = as.POSIXct(end_date), by = "30 mins"), tz = "UTC") + + data.full = data.frame(date, ws = rep(NA, length(date)), Tair = rep(NA, length(date)), rH = rep(NA, length(date)) ) + + + + + + + data.full$ws <- data$ws[match(date, data$date)] + data.full$Tair <- data$Tair[match(date, data$date)] + data.full$rH <- data$rH[match(date, data$date)] + + + return(data.full) + +} #end function + \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_Harvard/download_soilmoist_harvard.R b/modules/assim.sequential/inst/NEFI/US_Harvard/download_soilmoist_harvard.R new file mode 100644 index 00000000000..b6ba2937b2c --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Harvard/download_soilmoist_harvard.R @@ -0,0 +1,56 @@ +library(tidyr) +library(tidyverse) +library(lubridate) +library(PEcAn.all) + +download_soilmoist_Harvard <- function(start_date, end_date) { + + if(end_date > Sys.Date()) end_date = Sys.Date() + if(start_date < as.Date("2019-11-06")) start_date = "2019-11-06" + date = seq(from = as.Date(start_date), to = as.Date(end_date), by = 'days') + data = NA + for(i in 1:length(date)){ + + yy <- strftime(date[i], format = "%y") + doy <- strftime(date[i], format = "%j") + #my_host <- list(name = "geo.bu.edu", user = 'kzarada', tunnel = "/tmp/tunnel") + + #try(remote.copy.from(host = my_, src = paste0('/projectnb/dietzelab/NEFI_data/HFEMS_prelim_', yy, '_', doy, '_dat.csv'), + #dst = paste0('/fs/data3/kzarada/NEFI/US_Harvard/Flux_data/', yy, doy,'.csv'), delete=FALSE)) + + + + if(file.exists(paste0('/projectnb/dietzelab/NEFI_data/HFEMS_prelim_', yy, '_', doy, '_dat.csv'))){ + data1 = read.csv(paste0('/projectnb/dietzelab/NEFI_data/HFEMS_prelim_', yy, '_', doy, '_dat.csv'), header = T, sep = "") + data = rbind(data, data1)} + + } + + + data <- data %>% + drop_na(TIME_START.YYYYMMDDhhmm) %>% + mutate(Time = lubridate::with_tz(as.POSIXct(strptime(TIME_START.YYYYMMDDhhmm, format = "%Y%m%d%H%M", tz = "EST"),tz = "EST"), tz = "UTC")) %>% + dplyr::select(Time, SWC15) + + colnames(data) <- c("Time", "SWC15") + + + Time = lubridate::force_tz(seq(from = as.POSIXct(start_date), to = as.POSIXct(end_date), by = "30 mins"), tz = "UTC") + + data.full = data.frame(Time, SWC15 = rep(NA, length(Time))) + + + + + match(Time, data$Time) + + data.full$SWC15 <- data$SWC15[match(Time, data$Time)] + + + + return(data.full) +} + + +#manually check if files are available +#read.csv('ftp://ftp.as.harvard.edu/pub/exchange/jwm/Forecast_data/HFEMS_prelim_20_196_dat.csv') diff --git a/modules/assim.sequential/inst/NEFI/US_Harvard/harvard.sh b/modules/assim.sequential/inst/NEFI/US_Harvard/harvard.sh new file mode 100755 index 00000000000..6616af4e0fe --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Harvard/harvard.sh @@ -0,0 +1,30 @@ +# This script first runs a program which sets up the xml file for a current +# NOAA_GEFS PEcAn run, then runs PEcAn with that file. +# @author Luke Dramko + +# REPLACE < username > WITH YOUR USERNAME +# If running from a CRON job, these paths MUST be absolute paths. This is because CRON assumes that the directory it is in is the working directory. +xmlfile="/fs/data3/kzarada/NEFI/US_Harvard/harvard.xml" #Path to, and name of, the base xml file. +workflow_path="/fs/data3/kzarada/pecan/web/" #Path to workflow.R (in pecan/web for the standard version or pecan/scripts for the custom version). +output_path="/fs/data3/kzarada/NEFI/US_Harvard/output" #Path to the directory where all PEcAn output is put. +xmlscript="/fs/data3/kzarada/NEFI/NEFI_tools/pecan_scripts/generate.gefs.xml.R" #Path to, and name of, the script that modifies the xml. +# Could also be just workflow.R in pecan/web +workflow_name="workflow.R" #"workflow.wcr.assim.R" #Name of the workflow.R version + +# Generates the xml file based on a given input file. Overwrites the +# input file. +Rscript $xmlscript $xmlfile $1 &> /dev/null +if [ $? -eq 11 ]; +then +echo "xml file not found." +elif [ $? -eq 12 ] +then +echo "Database connection failed." +else + # Find the most recently created output directory. This system is kind of hack-y, and is messed up if anything after + # "PEcAn", alphabetically, is put in the directory. Fortunately, that is unlikely to happen. + output_dir=$(ls $output_path | sort -V | tail -n 1) +# Runs the PEcAn workflow. +Rscript ${workflow_path}${workflow_name} $xmlfile &> ${output_path}/${output_dir}/workflow.log.txt +echo "Workflow completed." +fi \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_Harvard/harvard.xml b/modules/assim.sequential/inst/NEFI/US_Harvard/harvard.xml new file mode 100755 index 00000000000..6a63e70656e --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Harvard/harvard.xml @@ -0,0 +1,91 @@ + + + + + 1000007443 + kzarada + 2020/03/19 04:40:03 +0000 + + /fs/data3/kzarada/NEFI/US_Harvard/output/PEcAn_1000012745/ + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + false + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.deciduous + + 1 + + + + + 3000 + + FALSE + FALSE + + 1.2 + AUTO + + + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + parameters + + + soil + + + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + SIPNET + unk + FALSE + /fs/data5/pecan.models/sipnet_unk/sipnet + + + 1000012745 + + + + 646 + 2020-03-07 + 2020-04-04 + + + + NOAA_GEFS_downscale + SIPNET + + + 2020-03-19 + 2020-04-04 + + + localhost + + diff --git a/modules/assim.sequential/inst/NEFI/US_Los/download_Los.R b/modules/assim.sequential/inst/NEFI/US_Los/download_Los.R new file mode 100644 index 00000000000..8d4bf4e6533 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Los/download_Los.R @@ -0,0 +1,40 @@ +library(tidyr) +library(tidyverse) +library(lubridate) + +download_US_Los <- function(start_date, end_date) { + + base_url <- "http://co2.aos.wisc.edu/data/cheas/lcreek/flux/current/ameriflux/US-Los_HH_" + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + data <- start_year:end_year %>% + purrr::map_df(function(syear){ + influx <- + tryCatch( + read.table( + paste0(base_url, syear, '01010000_', syear + 1, "01010000.csv"), + sep = ",", + header = TRUE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) %>% + mutate(Time = lubridate::ymd_hm(TIMESTAMP_START)) %>% + dplyr::select(Time, NEE, LE = LE_1_1_1) %>% + dplyr::na_if(-9999) %>% + mutate(NEE = PEcAn.utils::misc.convert(NEE, "umol C m-2 s-1", "kg C m-2 s-1")) %>% + filter(Time >= start_date & Time <=end_date) + + return(data) +} diff --git a/modules/assim.sequential/inst/NEFI/US_Los/download_Los_met.R b/modules/assim.sequential/inst/NEFI/US_Los/download_Los_met.R new file mode 100644 index 00000000000..b45f4651c9f --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Los/download_Los_met.R @@ -0,0 +1,40 @@ +library(tidyr) +library(tidyverse) +library(lubridate) + +download_US_Los_met <- function(start_date, end_date) { + + base_url <- "http://co2.aos.wisc.edu/data/cheas/lcreek/flux/current/ameriflux/US-Los_HH_" + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + data <- start_year:end_year %>% + purrr::map_df(function(syear){ + influx <- + tryCatch( + read.table( + paste0(base_url, syear, '01010000_', syear + 1, "01010000.csv"), + sep = ",", + header = TRUE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) %>% + mutate(Time = lubridate::ymd_hm(TIMESTAMP_START)) %>% + dplyr::select(Time, WS_1_1_1, TA_1_1_1) %>% + dplyr::na_if(-9999) %>% + add_column(rH = NA)%>% + filter(Time >= start_date & Time <=end_date) + colnames(data) = c("date", "ws", 'Tair', "rH") + return(data) +} diff --git a/modules/assim.sequential/inst/NEFI/US_Los/los.sh b/modules/assim.sequential/inst/NEFI/US_Los/los.sh new file mode 100755 index 00000000000..b3cf44e1dad --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Los/los.sh @@ -0,0 +1,30 @@ +# This script first runs a program which sets up the xml file for a current +# NOAA_GEFS PEcAn run, then runs PEcAn with that file. +# @author Luke Dramko + +# REPLACE < username > WITH YOUR USERNAME +# If running from a CRON job, these paths MUST be absolute paths. This is because CRON assumes that the directory it is in is the working directory. +xmlfile="/fs/data3/kzarada/NEFI/US_Los/los.xml" #Path to, and name of, the base xml file. +workflow_path="/fs/data3/kzarada/pecan/web/" #Path to workflow.R (in pecan/web for the standard version or pecan/scripts for the custom version). +output_path="/fs/data3/kzarada/NEFI/US_Los/output" #Path to the directory where all PEcAn output is put. +xmlscript="/fs/data3/kzarada/NEFI/NEFI_tools/pecan_scripts/generate.gefs.xml.R" #Path to, and name of, the script that modifies the xml. +# Could also be just workflow.R in pecan/web +workflow_name="workflow.R" #"workflow.wcr.assim.R" #Name of the workflow.R version + +# Generates the xml file based on a given input file. Overwrites the +# input file. +Rscript $xmlscript $xmlfile $1 &> /dev/null +if [ $? -eq 11 ]; +then +echo "xml file not found." +elif [ $? -eq 12 ] +then +echo "Database connection failed." +else + # Find the most recently created output directory. This system is kind of hack-y, and is messed up if anything after + # "PEcAn", alphabetically, is put in the directory. Fortunately, that is unlikely to happen. + output_dir=$(ls $output_path | sort -V | tail -n 1) +# Runs the PEcAn workflow. +Rscript ${workflow_path}${workflow_name} $xmlfile &> ${output_path}/${output_dir}/workflow.log.txt +echo "Workflow completed." +fi \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_Los/los.xml b/modules/assim.sequential/inst/NEFI/US_Los/los.xml new file mode 100755 index 00000000000..3aebb61cfe4 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Los/los.xml @@ -0,0 +1,77 @@ + + + + + -1 + + 2020/03/19 04:45:03 +0000 + + /fs/data3/kzarada/NEFI/US_Los/output/PEcAn_1000012746/ + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + false + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.wetland + + 1 + + + + + 3000 + FALSE + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + + + 1000012746 + + + + 679 + 2020-03-07 + 2020-04-04 + + + + NOAA_GEFS_downscale + SIPNET + + + 2020-03-19 + 2020-04-04 + + + localhost + + diff --git a/modules/assim.sequential/inst/NEFI/US_Potato/download_Potato.R b/modules/assim.sequential/inst/NEFI/US_Potato/download_Potato.R new file mode 100644 index 00000000000..2626e44a6f0 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Potato/download_Potato.R @@ -0,0 +1,94 @@ +#if then statement for date? Only the last 4 days are available in the current folder +#second part would be in the year folder that corresponds with the start date. +#only need the current system date from the current folder. The rest are in the year folder + +download_US_Potato<- function(start_date, end_date) { + + + #Each .dat file is a seperate half hour file. + date = seq.Date(from = as.Date(start_date), to = as.Date(end_date), by = 'day') + + t <- format(seq(from=as.POSIXct("0000","%H%M", tz="UTC"), + to=as.POSIXct("2330", "%H%M", tz="UTC"), + by="30 min", format = "%H%M"), "%H%M") + #read in the headers to start the data frame + data = read.delim("http://co2.aos.wisc.edu/data/potato/2019/20190128/Potato_flux_2019_01_28_0000.dat", sep = ",", skip = 1, stringsAsFactors = FALSE)[1,] + + #the current day is saved in a different folder so we need a different url + if(end_date == Sys.Date()){ + + for(j in 1: (length(date)-1)){ + + for( i in 1: length(t)){ + + + baseurl <- "http://co2.aos.wisc.edu/data/potato/" + url <- paste0(baseurl, lubridate::year(date[j]), "/", gsub("-", "", (date[j])), "/Potato_flux_", gsub("-", "_", (date[j])), "_", t[i], ".dat") + if(url.exists(url)){ + data<- rbind(data, read.delim(url, sep = ",", skip = 1, stringsAsFactors = FALSE)[3,]) + }else { + index.time <- strsplit(t[i], "") + index <- c(paste0(date[j], " ", index.time[[1]][1], index.time[[1]][2] , ":", index.time[[1]][3], index.time[[1]][4] , ":00"), rep("NA", 97)) + data <- rbind(data, index ) + } + + } + } + + #Have to adjust the time length because it's current. Going back 2 hours just to be safe with lag and errors + p <- format(seq(from=as.POSIXct("0000","%H%M", tz="UTC"), + to=as.POSIXct(format(lubridate::round_date(Sys.time() - lubridate::hours(2), unit = "30 min"), "%H%M"), "%H%M", tz="UTC"), + by="30 min", format = "%H%M"), "%H%M") + + for(i in 1:length(p)){ + + url1 <- paste0("http://co2.aos.wisc.edu/data/potato/current/Potato_flux_", gsub("-", "_", end_date), "_", p[i], ".dat") + data<- rbind(data, read.delim(url1, sep = ",", skip = 1, stringsAsFactors = FALSE)[3,]) + + } + } else{ + + for(j in 1: (length(date))){ + + for( i in 1: length(t)){ + + baseurl <- "http://co2.aos.wisc.edu/data/potato/" + url <- paste0(baseurl, lubridate::year(date[j]), "/", gsub("-", "", (date[j])), "/Potato_flux_", gsub("-", "_", (date[j])), "_", t[i], ".dat") + if(url.exists(url)){ + data<- rbind(data, read.delim(url, sep = ",", skip = 1, stringsAsFactors = FALSE)[3,]) + }else { + index.time <- strsplit(t[i], "") + index <- c(paste0(date[j], " ", index.time[[1]][1], index.time[[1]][2] , ":", index.time[[1]][3], index.time[[1]][4] , ":00"), rep("NA", 97)) + data <- rbind(data, index ) + } + + } + } + } + #want to pull out timestamp, u_star, + + #clean data + + data <- data[-1,] #remove units + + data <- data %>% dplyr::select("TIMESTAMP", "u_star" ,"LE_wpl", "Fc_wpl", "CO2_sig_strgth_mean", "H2O_sig_strgth_mean") %>% + mutate(NEE = replace(Fc_wpl, u_star < 0.1, "NA"), LE = replace(LE_wpl, u_star < 0.1, "NA")) %>% + mutate(NEE = replace(NEE, CO2_sig_strgth_mean < 0.6, "NA"), LE = replace(LE, H2O_sig_strgth_mean < 0.6, "NA")) %>% + dplyr::select("TIMESTAMP", "NEE", "LE") %>% + mutate(NEE = as.numeric(NEE), LE = as.numeric(LE)) %>% + na_if( -999) %>% + mutate(NEE = PEcAn.utils::misc.convert(NEE, "umol C m-2 s-1", "kg C m-2 s-1"), LE = as.numeric(LE)) + + + + colnames(data) <- c("Time", "NEE", "LE") + return(data) +} + + + +#download_potato(start_date, end_date) +#start_date = "2019-07-22" +#end_date = "2019-07-24" + + diff --git a/modules/assim.sequential/inst/NEFI/US_Potato/potato.sh b/modules/assim.sequential/inst/NEFI/US_Potato/potato.sh new file mode 100644 index 00000000000..01b47a3c92b --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Potato/potato.sh @@ -0,0 +1,30 @@ +# This script first runs a program which sets up the xml file for a current +# NOAA_GEFS PEcAn run, then runs PEcAn with that file. +# @author Luke Dramko + +# REPLACE < username > WITH YOUR USERNAME +# If running from a CRON job, these paths MUST be absolute paths. This is because CRON assumes that the directory it is in is the working directory. +xmlfile="/fs/data3/kzarada/NEFI/US_Potato/potato.xml" #Path to, and name of, the base xml file. +workflow_path="/fs/data3/kzarada/pecan/web/" #Path to workflow.R (in pecan/web for the standard version or pecan/scripts for the custom version). +output_path="/fs/data3/kzarada/NEFI/US_Potato/output" #Path to the directory where all PEcAn output is put. +xmlscript="/fs/data3/kzarada/NEFI/NEFI_tools/pecan_scripts/generate.gefs.xml.R" #Path to, and name of, the script that modifies the xml. +# Could also be just workflow.R in pecan/web +workflow_name="workflow.R" #"workflow.wcr.assim.R" #Name of the workflow.R version + +# Generates the xml file based on a given input file. Overwrites the +# input file. +Rscript $xmlscript $xmlfile $1 &> /dev/null +if [ $? -eq 11 ]; +then +echo "xml file not found." +elif [ $? -eq 12 ] +then +echo "Database connection failed." +else + # Find the most recently created output directory. This system is kind of hack-y, and is messed up if anything after + # "PEcAn", alphabetically, is put in the directory. Fortunately, that is unlikely to happen. + output_dir=$(ls $output_path | sort -V | tail -n 1) +# Runs the PEcAn workflow. +Rscript ${workflow_path}${workflow_name} $xmlfile &> ${output_path}/${output_dir}/workflow.log.txt +echo "Workflow completed." +fi \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_Potato/potato.xml b/modules/assim.sequential/inst/NEFI/US_Potato/potato.xml new file mode 100644 index 00000000000..cd58dacd62f --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Potato/potato.xml @@ -0,0 +1,77 @@ + + + + + -1 + + 2020/03/10 12:37:10 +0000 + + /fs/data3/kzarada/NEFI/US_Potato/output/PEcAn_1000012659/ + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + false + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + semiarid.grassland + + 1 + + + + + 3000 + FALSE + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + + + 1000012659 + + + + 1000026756 + 2020-02-27 + 2020-03-26 + + + + NOAA_GEFS_downscale + SIPNET + + + 2020-03-10 + 2020-03-26 + + + localhost + + diff --git a/modules/assim.sequential/inst/NEFI/US_Syv/download_Syv.R b/modules/assim.sequential/inst/NEFI/US_Syv/download_Syv.R new file mode 100644 index 00000000000..e4c854997ac --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Syv/download_Syv.R @@ -0,0 +1,42 @@ +library(tidyr) +library(tidyverse) +library(lubridate) + +download_US_Syv <- function(start_date, end_date) { + + base_url <- "http://co2.aos.wisc.edu/data/cheas/sylvania/flux/current/ameriflux/US-Syv_HH_" + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + data <- start_year:end_year %>% + purrr::map_df(function(syear){ + influx <- + tryCatch( + read.table( + paste0(base_url, syear, '01010000_', syear + 1, "01010000.csv"), + sep = ",", + header = TRUE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) %>% + mutate(Time = lubridate::ymd_hm(TIMESTAMP_START)) %>% + dplyr::select(Time, NEE, LE = LE_1_1_1) %>% + dplyr::na_if(-9999) %>% + mutate(NEE = PEcAn.utils::misc.convert(NEE, "umol C m-2 s-1", "kg C m-2 s-1")) %>% + filter(Time >= start_date & Time <=end_date) + + return(data) +} + + \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_Syv/download_Syv_met.R b/modules/assim.sequential/inst/NEFI/US_Syv/download_Syv_met.R new file mode 100644 index 00000000000..cefa42bdb9f --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Syv/download_Syv_met.R @@ -0,0 +1,40 @@ +library(tidyr) +library(tidyverse) +library(lubridate) + +download_US_Syv_met <- function(start_date, end_date) { + + base_url <- "http://co2.aos.wisc.edu/data/cheas/sylvania/flux/current/ameriflux/US-Syv_HH_" + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + data <- start_year:end_year %>% + purrr::map_df(function(syear){ + influx <- + tryCatch( + read.table( + paste0(base_url, syear, '01010000_', syear + 1, "01010000.csv"), + sep = ",", + header = TRUE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) %>% + mutate(Time = lubridate::ymd_hm(TIMESTAMP_START)) %>% + dplyr::select(Time, WS_1_1_1, TA_1_1_1, RH_1_1_1, TS_1_1_1) %>% + dplyr::na_if(-9999) %>% + filter(Time >= start_date & Time <=end_date) + colnames(data) = c("date", "ws", 'Tair', "rH", "Tsoil") + return(data) +} + diff --git a/modules/assim.sequential/inst/NEFI/US_Syv/download_soilmoist_Syv.R b/modules/assim.sequential/inst/NEFI/US_Syv/download_soilmoist_Syv.R new file mode 100644 index 00000000000..e8c022c8c45 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Syv/download_soilmoist_Syv.R @@ -0,0 +1,40 @@ +download_soilmoist_Syv <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/sylvania/flux/prelim/clean/ameriflux/US-Syv_HH_" + + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "01010000_", syear+1, "01010000.csv"), + sep = ",", + header = TRUE, stringsAsFactors = F + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + #Constructing the date based on the columns we have + raw.data$Time <-as.POSIXct(as.character(raw.data$TIMESTAMP_START), + format="%Y%m%d%H%M", tz="UTC") + # Some cleaning and filtering + raw.data <- raw.data %>% + dplyr::select(SWC_1_1_1, Time) %>% + na_if(-9999) %>% + filter(Time >= start_date & Time <=end_date) + colnames(raw.data) <- c('avgsoil', 'Time') + return(raw.data) +} diff --git a/modules/assim.sequential/inst/NEFI/US_Syv/syv.sh b/modules/assim.sequential/inst/NEFI/US_Syv/syv.sh new file mode 100755 index 00000000000..9484e1eb846 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Syv/syv.sh @@ -0,0 +1,147 @@ + + + + + -1 + + 2020/03/10 13:06:23 +0000 + + /fs/data3/kzarada/NEFI/US_Potato/output/PEcAn_1000012660/ + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + FALSE + + /fs/data3/kzarada/pecan.data/dbfiles + + + + semiarid.grassland + + 1 + + /fs/data3/kzarada/NEFI/US_Potato/output/PEcAn_1000012659//pft/semiarid.grassland + 1000018772 + + + + 3000 + + FALSE + TRUE + + 1.2 + AUTO + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + parameters + + + soil + + + NA + + + 1000000030 + SIPNET + 102319 + FALSE + /fs/data5/pecan.models/SIPNET/1023/sipnet + + + 1000012660 + + + + 1000026756 + 2020-02-25 + 2020-03-24 + POTATO + 44.1394 + -89.5727 + + + + NOAA_GEFS_downscale + SIPNET + + 1000115354 + 1000115355 + 1000115356 + 1000115357 + 1000115358 + 1000115359 + 1000115360 + 1000115361 + 1000115362 + 1000115363 + 1000115364 + 1000115365 + 1000115366 + 1000115367 + 1000115368 + 1000115369 + 1000115370 + 1000115371 + 1000115372 + 1000115373 + 1000115374 + + + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_1/NOAA_GEFS_downscale.POTATO.1.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_2/NOAA_GEFS_downscale.POTATO.2.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_3/NOAA_GEFS_downscale.POTATO.3.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_4/NOAA_GEFS_downscale.POTATO.4.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_5/NOAA_GEFS_downscale.POTATO.5.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_6/NOAA_GEFS_downscale.POTATO.6.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_7/NOAA_GEFS_downscale.POTATO.7.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_8/NOAA_GEFS_downscale.POTATO.8.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_9/NOAA_GEFS_downscale.POTATO.9.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_10/NOAA_GEFS_downscale.POTATO.10.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_11/NOAA_GEFS_downscale.POTATO.11.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_12/NOAA_GEFS_downscale.POTATO.12.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_13/NOAA_GEFS_downscale.POTATO.13.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_14/NOAA_GEFS_downscale.POTATO.14.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_15/NOAA_GEFS_downscale.POTATO.15.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_16/NOAA_GEFS_downscale.POTATO.16.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_17/NOAA_GEFS_downscale.POTATO.17.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_18/NOAA_GEFS_downscale.POTATO.18.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_19/NOAA_GEFS_downscale.POTATO.19.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_20/NOAA_GEFS_downscale.POTATO.20.2020-03-10T00:00.2020-03-26T00:00.clim + /fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_SIPNET_site_1-26756_21/NOAA_GEFS_downscale.POTATO.21.2020-03-10T00:00.2020-03-26T00:00.clim + + + + 2020-03-08 + 2020-03-24 + + + localhost + /fs/data3/kzarada/NEFI/US_Potato/output/PEcAn_1000012659//run + /fs/data3/kzarada/NEFI/US_Potato/output/PEcAn_1000012659//out + + + TRUE + TRUE + TRUE + + /fs/data3/kzarada/NEFI/US_Potato/output/PEcAn_1000012659//run + /fs/data3/kzarada/NEFI/US_Potato/output/PEcAn_1000012659//out + diff --git a/modules/assim.sequential/inst/NEFI/US_Syv/syv.xml b/modules/assim.sequential/inst/NEFI/US_Syv/syv.xml new file mode 100755 index 00000000000..9fc0eb7faa6 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_Syv/syv.xml @@ -0,0 +1,78 @@ + + + + + -1 + + 2020/03/10 13:18:24 +0000 + + /fs/data3/kzarada/NEFI/US_Syv/output/PEcAn_1000012661/ + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + false + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.coniferous + + 1 + + + + + 3000 + FALSE + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + + + 1000012661 + + + + 622 + 2020-02-25 + 2020-03-24 + + + + NOAA_GEFS_downscale + SIPNET + + + 2020-03-08 + 2020-03-24 + + + localhost + + diff --git a/modules/assim.sequential/inst/NEFI/US_WCr/download_WCr.R b/modules/assim.sequential/inst/NEFI/US_WCr/download_WCr.R new file mode 100644 index 00000000000..ddb3ec75e11 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WCr/download_WCr.R @@ -0,0 +1,55 @@ +download_US_WCr <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/wcreek/flux/prelim/wcreek" + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "_flux.txt"), + sep = "", + header = FALSE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + if(dim(raw.data)[1] > 0 & dim(raw.data)[2] > 0){ + #Constructing the date based on the columns we have + raw.data$date <-as.POSIXct(paste0(raw.data$V1,"/",raw.data$V2,"/",raw.data$V3," ", raw.data$V4 %>% as.integer(), ":",(raw.data$V4-as.integer(raw.data$V4))*60), + format="%Y/%m/%d %H:%M", tz="UTC") + + raw.data <- raw.data %>% dplyr::select(date, V9, V10) %>% + filter(date >= start_date & date <=end_date) %>% + na_if( -999) %>% + mutate(V9 = PEcAn.utils::misc.convert(V9, "umol C m-2 s-1", "kg C m-2 s-1") ) + colnames(raw.data) <- c("Time", "NEE", "LE") + }else(raw.data = NULL) #end if statment + # Some cleaning and filtering + #raw.data <- raw.data %>% + # select(-V5, -V6) %>% + # filter(date <=end_date) + + #Colnames changed + + return(raw.data) +} +# start_date <- as.Date("2017-01-01") +# end_date <- as.Date("2018-10-01") +# +# download_US_WCr(start_date, end_date) ->pp +# +# tail(pp) \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_WCr/download_WCr_met.R b/modules/assim.sequential/inst/NEFI/US_WCr/download_WCr_met.R new file mode 100644 index 00000000000..dc6f3fad9f1 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WCr/download_WCr_met.R @@ -0,0 +1,51 @@ +download_US_WCr_met <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/wcreek/flux/prelim/wcreek" + + + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "_met.txt"), + sep = "", + header = FALSE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + + if(dim(raw.data)[1] > 0 & dim(raw.data)[2] > 0){ + #Constructing the date based on the columns we have + raw.data$date <-as.POSIXct(paste0(raw.data$V1,"/",raw.data$V2,"/",raw.data$V3," ", raw.data$V4 %>% as.integer(), ":",(raw.data$V4-as.integer(raw.data$V4))*60), + format="%Y/%m/%d %H:%M", tz="UTC") + # Some cleaning and filtering + raw.data <- raw.data %>% + dplyr::select(V1,V2,V3,V4,V5, V6, V26, V35, V40, V59, V51, V61, V17, V58, date) %>% + filter(date >= start_date & date <=end_date) + + #Colnames changed + colnames(raw.data) <- c("Year", "Month", "Day", "Hour", "DoY", "FjDay", "Tair", "rH", "Tsoil", "Rg", "P_atm", "LW", "WS" , "Rain", "date") + }else(raw.data = NULL) + return(raw.data) +} +# start_date <- as.Date("2017-01-01") +# end_date <- as.Date("2018-10-01") +# +#download_US_WCr_met(start_date, end_date) ->met +# +# tail(pp) \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_WCr/download_soilmoist_WCr.R b/modules/assim.sequential/inst/NEFI/US_WCr/download_soilmoist_WCr.R new file mode 100644 index 00000000000..6b64599b979 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WCr/download_soilmoist_WCr.R @@ -0,0 +1,52 @@ +download_soilmoist_WCr <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/wcreek/flux/prelim/clean/ameriflux/US-WCr_HH_" + + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "01010000_", syear+1, "01010000.csv"), + sep = ",", + header = TRUE, stringsAsFactors = F + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + #Constructing the date based on the columns we have + if(dim(raw.data)[1] > 0 & dim(raw.data)[2] > 0){ + raw.data$Time <-as.POSIXct(as.character(raw.data$TIMESTAMP_START), + format="%Y%m%d%H%M", tz="UTC") + # Some cleaning and filtering + # SWC origionally has units = % at depths 2_1 = 5cm, 2_2 = 10cm, 2_3 = 20cm, 2_4 = 30cm, 2_5 = 40cm, 2_6 = 50cm + raw.data <- raw.data %>% + dplyr::select(SWC_1_1_1, SWC_1_2_1, SWC_1_3_1, SWC_1_4_1, SWC_1_5_1, SWC_2_1_1, SWC_2_2_1, SWC_2_3_1, SWC_2_4_1, SWC_2_5_1, SWC_2_6_1, Time) %>% + na_if(-9999) %>% + filter(Time >= start_date & Time <=end_date) + + #get average soil moisture + + #with all depths + #raw.data$avgsoil <- raw.data$SWC_2_1_1*.05 + raw.data$SWC_2_2_1*.10 + raw.data$SWC_2_3_1*.20 + raw.data$SWC_2_4_1*.30 + raw.data$SWC_2_5_1*.40 + raw.data$SWC_2_6_1*.50 + + #shallow depths (>30cm) + raw.data$avgsoil2 <- raw.data$SWC_2_1_1 #*.05 + raw.data$SWC_2_2_1*.10 + raw.data$SWC_2_3_1*.20 + raw.data$avgsoil1 <- raw.data$SWC_1_2_1*0.12 + raw.data$SWC_1_3_1*0.16 + raw.data$SWC_1_4_1*0.32 + raw.data$SWC_1_5_1*0.4 #old sensor + raw.data <- raw.data %>% dplyr::select(Time, avgsoil1, avgsoil2) + }else(raw.data <- NULL) + return(raw.data) +} diff --git a/modules/assim.sequential/inst/NEFI/gefs.sipnet.source.xml b/modules/assim.sequential/inst/NEFI/US_WCr/gefs.sipnet.source.xml similarity index 100% rename from modules/assim.sequential/inst/NEFI/gefs.sipnet.source.xml rename to modules/assim.sequential/inst/NEFI/US_WCr/gefs.sipnet.source.xml diff --git a/modules/assim.sequential/inst/NEFI/US_WCr/wcr.sh b/modules/assim.sequential/inst/NEFI/US_WCr/wcr.sh new file mode 100755 index 00000000000..994492f91e7 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WCr/wcr.sh @@ -0,0 +1,30 @@ +# This script first runs a program which sets up the xml file for a current +# NOAA_GEFS PEcAn run, then runs PEcAn with that file. +# @author Luke Dramko + +# REPLACE < username > WITH YOUR USERNAME +# If running from a CRON job, these paths MUST be absolute paths. This is because CRON assumes that the directory it is in is the working directory. +xmlfile="/fs/data3/kzarada/NEFI/US_WCr/wcr.xml" #Path to, and name of, the base xml file. +workflow_path="/fs/data3/kzarada/pecan/web/" #Path to workflow.R (in pecan/web for the standard version or pecan/scripts for the custom version). +output_path="/fs/data3/kzarada/output/" #Path to the directory where all PEcAn output is put. +xmlscript="/fs/data3/kzarada/NEFI/NEFI_tools/pecan_scripts/generate.gefs.xml.R" #Path to, and name of, the script that modifies the xml. +# Could also be just workflow.R in pecan/web +workflow_name="workflow.R" #"workflow.wcr.assim.R" #Name of the workflow.R version + +# Generates the xml file based on a given input file. Overwrites the +# input file. +Rscript $xmlscript $xmlfile $1 &> /dev/null +if [ $? -eq 11 ]; +then +echo "xml file not found." +elif [ $? -eq 12 ] +then +echo "Database connection failed." +else + # Find the most recently created output directory. This system is kind of hack-y, and is messed up if anything after + # "PEcAn", alphabetically, is put in the directory. Fortunately, that is unlikely to happen. + output_dir=$(ls $output_path | sort -V | grep "PEcAn_" | tail -n 1) +# Runs the PEcAn workflow. +Rscript ${workflow_path}${workflow_name} $xmlfile &> ${output_path}/${output_dir}/workflow.log.txt +echo "Workflow completed." +fi \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_WCr/wcr.xml b/modules/assim.sequential/inst/NEFI/US_WCr/wcr.xml new file mode 100644 index 00000000000..a8a6c966e9b --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WCr/wcr.xml @@ -0,0 +1,79 @@ + + + + + -1 + + 2020/07/06 04:00:02 +0000 + + /fs/data3/kzarada/output/PEcAn_1000013659/ + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + false + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.deciduous.ALL + + 1 + + 1000012409 + + + + 3000 + FALSE + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + + + 1000013659 + + + + 676 + 2020-06-24 + 2020-07-22 + + + + NOAA_GEFS_downscale + SIPNET + + + 2020-07-06 + 2020-07-22 + + + localhost + + diff --git a/modules/assim.sequential/inst/NEFI/US_WLEF/download_WLEF.R b/modules/assim.sequential/inst/NEFI/US_WLEF/download_WLEF.R new file mode 100644 index 00000000000..1633e04cf7c --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WLEF/download_WLEF.R @@ -0,0 +1,54 @@ +download_US_WLEF <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/wlef/flux/prelim/" + + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "/flux_", syear, ".txt"), + sep = "", + header = TRUE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + #Constructing the date based on the columns we have + raw.data$date <-as.POSIXct(paste0(raw.data$Year,"/",raw.data$MO,"/",raw.data$DD," ", raw.data$HH), + format="%Y/%m/%d %H", tz="UTC") + + raw.data <- raw.data %>% dplyr::select(date, NEE_122, LE_122) %>% + filter(date >= start_date & date <=end_date) %>% + na_if( -999) %>% + mutate(NEE_122 = PEcAn.utils::misc.convert(NEE_122, "umol C m-2 s-1", "kg C m-2 s-1")) + + colnames(raw.data) <- c("Time", "NEE", "LE") + # Some cleaning and filtering + #raw.data <- raw.data %>% + # select(-V5, -V6) %>% + # filter(date <=end_date) + + #Colnames changed + + return(raw.data) +} +# start_date <- as.Date("2017-01-01") +# end_date <- as.Date("2018-10-01") +# +# download_US_WCr(start_date, end_date) ->pp +# +# tail(pp) \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_WLEF/download_WLEF_met.R b/modules/assim.sequential/inst/NEFI/US_WLEF/download_WLEF_met.R new file mode 100644 index 00000000000..d7aa10548ca --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WLEF/download_WLEF_met.R @@ -0,0 +1,43 @@ +download_US_WLEF_met <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/wlef/flux/prelim/" + + + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "/met_", syear, ".txt"), + sep = "", + header = TRUE + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + #Constructing the date based on the columns we have + raw.data$date <-as.POSIXct(paste0(raw.data$Year,"/",raw.data$MO,"/",raw.data$DD," ", raw.data$HH), + format="%Y/%m/%d %H", tz="UTC") + + # Some cleaning and filtering + raw.data <- raw.data %>% + dplyr::select(Year,MO,DD,HH,DOY, fDOY, T122, RH122, Patm, Precip, PAR, date) %>% + filter(date >= start_date & date <=end_date) + + colnames(raw.data) <- c("Year", "Month", "Day", "Hour", "DOY", "FjDay", "Tair", "rH", "P_atm", "Rain", "PAR", "date") + + return(raw.data) +} \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_WLEF/download_soilmoist_WLEF.R b/modules/assim.sequential/inst/NEFI/US_WLEF/download_soilmoist_WLEF.R new file mode 100644 index 00000000000..d52daa6a8b1 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WLEF/download_soilmoist_WLEF.R @@ -0,0 +1,40 @@ +download_soilmoist_WLEF <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/wlef/flux/prelim/clean/ameriflux/US-PFa_HR_" + + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "01010000_", syear+1, "01010000.csv"), + sep = ",", + header = TRUE, stringsAsFactors = F + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + #Constructing the date based on the columns we have + raw.data$Time <-as.POSIXct(as.character(raw.data$TIMESTAMP_START), + format="%Y%m%d%H%M", tz="UTC") + # Some cleaning and filtering + raw.data <- raw.data %>% + dplyr::select(SWC_1_1_1, Time) %>% + na_if(-9999) %>% + filter(Time >= start_date & Time <=end_date) + colnames(raw.data) <- c('avgsoil', 'Time') + return(raw.data) +} diff --git a/modules/assim.sequential/inst/NEFI/US_WLEF/wlef.sh b/modules/assim.sequential/inst/NEFI/US_WLEF/wlef.sh new file mode 100755 index 00000000000..c0c9035bf93 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WLEF/wlef.sh @@ -0,0 +1,30 @@ +# This script first runs a program which sets up the xml file for a current +# NOAA_GEFS PEcAn run, then runs PEcAn with that file. +# @author Luke Dramko + +# REPLACE < username > WITH YOUR USERNAME +# If running from a CRON job, these paths MUST be absolute paths. This is because CRON assumes that the directory it is in is the working directory. +xmlfile="/fs/data3/kzarada/NEFI/US_WLEF/wlef.xml" #Path to, and name of, the base xml file. +workflow_path="/fs/data3/kzarada/pecan/web/" #Path to workflow.R (in pecan/web for the standard version or pecan/scripts for the custom version). +output_path="/fs/data3/kzarada/NEFI/US_WLEF/output" #Path to the directory where all PEcAn output is put. +xmlscript="/fs/data3/kzarada/NEFI/NEFI_tools/pecan_scripts/generate.gefs.xml.R" #Path to, and name of, the script that modifies the xml. +# Could also be just workflow.R in pecan/web +workflow_name="workflow.R" #"workflow.wcr.assim.R" #Name of the workflow.R version + +# Generates the xml file based on a given input file. Overwrites the +# input file. +Rscript $xmlscript $xmlfile $1 &> /dev/null +if [ $? -eq 11 ]; +then +echo "xml file not found." +elif [ $? -eq 12 ] +then +echo "Database connection failed." +else + # Find the most recently created output directory. This system is kind of hack-y, and is messed up if anything after + # "PEcAn", alphabetically, is put in the directory. Fortunately, that is unlikely to happen. + output_dir=$(ls $output_path | sort -V | tail -n 1) +# Runs the PEcAn workflow. +Rscript ${workflow_path}${workflow_name} $xmlfile &> ${output_path}/${output_dir}/workflow.log.txt +echo "Workflow completed." +fi \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/US_WLEF/wlef.xml b/modules/assim.sequential/inst/NEFI/US_WLEF/wlef.xml new file mode 100755 index 00000000000..aaf00dea751 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/US_WLEF/wlef.xml @@ -0,0 +1,91 @@ + + + + + 1000007443 + kzarada + 2020/03/19 04:15:03 +0000 + + /fs/data3/kzarada/NEFI/US_WLEF/output/PEcAn_1000012744/ + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + false + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.deciduous + + 1 + + + + + 3000 + + FALSE + FALSE + + 1.2 + AUTO + + + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + parameters + + + soil + + + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + SIPNET + unk + FALSE + /fs/data5/pecan.models/sipnet_unk/sipnet + + + 1000012744 + + + + 678 + 2020-03-07 + 2020-04-04 + + + + NOAA_GEFS_downscale + SIPNET + + + 2020-03-19 + 2020-04-04 + + + localhost + + diff --git a/modules/assim.sequential/inst/NEFI/automatic_graphs.sh b/modules/assim.sequential/inst/NEFI/automatic_graphs.sh new file mode 100755 index 00000000000..32951d72601 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/automatic_graphs.sh @@ -0,0 +1,4 @@ +Rscript -e "rmarkdown::render('/fs/data3/kzarada/NEFI/Willow_Creek/index.Rmd')" +Rscript "/fs/data3/kzarada/NEFI/Willow_Creek/email.R" +Rscript "/fs/data3/kzarada/NEFI/graph_fluxtowers.R" +Rscript "/fs/data3/kzarada/NEFI/graph_SDA_fluxtowers.R" \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/dbscripts/README.txt b/modules/assim.sequential/inst/NEFI/dbscripts/README.txt deleted file mode 100644 index 80e1a3f436b..00000000000 --- a/modules/assim.sequential/inst/NEFI/dbscripts/README.txt +++ /dev/null @@ -1,22 +0,0 @@ -These database scripts help identify and modify the state of the BETY database. -Working with NOAA_GEFS data produces a lot of database files and IDs, so -this is a nicer way to interact with them all at once, rather than through -the web interface. - --- dbsetup.R -- -Sets up the connection to the database for running interactively in the consonle -sourcing this script produces a PostgreSQL connection object named con, which -can be passed to any of the PEcAn.DB functions. Remember to close the connection -when you're done with it. - --- dbclean.R -- -Completely wipes the database of all NOAA_GEFS data at site 676 (Willow Creek) -The script will print out all of the files it wants to wipe first, and exit. -Run with the command line argument TRUE in order to clear files. - --- dbSelectRemove.R -- -dbSelectRemove is a more conservative version of dbclean. It removes only dbfiles -and input files from a given day, provided as a command line argument. By default, -it will then print each file and exit; run with TRUE as a second command line a -rgument to delete the files. dbSelectRemove.R doesn NOT remove input/dbfiles -for raw data, only for gapfilled and model-converted data. diff --git a/modules/assim.sequential/inst/NEFI/dbscripts/dbSelectRemove.R b/modules/assim.sequential/inst/NEFI/dbscripts/dbSelectRemove.R deleted file mode 100644 index 57c68a9acf4..00000000000 --- a/modules/assim.sequential/inst/NEFI/dbscripts/dbSelectRemove.R +++ /dev/null @@ -1,83 +0,0 @@ -# Removes all references of the given date from the database - -library("dplyr") - -args <- commandArgs(trailingOnly = TRUE) - -len = length(args) -args_idx = 1 - -# Defaults -pattern <- "NOAA_GEFS" -delete <- FALSE - -if (len > 0) { - start_date <- args[1] -} else { - print("Please enter a date to search for.") - quit("no") -} - -if (len > 1 && args[2] == "TRUE") { - delete <- TRUE -} - -## Open Connection -bety <- dplyr::src_postgres(dbname = 'bety', - host = 'psql-pecan.bu.edu', - user = 'bety', - password = 'bety') - -con <- bety$con -##List All tables -# src_tbls(bety) - -inputs = PEcAn.DB::db.query(paste0("SELECT * FROM inputs WHERE site_id=676 AND start_date='", start_date, - "' AND name='NOAA_GEFS_SIPNET_site_0-676'"), con = con) -inputs = rbind(inputs, PEcAn.DB::db.query(paste0("SELECT * FROM inputs WHERE site_id=676 AND start_date='",start_date, - "' AND name LIKE 'NOAA_GEFS__'"), con)) - -inputs = rbind(inputs, PEcAn.DB::db.query(paste0("SELECT * FROM inputs WHERE site_id=676 AND start_date='",start_date, - "' AND name LIKE 'NOAA_GEFS___'"), con)) - -print("-------------- All matching files ----------------") -print(inputs) -print("--------------------------------------------------") - -inputs <- inputs[grepl(pattern, inputs$name),] -print("@@@---------- Files to be Deleted -----------@@@") -print(inputs) -print("@@@------------------------------------------@@@") - -if (!delete) { - print("Run with TRUE as the second command line argument to delete files.") - quit("no") -} - -for (i in 1:nrow(inputs)) { - print(paste0("i = ", i)) - print(inputs[i,]) - print("id") - print(inputs[i,]$id) - - hostname = PEcAn.remote::fqdn() - print(paste0("hostname = ", hostname)) - - dbfile <- PEcAn.DB::dbfile.check(type = 'Input', container.id = inputs[i,]$id, con = con, hostname = hostname, machine.check = TRUE) - - print("dbfile") - print(dbfile) - - if (!is.null(dbfile$id)) { - PEcAn.DB::db.query(query =paste0("DELETE FROM dbfiles where id =", dbfile$id), - con) - - print(paste0("dbfile ", dbfile$id ," removed.")) - } - - PEcAn.DB::db.query(query =paste0("DELETE FROM inputs where id =", inputs[i,]$id), - con) - print(paste0("inputfile ", inputs[i,]$id ," removed.")) -} - -PEcAn.DB::db.close(con) \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/dbscripts/dbclean.R b/modules/assim.sequential/inst/NEFI/dbscripts/dbclean.R deleted file mode 100644 index 81466350be7..00000000000 --- a/modules/assim.sequential/inst/NEFI/dbscripts/dbclean.R +++ /dev/null @@ -1,79 +0,0 @@ -# Database scrubbing script. Destroys all input and associated dbfile entries with NOAA_GEFS in the file name. -# @author Luke Dramko - -library("dplyr") - -args <- commandArgs(trailingOnly = TRUE) - -len = length(args) -args_idx = 1 - -# Defaults -pattern <- "NOAA_GEFS" -delete <- FALSE - -# Process command line arguments -if (len >= 3 && args[args_idx] == "-P") { - args_idx = args_idx + 1 - pattern = args[args_idx] - args_idx = args_idx + 1 -} -if (len >= 1 && args[args_idx] == "TRUE") { - delete <- TRUE -} - -## Open Connection -bety <- dplyr::src_postgres(dbname = 'bety', - host = 'psql-pecan.bu.edu', - user = 'bety', - password = 'bety') - -con <- bety$con -##List All tables -src_tbls(bety) - -inputs = PEcAn.DB::db.query("SELECT * FROM inputs WHERE site_id=676", con = con) - -print("-------------- All matching files ----------------") -print(inputs) -print("--------------------------------------------------") - -inputs <- inputs[grepl(pattern, inputs$name),] -print("@@@---------- Files to be Deleted -----------@@@") -print(inputs) -print("@@@------------------------------------------@@@") - -if (delete) { - print("Moving on to delete files.") -} else { - print("Quitting (default behavior). Run with 'TRUE' as a command line argument to delete files.") - quit("no") ### Remove to run. This is a safety feature. -} - -for (i in 1:nrow(inputs)) { - print(paste0("i = ", i)) - print(inputs[i,]) - print("id") - print(inputs[i,]$id) - - hostname = PEcAn.remote::fqdn() - print(paste0("hostname = ", hostname)) - - dbfile <- PEcAn.DB::dbfile.check(type = 'Input', container.id = inputs[i,]$id, con = con, hostname = hostname, machine.check = TRUE) - - print("dbfile") - print(dbfile) - - if (!is.null(dbfile$id)) { - PEcAn.DB::db.query(query =paste0("DELETE FROM dbfiles where id =", dbfile$id), - con) - - print(paste0("dbfile ", dbfile$id ," removed.")) - } - - PEcAn.DB::db.query(query =paste0("DELETE FROM inputs where id =", inputs[i,]$id), - con) - print(paste0("inputfile ", inputs[i,]$id ," removed.")) -} - -PEcAn.DB::db.close(con) \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/dbscripts/dbsetup.R b/modules/assim.sequential/inst/NEFI/dbscripts/dbsetup.R deleted file mode 100644 index 1ae7590355e..00000000000 --- a/modules/assim.sequential/inst/NEFI/dbscripts/dbsetup.R +++ /dev/null @@ -1,17 +0,0 @@ -# Creates a database connection to BETY. Useful for working in the console. - -dbparms = list() -dbparms$dbname = "bety" -dbparms$host = "128.197.168.114" -dbparms$user = "bety" -dbparms$password = "bety" - - -#-------------------------------------------------- -#Connection code copied and pasted from met.process -bety <- dplyr::src_postgres(dbname = dbparms$dbname, - host = dbparms$host, - user = dbparms$user, - password = dbparms$password) - -con <- bety$con #Connection to the database. dplyr returns a list. diff --git a/modules/assim.sequential/inst/NEFI/forecast.graphs.R b/modules/assim.sequential/inst/NEFI/forecast.graphs.R new file mode 100644 index 00000000000..2e4b1203567 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/forecast.graphs.R @@ -0,0 +1,196 @@ +#### need to create a graph funciton here to call with the args of start time + +forecast.graphs <- function(args){ + start_date <- tryCatch(as.POSIXct(args[1]), error = function(e) {NULL} ) + if (is.null(start_date)) { + in_wid <- as.integer(args[1]) + } + dbparms = list() + dbparms$dbname = "bety" + dbparms$host = "128.197.168.114" + dbparms$user = "bety" + dbparms$password = "bety" + #Connection code copied and pasted from met.process + bety <- dplyr::src_postgres(dbname = dbparms$dbname, + host = dbparms$host, + user = dbparms$user, + password = dbparms$password) + con <- bety$con #Connection to the database. dplyr returns a list. + # Identify the workflow with the proper information + if (!is.null(start_date)) { + workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE start_date='", format(start_date, "%Y-%m-%d %H:%M:%S"), + "' ORDER BY id"), con) + } else { + workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE id='", in_wid, "'"), con) + } + print(workflows) + + workflows <- workflows[which(workflows$site_id == args[3]),] + + if (nrow(workflows) > 1) { + workflow <- workflows[1,] + } else { + workflow <- workflows + } + + + print(paste0("Using workflow ", workflow$id)) + wid <- workflow$id + outdir <- args[4] + pecan_out_dir <- paste0(outdir, "PEcAn_", wid, "/out"); + pecan_out_dirs <- list.dirs(path = pecan_out_dir) + if (is.na(pecan_out_dirs[1])) { + print(paste0(pecan_out_dirs, " does not exist.")) + } + + + #neemat <- matrix(1:64, nrow=1, ncol=64) # Proxy row, will be deleted later. + #qlemat <- matrix(1:64, nrow=1, ncol=64)# Proxy row, will be deleted later. + + neemat <- vector() + qlemat <- vector() + soilmoist <- vector() + time <- vector() + + num_results <- 0; + for (i in 2:length(pecan_out_dirs)) { + #datafile <- file.path(pecan_out_dirs[i], format(workflow$start_date, "%Y.nc")) + datafiles <- list.files(pecan_out_dirs[i]) + datafiles <- datafiles[grep("*.nc$", datafiles)] + + if (length(datafiles) == 0) { + print(paste0("File ", pecan_out_dirs[i], " does not exist.")) + next + } + + if(length(datafiles) == 1){ + + file = paste0(pecan_out_dirs[i],'/', datafiles[1]) + + num_results <- num_results + 1 + + #open netcdf file + ncptr <- ncdf4::nc_open(file); + + # Attach data to matricies + nee <- ncdf4::ncvar_get(ncptr, "NEE") + if(i == 2){ neemat <- nee} else{neemat <- cbind(neemat,nee)} + + qle <- ncdf4::ncvar_get(ncptr, "Qle") + if(i == 2){ qlemat <- qle} else{qlemat <- cbind(qlemat,qle)} + + soil <- ncdf4::ncvar_get(ncptr, "SoilMoistFrac") + if(i == 2){ soilmoist <- soil} else{soilmoist <- cbind(soilmoist,soil)} + + sec <- ncptr$dim$time$vals + origin <- strsplit(ncptr$dim$time$units, " ")[[1]][3] + + # Close netcdf file + ncdf4::nc_close(ncptr) + } + + if(length(datafiles) > 1){ + + + file = paste0(pecan_out_dirs[i],'/', datafiles[1]) + file2 = paste0(pecan_out_dirs[i],'/', datafiles[2]) + + num_results <- num_results + 1 + + #open netcdf file + ncptr1 <- ncdf4::nc_open(file); + ncptr2 <- ncdf4::nc_open(file2); + # Attach data to matricies + nee1 <- ncdf4::ncvar_get(ncptr1, "NEE") + nee2 <- ncdf4::ncvar_get(ncptr2, "NEE") + nee <- c(nee1, nee2) + if(i == 2){ neemat <- nee} else{neemat <- cbind(neemat,nee)} + + qle1 <- ncdf4::ncvar_get(ncptr1, "Qle") + qle2 <- ncdf4::ncvar_get(ncptr2, "Qle") + qle <- c(qle1, qle2) + + if(i == 2){ qlemat <- qle} else{qlemat <- cbind(qlemat,qle)} + + soil1 <- ncdf4::ncvar_get(ncptr1, "SoilMoistFrac") + soil2 <- ncdf4::ncvar_get(ncptr2, "SoilMoistFrac") + soil <- c(soil1, soil2) + if(i == 2){ soilmoist <- soil} else{soilmoist <- cbind(soilmoist,soil)} + + + sec <- c(ncptr1$dim$time$vals, ncptr2$dim$time$vals+ last(ncptr1$dim$time$vals)) + origin <- strsplit(ncptr1$dim$time$units, " ")[[1]][3] + + + # Close netcdf file + ncdf4::nc_close(ncptr1) + ncdf4::nc_close(ncptr2) + + } + + } + + if (num_results == 0) { + print("No results found.") + quit("no") + } else { + print(paste0(num_results, " results found.")) + } + + # Time + time <- seq(1, length.out= length(sec)) + + + # Caluclate means + neemins <- NULL + neemaxes <- NULL + quantiles <- apply(neemat,1,quantile,c(0.025,0.5,0.975), na.rm=TRUE) + neelower95 <- quantiles[1,] + neemeans <- quantiles[2,] + neeupper95 <- quantiles[3,] + needf <- data.frame(time = time, Lower = neelower95, Predicted = neemeans, Upper = neeupper95) + needf$date <- as.Date(sec, origin = origin) + #$needf$Time <- c(6,12,18, rep(c(0,6,12,18),length.out = (length(needf$date) - 3))) + needf$start_date <- rep(start_date, each = length(sec)) + needf$Time <- round(abs(sec - floor(sec)) * 24) + + + + + quantiles <- apply(qlemat,1,quantile,c(0.025,0.5,0.975), na.rm=TRUE) + qlelower95 <- quantiles[1,] + qlemeans <- quantiles[2,] + qleupper95 <- quantiles[3,] + qledf <- data.frame(time = time, Lower = qlelower95, Predicted = qlemeans, Upper = qleupper95) + qledf$date <- as.Date(sec, origin = origin) + #qledf$Time <- c(6,12,18, rep(c(0,6,12,18),length.out = (length(qledf$date) - 3))) + qledf$start_date <- rep(start_date, each = length(sec)) + qledf$Time <- round(abs(sec - floor(sec)) * 24) + + + #soil moisture + soilmins <- NULL + soilmaxes <- NULL + quantiles <- apply(soilmoist,1,quantile,c(0.025,0.5,0.975), na.rm=TRUE) + soillower95 <- quantiles[1,] + soilmeans <- quantiles[2,] + soilupper95 <- quantiles[3,] + soildf <- data.frame(time = time, Lower = soillower95, Predicted = soilmeans, Upper = soilupper95) + soildf$date <- as.Date(sec, origin = origin) + #$needf$Time <- c(6,12,18, rep(c(0,6,12,18),length.out = (length(needf$date) - 3))) + soildf$start_date <- rep(start_date, each = length(sec)) + soildf$Time <- round(abs(sec - floor(sec)) * 24) + + + + if(args[2] == "NEE"){ + return(needf)} + if(args[2]== "LE"){ + return(qledf)} + else(return(soildf)) + + PEcAn.DB::db.close(con) +} + + + diff --git a/modules/assim.sequential/inst/NEFI/graph_SDA_fluxtowers.R b/modules/assim.sequential/inst/NEFI/graph_SDA_fluxtowers.R new file mode 100644 index 00000000000..a173ba6a733 --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/graph_SDA_fluxtowers.R @@ -0,0 +1,317 @@ + +#setwd('/fs/data3/kzarada/NEFI/Willow_Creek') +library("ggplot2") +library("plotly") +library("gganimate") +library("tidyverse") +library('PEcAn.all') +library("RCurl") +source("/fs/data3/kzarada/NEFI/sda.graphs.R") +#source("/fs/data3/kzarada/NEFI/Willow_Creek/download_WCr_met.R") + + +#WCR +WCR.num.SDA = 676 +WCR.abv.SDA = "WCr" +WCR.outdir.SDA = '/fs/data3/kzarada/ouput/' +WCR.db.num.SDA = "0-676" + + +sda.tower.graphs <- function(site.num, site.abv, outdir, db.num){ + + + ### Site numbers ### + # WCr = 676 + # Syv = 622 + # Wlef = 678 + # Los = 679 + frame_end = Sys.Date() + lubridate::days(16) + frame_start = Sys.Date() - lubridate::days(10) + + ftime = seq(as.Date(frame_start), as.Date(frame_end), by="days") + ctime = seq(as.Date(frame_start), Sys.Date(), by = "days") - lubridate::days(4) + vars = c("NEE", "LE", "soil") + + for(j in 1:length(vars)){ + + + for(i in 1:length(ctime)){ + + args = c(as.character(ctime[i]), vars[j], site.num, outdir) + + assign(paste0(ctime[i], "_", vars[j]), sda.graphs(args)) + + } + } + NEE.index <- ls(pattern = paste0("_NEE"), envir=environment()) + LE.index <- ls(pattern = paste0("_LE"), envir=environment()) + soil.index <- ls(pattern = paste0("_soil"), envir=environment()) + + + nee.data = get(NEE.index[1]) + for(i in 2:length(NEE.index)){ + + nee.data = rbind(nee.data, get(NEE.index[i])) + } + + le.data = get(LE.index[1]) + for(i in 2:length(LE.index)){ + + le.data = rbind(le.data, get(LE.index[i])) + } + + soil.data = get(soil.index[1]) + for(i in 2:length(LE.index)){ + + soil.data = rbind(soil.data, get(soil.index[i])) + } + + nee.data$Time <- as.POSIXct(paste(nee.data$date, nee.data$Time, sep = " "), format = "%Y-%m-%d %H") + nee.data$Time <- lubridate::force_tz(nee.data$Time, "UTC") + nee.data$start_date <- as.factor(nee.data$start_date) + + le.data$Time <- as.POSIXct(paste(le.data$date, le.data$Time, sep = " "), format = "%Y-%m-%d %H") + le.data$Time <- lubridate::force_tz(le.data$Time, "UTC") + le.data$start_date <- as.factor(le.data$start_date) + + soil.data$Time <- as.POSIXct(paste(soil.data$date, soil.data$Time, sep = " "), format = "%Y-%m-%d %H") + soil.data$Time <- lubridate::force_tz(soil.data$Time, "UTC") + soil.data$start_date <- as.factor(soil.data$start_date) + + Time = seq(from = head(unique(nee.data$date), 1), to = tail(unique(nee.data$date), 1), by = 1) + #Download observed data + source(paste0('/fs/data3/kzarada/NEFI/US_', site.abv,"/download_", site.abv, ".R")) + real_data <- do.call(paste0("download_US_", site.abv), list(Time[1], last(Time))) + real_data$Time = lubridate::with_tz(as.POSIXct(real_data$Time, format = "%Y-%m-%d %H:%M:%S", tz = "UTC"), "UTC") + + + + #Time1 <- lubridate::with_tz(seq(from = as.POSIXct(frame_start, tz = "UTC"), to = as.POSIXct(frame_end, tz = "UTC"), by ="hour"), "UTC") + #Time1 <- Time1[-1] #first time isn't included + + #combine observed with predicted data + real_data_nee <- as_tibble(real_data %>% dplyr::select(Time, NEE)) + real_data_le <- as_tibble(real_data %>% dplyr::select(Time, LE)) + + nee.data <- left_join(as_tibble(nee.data), real_data_nee, by = c("Time"), suffix = c("nee", "real")) + le.data <- left_join(as_tibble(le.data), real_data_le, by = c("Time"), suffix = c("le", "real")) + + if(file.exists(paste0('/fs/data3/kzarada/NEFI/US_', site.abv, '/download_soilmoist_', site.abv, '.R'))){ + source(paste0('/fs/data3/kzarada/NEFI/US_', site.abv, '/download_soilmoist_', site.abv, '.R')) + real_soil <- do.call(paste0("download_soilmoist_", site.abv), list(frame_start, frame_end)) + soil.data <- left_join(as_tibble(soil.data), real_soil, by = c("Time"), suffic = c("soil", "real")) + soil.data$avgsoil = soil.data$avgsoil/100 + + Time = lubridate::with_tz(as.POSIXct(Time), tz = "UTC") + x.breaks <- match(Time, nee.data$Time) + x.breaks <- x.breaks[!is.na(x.breaks)] + + s <-ggplot(soil.data, aes(group = start_date, ids = start_date, frame = start_date)) + #, label= LE - Predicted + geom_ribbon(aes(x = Time, ymin=Lower, ymax=Upper, fill="95% Confidence Interval"), alpha = 0.4) + + geom_line(aes(x = Time, y = avgsoil, color = "Observed Data"), size = 1) + + geom_line(aes(x = Time, y = Predicted, color = "Predicted Mean")) + + ggtitle(paste0("Soil Moisture for ", frame_start, " to ", frame_end,", at ", site.abv)) + + scale_color_manual(name = "Legend", labels = c("Predicted Mean", "Observed Data"), values=c("Predicted Mean" = "skyblue1", "Observed Data" = "firebrick4")) + + scale_fill_manual(labels = c("95% Confidence Interval"), values=c("95% Confidence Interval" = "blue1")) + + scale_y_continuous(name="Soil Moisture (%)") + #, limits = c(qle_lower, qle_upper)) + + scale_x_discrete(name = "", breaks = x.breaks, labels = format(Time, "%m-%d")) + + theme_minimal() + + theme(plot.title = element_text(hjust = 0.5, size = 16), legend.title = element_blank(), legend.text = element_text(size = 12), axis.text.x = element_text(size = 12, angle = 45), axis.text.y = element_text(size = 13), axis.title.y = element_text(size = 16)) + + + + ggplot.soil<-ggplotly(s, tooltip = 'all', layerData = 2) %>% + animation_opts(frame = 1200, easing = 'linear-in', transition = 0, redraw = F, mode = "next") %>% + animation_slider(x = 0, y = -0.1, visible = T, currentvalue = list(prefix = "Forecast Date:", font = list(color = 'black'))) %>% + animation_button(x = 0, xanchor = "left", y = 1.5, yanchor= "top") %>% + layout(legend = list(orientation = "h", x = 0.25, y = 1.1)) %>% + layout(showlegend = T, margin = c(30,50,30,50)) + + ggplot.soil$x$data[[1]]$name <-"95% Confidence Interval" + ggplot.soil$x$data[[2]]$name <- "Observed Data" + ggplot.soil$x$data[[3]]$name <- "Predicted Mean" + + soil.data$error = soil.data$avgsoil - soil.data$Predicted + + } else(s = "NA") + + + Time = lubridate::with_tz(as.POSIXct(Time), tz = "UTC") + x.breaks <- match(Time, nee.data$Time) + x.breaks <- x.breaks[!is.na(x.breaks)] + + + # These variables control the start and end dates of the y axis + nee_upper = max(nee.data %>% dplyr::select(Upper, Lower, Predicted, NEE), na.rm = TRUE) + nee_lower = min(nee.data %>% dplyr::select(Upper, Lower, Predicted, NEE), na.rm = TRUE) + + qle_upper = max(le.data %>% dplyr::select(Upper, Predicted, LE) %>% drop_na()) + qle_lower = min(le.data %>% dplyr::select(Lower, Predicted, LE) %>% drop_na()) + + p <-ggplot(nee.data, aes(group = start_date, ids = start_date, frame = start_date)) + + geom_ribbon(aes(x = Time, ymin=Lower, ymax=Upper, fill="95% Confidence Interval"), alpha = 0.4) + + geom_line(aes(x = Time, y = NEE, color = "Observed Data"), size = 1) + + geom_line(aes(x = Time, y = Predicted, color = "Predicted Mean")) + + ggtitle(paste0("Net Ecosystem Exchange for ", frame_start, " to ", frame_end, ", at ", site.abv)) + + scale_color_manual(name = "Legend", labels = c("Predicted Mean", "Observed Data"), values=c("Predicted Mean" = "skyblue1", "Observed Data" = "firebrick4")) + + scale_fill_manual(labels = c("95% Confidence Interval"), values=c("95% Confidence Interval" = "blue1")) + + scale_y_continuous(name="NEE (kg C m-2 s-1)", limits = c(nee_lower, nee_upper)) + + scale_x_discrete(name = "", breaks = x.breaks, labels = format(Time, "%m-%d")) + + theme_minimal() + + theme(plot.title = element_text(hjust = 0.5, size = 16), legend.title = element_blank(), legend.text = element_text(size = 12), axis.text.x = element_text(size = 12, angle = 45), axis.text.y = element_text(size = 13), axis.title.y = element_text(size = 16)) + + q <- ggplot(le.data, aes(group = start_date, ids = start_date, frame = start_date)) + #, label= LE - Predicted + geom_ribbon(aes(x = Time, ymin=Lower, ymax=Upper, fill="95% Confidence Interval"), alpha = 0.4) + + geom_line(aes(x = Time, y = LE, color = "Observed Data"), size = 1) + + geom_line(aes(x = Time, y = Predicted, color = "Predicted Mean")) + + ggtitle(paste0("Latent Energy for ", frame_start, " to ", frame_end, ", at ", site.abv)) + + scale_color_manual(name = "Legend", labels = c("Predicted Mean", "Observed Data"), values=c("Predicted Mean" = "skyblue1", "Observed Data" = "firebrick4")) + + scale_fill_manual(labels = c("95% Confidence Interval"), values=c("95% Confidence Interval" = "blue1")) + + scale_y_continuous(name="LE (W m-2 s-1)") + #, limits = c(qle_lower, qle_upper)) + + scale_x_discrete(name = "", breaks = x.breaks, labels = format(Time, "%m-%d")) + + theme_minimal() + + theme(plot.title = element_text(hjust = 0.5, size = 16), legend.title = element_blank(), legend.text = element_text(size = 12), axis.text.x = element_text(size = 12, angle = 45), axis.text.y = element_text(size = 13), axis.title.y = element_text(size = 16)) + + + + ggplot.nee<-ggplotly(p, tooltip = 'all') %>% + animation_opts(frame = 1200, easing = 'linear-in', transition = 0, redraw = F, mode = "next") %>% + animation_slider(x = 0, y = -0.1, visible = T, currentvalue = list(prefix = "Forecast Date:", font = list(color = 'black'))) %>% + animation_button(x = 0, xanchor = "left", y = 1.5, yanchor= "top") %>% + layout(legend = list(orientation = "h", x = 0.25, y = 1.1)) %>% + layout(showlegend = T, margin = c(30,50,30,50)) + + ggplot.nee$x$data[[1]]$name <-"95% Confidence Interval" + ggplot.nee$x$data[[2]]$name <- "Observed Data" + ggplot.nee$x$data[[3]]$name <- "Predicted Mean" + + + ggplot.le<-ggplotly(q, tooltip = 'all', layerData = 2) %>% + animation_opts(frame = 1200, easing = 'linear-in', transition = 0, redraw = F, mode = "next") %>% + animation_slider(x = 0, y = -0.1, visible = T, currentvalue = list(prefix = "Forecast Date:", font = list(color = 'black'))) %>% + animation_button(x = 0, xanchor = "left", y = 1.5, yanchor= "top") %>% + layout(legend = list(orientation = "h", x = 0.25, y = 1.1)) %>% + layout(showlegend = T, margin = c(30,50,30,50)) + + ggplot.le$x$data[[1]]$name <-"95% Confidence Interval" + ggplot.le$x$data[[2]]$name <- "Observed Data" + ggplot.le$x$data[[3]]$name <- "Predicted Mean" + + + + #for shiny app + if(file.exists(paste0("/fs/data3/kzarada/NEFI/US_", site.abv, "/download_", site.abv,"_met.R"))){ + source(paste0("/fs/data3/kzarada/NEFI/US_", site.abv, "/download_", site.abv,"_met.R")) + met = do.call(paste0("download_US_", site.abv,"_met"), list(frame_start, Sys.Date())) + + if("Tsoil" %in% names(met)){ + met <- as_tibble(met) %>% mutate(Time = as.POSIXct(date)) %>% dplyr::select(Time, Tair,Tsoil, rH) + }else{met <- as_tibble(met) %>% mutate(Time = as.POSIXct(date)) %>% dplyr::select(Time, Tair, rH)} + + nee.met <- nee.data %>% inner_join(met,nee.data, by = c("Time")) + + #Calculate Error + nee.met$error <- (nee.met$NEE - nee.met$Predicted) + } + + nee.data$error = nee.data$NEE - nee.data$Predicted + le.data$error = le.data$LE - le.data$Predicted + + #for met comparison + + library(ncdf4) + forecast.path <- paste0("/fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_site_", db.num, "/") + + forecasted_data <- data.frame() + #### stopping here-- need to make sure that it goes through each dir index and saves and then moves on + dirs <- list.dirs(path = forecast.path) + dir.1 <- dirs[grepl(paste0(".21.", Sys.Date(), "T*"), dirs)] + nc.files = list() + index = list() + dir.index = list() + + index= strsplit(dir.1[1], split = ".21.20")[[1]][2] + dir.index= dirs[grepl(index[1], dirs)] + + + + for(k in 1:21){ + nc.files[k]<- list.files(path = dir.index[k], pattern = '*.nc' ) + } + + forecasted_data <- data.frame() + for(i in 1:21){ + setwd(dir.index[i]) + nc <- nc_open(nc.files[[i]][1]) + sec <- nc$dim$time$vals + sec <- udunits2::ud.convert(sec, unlist(strsplit(nc$dim$time$units, " "))[1], "seconds") + dt <- mean(diff(sec), na.rm=TRUE) + tstep <- round(86400 / dt) + dt <- 86400 / tstep + + + Tair <-ncdf4::ncvar_get(nc, "air_temperature") ## in Kelvin + Tair_C <- udunits2::ud.convert(Tair, "K", "degC") + Qair <-ncdf4::ncvar_get(nc, "specific_humidity") #humidity (kg/kg) + ws <- try(ncdf4::ncvar_get(nc, "wind_speed")) + if (!is.numeric(ws)) { + U <- ncdf4::ncvar_get(nc, "eastward_wind") + V <- ncdf4::ncvar_get(nc, "northward_wind") + ws <- sqrt(U ^ 2 + V ^ 2) + PEcAn.logger::logger.info("wind_speed absent; calculated from eastward_wind and northward_wind") + } + + + Rain <- ncdf4::ncvar_get(nc, "precipitation_flux") + pres <- ncdf4::ncvar_get(nc,'air_pressure') ## in pascal + SW <- ncdf4::ncvar_get(nc, "surface_downwelling_shortwave_flux_in_air") ## in W/m2 + LW <- ncdf4::ncvar_get(nc, "surface_downwelling_longwave_flux_in_air") + RH <- PEcAn.data.atmosphere::qair2rh(Qair, Tair_C, press = 950) + + file.name <- nc.files[[i]][1] + + hour <- strsplit(strsplit(index, split = "T")[[1]][2], split = ".20")[[1]][1] + + start_date <- as.POSIXct(paste0(strsplit(strsplit(nc$dim$time$units, " ")[[1]][3], split = "T")[[1]][1]," ", hour), format = "%Y-%m-%d %H:%M") + sec <- nc$dim$time$vals + + + timestamp <- seq(from = start_date + lubridate::hours(6), by = "6 hour", length.out = length(sec)) + ensemble <- rep(i, times = length(timestamp)) + tmp <- as.data.frame(cbind( + ensemble, + Tair_C, + Qair, + RH, + Rain = Rain * dt, + ws, + SW, + LW + )) + tmp$timestamp <- timestamp + nc_close(nc) + forecasted_data <- rbind(forecasted_data, tmp) + } + + forecasted_data$ensemble = as.factor(forecasted_data$ensemble) + + + + + #Save Rdata for shiny app + save(list = ls(), file = paste0("/srv/shiny-server/Flux_Dashboard/data/", site.abv, ".SDA.RData")) + save(list = ls(), file = paste0("/fs/data3/kzarada/NEFI/", site.abv, ".SDA.RData")) + + + print(ls()) +} + + +sda.tower.graphs(WCR.num.SDA, + WCR.abv.SDA, + WCR.outdir.SDA, + WCR.db.num.SDA) + + + + diff --git a/modules/assim.sequential/inst/NEFI/graph_fluxtowers.R b/modules/assim.sequential/inst/NEFI/graph_fluxtowers.R new file mode 100644 index 00000000000..a531a8dd78d --- /dev/null +++ b/modules/assim.sequential/inst/NEFI/graph_fluxtowers.R @@ -0,0 +1,362 @@ + +#setwd('/fs/data3/kzarada/NEFI/Willow_Creek') +library("ggplot2") +library("plotly") +library("gganimate") +library("tidyverse") +library('PEcAn.all') +library("RCurl") +source("/fs/data3/kzarada/NEFI/Willow_Creek/forecast.graphs.R") +#source("/fs/data3/kzarada/NEFI/Willow_Creek/download_WCr_met.R") + +#WLEF +WLEF.num = 678 +WLEF.abv = "WLEF" +WLEF.outdir = '/fs/data3/kzarada/NEFI/US_WLEF/output/' +WLEF.db.num = "0-678" +#WCR +WCR.num = 676 +WCR.abv = "WCr" +WCR.outdir = '/fs/data3/kzarada/output/' +WCR.db.num = "0-676" +#Potato +Potato.num = 1000026756 +Potato.abv = 'Potato' +Potato.outdir = '/fs/data3/kzarada/NEFI/US_Potato/output/' +Potato.db.num = "1-26756" +#Syv +Syv.num = 622 +Syv.abv = "Syv" +Syv.outdir = '/fs/data3/kzarada/NEFI/US_Syv/output/' +Syv.db.num = "0-622" + +#Los +Los.num = 679 +Los.abv = "Los" +Los.outdir = '/fs/data3/kzarada/NEFI/US_Los/output/' +Los.db.num = "0-679" + +#Harvard +Harvard.num = 646 +Harvard.abv = "Harvard" +Harvard.outdir = '/fs/data3/kzarada/NEFI/US_Harvard/output/' +Harvard.db.num = '0-646' + +tower.graphs <- function(site.num, site.abv, outdir, db.num){ + + +### Site numbers ### +# WCr = 676 +# Syv = 622 +# Wlef = 678 +# Los = 679 +frame_end = Sys.Date() + lubridate::days(16) +frame_start = Sys.Date() - lubridate::days(10) + +ftime = seq(as.Date(frame_start), as.Date(frame_end), by="days") +ctime = seq(as.Date(frame_start), Sys.Date(), by = "days") +vars = c("NEE", "LE", "soil") + +for(j in 1:length(vars)){ + + + for(i in 1:length(ctime)){ + + args = c(as.character(ctime[i]), vars[j], site.num, outdir) + + assign(paste0(ctime[i], "_", vars[j]), forecast.graphs(args)) + + } +} +NEE.index <- ls(pattern = paste0("_NEE"), envir=environment()) +LE.index <- ls(pattern = paste0("_LE"), envir=environment()) +soil.index <- ls(pattern = paste0("_soil"), envir=environment()) + + +nee.data = get(NEE.index[1]) +for(i in 2:length(NEE.index)){ + + nee.data = rbind(nee.data, get(NEE.index[i])) +} + +le.data = get(LE.index[1]) +for(i in 2:length(LE.index)){ + + le.data = rbind(le.data, get(LE.index[i])) +} + +soil.data = get(soil.index[1]) +for(i in 2:length(LE.index)){ + + soil.data = rbind(soil.data, get(soil.index[i])) +} + +nee.data$Time <- as.POSIXct(paste(nee.data$date, nee.data$Time, sep = " "), format = "%Y-%m-%d %H") +nee.data$Time <- lubridate::force_tz(nee.data$Time, "UTC") +nee.data$start_date <- as.factor(nee.data$start_date) + +le.data$Time <- as.POSIXct(paste(le.data$date, le.data$Time, sep = " "), format = "%Y-%m-%d %H") +le.data$Time <- lubridate::force_tz(le.data$Time, "UTC") +le.data$start_date <- as.factor(le.data$start_date) + +soil.data$Time <- as.POSIXct(paste(soil.data$date, soil.data$Time, sep = " "), format = "%Y-%m-%d %H") +soil.data$Time <- lubridate::force_tz(soil.data$Time, "UTC") +soil.data$start_date <- as.factor(soil.data$start_date) + + +#Download observed data +source(paste0('/fs/data3/kzarada/NEFI/US_', site.abv,"/download_", site.abv, ".R")) +real_data <- do.call(paste0("download_US_", site.abv), list(frame_start, frame_end)) +real_data$Time = lubridate::with_tz(as.POSIXct(real_data$Time, format = "%Y-%m-%d %H:%M:%S", tz = "UTC"), "UTC") + + + +#Time1 <- lubridate::with_tz(seq(from = as.POSIXct(frame_start, tz = "UTC"), to = as.POSIXct(frame_end, tz = "UTC"), by ="hour"), "UTC") +#Time1 <- Time1[-1] #first time isn't included + +#combine observed with predicted data +real_data_nee <- as_tibble(real_data %>% dplyr::select(Time, NEE)) +real_data_le <- as_tibble(real_data %>% dplyr::select(Time, LE)) + +nee.data <- left_join(as_tibble(nee.data), real_data_nee, by = c("Time"), suffix = c("nee", "real")) +le.data <- left_join(as_tibble(le.data), real_data_le, by = c("Time"), suffix = c("le", "real")) + +# if(file.exists(paste0('/fs/data3/kzarada/NEFI/US_', site.abv, '/download_soilmoist_', site.abv, '.R'))){ +# source(paste0('/fs/data3/kzarada/NEFI/US_', site.abv, '/download_soilmoist_', site.abv, '.R')) +# real_soil <- do.call(paste0("download_soilmoist_", site.abv), list(frame_start, frame_end)) +# soil.data <- left_join(as_tibble(soil.data), real_soil, by = c("Time"), suffic = c("soil", "real")) +# soil.data$avgsoil = soil.data$avgsoil/100 +# +# ftime = lubridate::with_tz(as.POSIXct(ftime), tz = "UTC") +# x.breaks <- match(ftime, nee.data$Time) +# x.breaks <- x.breaks[!is.na(x.breaks)] +# +# s <-ggplot(soil.data, aes(group = start_date, ids = start_date, frame = start_date)) + #, label= LE - Predicted +# geom_ribbon(aes(x = Time, ymin=Lower, ymax=Upper, fill="95% Confidence Interval"), alpha = 0.4) + +# geom_line(aes(x = Time, y = avgsoil, color = "Observed Data"), size = 1) + +# geom_line(aes(x = Time, y = Predicted, color = "Predicted Mean")) + +# ggtitle(paste0("Soil Moisture for ", frame_start, " to ", frame_end,", at ", site.abv)) + +# scale_color_manual(name = "Legend", labels = c("Predicted Mean", "Observed Data"), values=c("Predicted Mean" = "skyblue1", "Observed Data" = "firebrick4")) + +# scale_fill_manual(labels = c("95% Confidence Interval"), values=c("95% Confidence Interval" = "blue1")) + +# scale_y_continuous(name="Soil Moisture (%)") + #, limits = c(qle_lower, qle_upper)) + +# #scale_x_discrete(name = "", breaks = x.breaks, labels = format(ftime[-length(ftime)], "%m-%d")) + +# theme_minimal() + +# theme(plot.title = element_text(hjust = 0.5, size = 16), legend.title = element_blank(), legend.text = element_text(size = 12), axis.text.x = element_text(size = 12, angle = 45), axis.text.y = element_text(size = 13), axis.title.y = element_text(size = 16)) +# +# +# +# ggplot.soil<-ggplotly(s, tooltip = 'all', layerData = 2) %>% +# animation_opts(frame = 1200, easing = 'linear-in', transition = 0, redraw = F, mode = "next") %>% +# animation_slider(x = 0, y = -0.1, visible = T, currentvalue = list(prefix = "Forecast Date:", font = list(color = 'black'))) %>% +# animation_button(x = 0, xanchor = "left", y = 1.5, yanchor= "top") %>% +# layout(legend = list(orientation = "h", x = 0.25, y = 1.1)) %>% +# layout(showlegend = T, margin = c(30,50,30,50)) +# +# ggplot.soil$x$data[[1]]$name <-"95% Confidence Interval" +# ggplot.soil$x$data[[2]]$name <- "Observed Data" +# ggplot.soil$x$data[[3]]$name <- "Predicted Mean" +# +# soil.data$error = soil.data$avgsoil - soil.data$Predicted +# +# } else(s = "NA") + + +ftime = lubridate::with_tz(as.POSIXct(ftime), tz = "UTC") +x.breaks <- match(ftime, nee.data$Time) +x.breaks <- x.breaks[!is.na(x.breaks)] + + +# These variables control the start and end dates of the y axis +nee_upper = max(nee.data %>% dplyr::select(Upper, Lower, Predicted, NEE), na.rm = TRUE) +nee_lower = min(nee.data %>% dplyr::select(Upper, Lower, Predicted, NEE), na.rm = TRUE) + +qle_upper = max(le.data %>% dplyr::select(Upper, Predicted, LE) %>% drop_na()) +qle_lower = min(le.data %>% dplyr::select(Lower, Predicted, LE) %>% drop_na()) + +p <-ggplot(nee.data, aes(group = start_date, ids = start_date, frame = start_date)) + + geom_ribbon(aes(x = Time, ymin=Lower, ymax=Upper, fill="95% Confidence Interval"), alpha = 0.4) + + geom_line(aes(x = Time, y = NEE, color = "Observed Data"), size = 1) + + geom_line(aes(x = Time, y = Predicted, color = "Predicted Mean")) + + ggtitle(paste0("Net Ecosystem Exchange for ", frame_start, " to ", frame_end, ", at ", site.abv)) + + scale_color_manual(name = "Legend", labels = c("Predicted Mean", "Observed Data"), values=c("Predicted Mean" = "skyblue1", "Observed Data" = "firebrick4")) + + scale_fill_manual(labels = c("95% Confidence Interval"), values=c("95% Confidence Interval" = "blue1")) + + scale_y_continuous(name="NEE (kg C m-2 s-1)", limits = c(nee_lower, nee_upper)) + + #scale_x_discrete(name = "", breaks = x.breaks, labels = format(ftime[-length(ftime)], "%m-%d")) + + theme_minimal() + + theme(plot.title = element_text(hjust = 0.5, size = 16), legend.title = element_blank(), legend.text = element_text(size = 12), axis.text.x = element_text(size = 12, angle = 45), axis.text.y = element_text(size = 13), axis.title.y = element_text(size = 16)) + +q <- ggplot(le.data, aes(group = start_date, ids = start_date, frame = start_date)) + #, label= LE - Predicted + geom_ribbon(aes(x = Time, ymin=Lower, ymax=Upper, fill="95% Confidence Interval"), alpha = 0.4) + + geom_line(aes(x = Time, y = LE, color = "Observed Data"), size = 1) + + geom_line(aes(x = Time, y = Predicted, color = "Predicted Mean")) + + ggtitle(paste0("Latent Energy for ", frame_start, " to ", frame_end, ", at ", site.abv)) + + scale_color_manual(name = "Legend", labels = c("Predicted Mean", "Observed Data"), values=c("Predicted Mean" = "skyblue1", "Observed Data" = "firebrick4")) + + scale_fill_manual(labels = c("95% Confidence Interval"), values=c("95% Confidence Interval" = "blue1")) + + scale_y_continuous(name="LE (W m-2 s-1)") + #, limits = c(qle_lower, qle_upper)) + + #scale_x_discrete(name = "", breaks = x.breaks, labels = format(ftime[-length(ftime)], "%m-%d")) + + theme_minimal() + + theme(plot.title = element_text(hjust = 0.5, size = 16), legend.title = element_blank(), legend.text = element_text(size = 12), axis.text.x = element_text(size = 12, angle = 45), axis.text.y = element_text(size = 13), axis.title.y = element_text(size = 16)) + + + +ggplot.nee<-ggplotly(p, tooltip = 'all') %>% + animation_opts(frame = 1200, easing = 'linear-in', transition = 0, redraw = F, mode = "next") %>% + animation_slider(x = 0, y = -0.1, visible = T, currentvalue = list(prefix = "Forecast Date:", font = list(color = 'black'))) %>% + animation_button(x = 0, xanchor = "left", y = 1.5, yanchor= "top") %>% + layout(legend = list(orientation = "h", x = 0.25, y = 1.1)) %>% + layout(showlegend = T, margin = c(30,50,30,50)) + +ggplot.nee$x$data[[1]]$name <-"95% Confidence Interval" +ggplot.nee$x$data[[2]]$name <- "Observed Data" +ggplot.nee$x$data[[3]]$name <- "Predicted Mean" + + +ggplot.le<-ggplotly(q, tooltip = 'all', layerData = 2) %>% + animation_opts(frame = 1200, easing = 'linear-in', transition = 0, redraw = F, mode = "next") %>% + animation_slider(x = 0, y = -0.1, visible = T, currentvalue = list(prefix = "Forecast Date:", font = list(color = 'black'))) %>% + animation_button(x = 0, xanchor = "left", y = 1.5, yanchor= "top") %>% + layout(legend = list(orientation = "h", x = 0.25, y = 1.1)) %>% + layout(showlegend = T, margin = c(30,50,30,50)) + +ggplot.le$x$data[[1]]$name <-"95% Confidence Interval" +ggplot.le$x$data[[2]]$name <- "Observed Data" +ggplot.le$x$data[[3]]$name <- "Predicted Mean" + + + +#for shiny app +if(file.exists(paste0("/fs/data3/kzarada/NEFI/US_", site.abv, "/download_", site.abv,"_met.R"))){ +source(paste0("/fs/data3/kzarada/NEFI/US_", site.abv, "/download_", site.abv,"_met.R")) +met = do.call(paste0("download_US_", site.abv,"_met"), list(frame_start, Sys.Date())) + +if("Tsoil" %in% names(met)){ +met <- as_tibble(met) %>% mutate(Time = as.POSIXct(date)) %>% dplyr::select(Time, Tair,Tsoil, rH) +}else{met <- as_tibble(met) %>% mutate(Time = as.POSIXct(date)) %>% dplyr::select(Time, Tair, rH)} + +nee.met <- nee.data %>% inner_join(met,nee.data, by = c("Time")) + +#Calculate Error +nee.met$error <- (nee.met$NEE - nee.met$Predicted) +} + +nee.data$error = nee.data$NEE - nee.data$Predicted +le.data$error = le.data$LE - le.data$Predicted + +#for met comparison + +library(ncdf4) + +if(dir.exists(paste0("/fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_site_", db.num, "/"))){ + forecast.path <-paste0("/fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_downscale_site_", db.num, "/") + }else(forecast.path <- paste0("/fs/data3/kzarada/pecan.data/dbfiles/NOAA_GEFS_site_", db.num, "/")) + +forecasted_data <- data.frame() +#### stopping here-- need to make sure that it goes through each dir index and saves and then moves on +dirs <- list.dirs(path = forecast.path) +dir.1 <- dirs[grepl(paste0(".21.", Sys.Date(), "T*"), dirs)] +nc.files = list() +index = list() +dir.index = list() + +index= strsplit(dir.1[1], split = ".21.20")[[1]][2] +dir.index= dirs[grepl(index[1], dirs)] + + + +for(k in 1:21){ + nc.files[k]<- list.files(path = dir.index[k], pattern = '*.nc' ) +} + +forecasted_data <- data.frame() +for(i in 1:21){ + setwd(dir.index[i]) + nc <- nc_open(nc.files[[i]][1]) + sec <- nc$dim$time$vals + sec <- udunits2::ud.convert(sec, unlist(strsplit(nc$dim$time$units, " "))[1], "seconds") + dt <- mean(diff(sec), na.rm=TRUE) + tstep <- round(86400 / dt) + dt <- 86400 / tstep + + + Tair <-ncdf4::ncvar_get(nc, "air_temperature") ## in Kelvin + Tair_C <- udunits2::ud.convert(Tair, "K", "degC") + Qair <-ncdf4::ncvar_get(nc, "specific_humidity") #humidity (kg/kg) + ws <- try(ncdf4::ncvar_get(nc, "wind_speed")) + if (!is.numeric(ws)) { + U <- ncdf4::ncvar_get(nc, "eastward_wind") + V <- ncdf4::ncvar_get(nc, "northward_wind") + ws <- sqrt(U ^ 2 + V ^ 2) + PEcAn.logger::logger.info("wind_speed absent; calculated from eastward_wind and northward_wind") + } + + + Rain <- ncdf4::ncvar_get(nc, "precipitation_flux") + pres <- ncdf4::ncvar_get(nc,'air_pressure') ## in pascal + SW <- ncdf4::ncvar_get(nc, "surface_downwelling_shortwave_flux_in_air") ## in W/m2 + LW <- ncdf4::ncvar_get(nc, "surface_downwelling_longwave_flux_in_air") + RH <- PEcAn.data.atmosphere::qair2rh(Qair, Tair_C, press = 950) + + file.name <- nc.files[[i]][1] + + hour <- strsplit(strsplit(index, split = "T")[[1]][2], split = ".20")[[1]][1] + + start_date <- as.POSIXct(paste0(strsplit(strsplit(nc$dim$time$units, " ")[[1]][3], split = "T")[[1]][1]," ", hour), format = "%Y-%m-%d %H:%M") + sec <- nc$dim$time$vals + + + timestamp <- seq(from = start_date + lubridate::hours(6), by = "1 hour", length.out = length(sec)) + ensemble <- rep(i, times = length(timestamp)) + tmp <- as.data.frame(cbind( + ensemble, + Tair_C, + Qair, + RH, + Rain = Rain * dt, + ws, + SW, + LW + )) + tmp$timestamp <- timestamp + nc_close(nc) + forecasted_data <- rbind(forecasted_data, tmp) +} + +forecasted_data$ensemble = as.factor(forecasted_data$ensemble) + + + + +#Save Rdata for shiny app +save(list = ls(), file = paste0("/srv/shiny-server/Flux_Dashboard/data/", site.abv, ".RData")) +save(list = ls(), file = paste0("/fs/data3/kzarada/NEFI/", site.abv, ".RData")) + + +print(ls()) +} + + +try(tower.graphs(WLEF.num, + WLEF.abv, + WLEF.outdir, + WLEF.db.num)) +try(tower.graphs(WCR.num, + WCR.abv, + WCR.outdir, + WCR.db.num)) +try(tower.graphs(Potato.num, + Potato.abv, + Potato.outdir, + Potato.db.num)) +try(tower.graphs(Syv.num, + Syv.abv, + Syv.outdir, + Syv.db.num)) +try(tower.graphs(Los.num, + Los.abv, + Los.outdir, + Los.db.num)) +try(tower.graphs(Harvard.num, + Harvard.abv, + Harvard.outdir, + Harvard.db.num)) + diff --git a/modules/assim.sequential/inst/NEFI/graphs.R b/modules/assim.sequential/inst/NEFI/graphs.R deleted file mode 100644 index 573322d71dd..00000000000 --- a/modules/assim.sequential/inst/NEFI/graphs.R +++ /dev/null @@ -1,161 +0,0 @@ -# Creates a plot of the nc files generated by the workflow -# @author Luke Dramko -library("tidyverse") - -graph_dir = "./graphs/" -args = commandArgs(trailingOnly = TRUE) -if (is.na(args[1])) { - print("Please include a start date or workflow id.") - exit("Missing input parameter") -} -# Validate date -start_date <- tryCatch(as.POSIXct(args[1]), error = function(e) {NULL} ) -if (is.null(start_date)) { - in_wid <- as.integer(args[1]) -} -# Set up database connection -dbparms = list() -dbparms$dbname = "bety" -dbparms$host = "128.197.168.114" -dbparms$user = "bety" -dbparms$password = "bety" -#Connection code copied and pasted from met.process -bety <- dplyr::src_postgres(dbname = dbparms$dbname, - host = dbparms$host, - user = dbparms$user, - password = dbparms$password) -con <- bety$con #Connection to the database. dplyr returns a list. -# Identify the workflow with the proper information -if (!is.null(start_date)) { - workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE start_date='", format(start_date, "%Y-%m-%d %H:%M:%S"), - "' ORDER BY id"), con) -} else { - workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE id='", in_wid, "'"), con) -} -print(workflows) -if (nrow(workflows) == 0) { - print("No workflow found.") - quit("no") -} -if (nrow(workflows) > 1) { - print("Multiple workflows found: Using the latest") - workflow <- workflows[nrow(workflows),] -} else { - workflow <- workflows -} -print(paste0("Using workflow ", workflow$id)) -wid <- workflow$id -pecan_out_dir <- paste0("/fs/data3/kzarada/output/PEcAn_", wid, "/out"); -pecan_out_dirs <- list.dirs(path = pecan_out_dir) -if (is.na(pecan_out_dirs[1])) { - print(paste0(pecan_out_dirs, " does not exist.")) - quit("no") -} -neemat <- matrix(1:64, nrow=1, ncol=64) # Proxy row, will be deleted later. -qlemat <- matrix(1:64, nrow=1, ncol=64) # Proxy row, will be deleted later. -num_results <- 0; -for (i in 2:length(pecan_out_dirs)) { - datafile <- file.path(pecan_out_dirs[i], format(workflow$start_date, "%Y.nc")) - if (!file.exists(datafile)) { - print(paste0("File ", datafile, " does not exist.")) - next - } - - num_results <- num_results + 1 - - #open netcdf file - ncptr <- ncdf4::nc_open(datafile); - - # Attach data to matricies - nee <- ncdf4::ncvar_get(ncptr, "NEE") - neemat <- rbind(neemat, nee) - - qle <- ncdf4::ncvar_get(ncptr, "Qle") - qlemat <- rbind(qlemat, qle) - - # Close netcdf file - ncdf4::nc_close(ncptr) -} -if (num_results == 0) { - print("No results found.") - quit("no") -} else { - print(paste0(num_results, " results found.")) -} -# Strip away proxy rows -neemat <- neemat[-1,] -qlemat <- qlemat[-1,] -# Time -time <- seq(6, 6 * ncol(neemat), by=6) -# Caluclate means -neemins <- NULL -neemaxes <- NULL -quantiles <- apply(neemat,2,quantile,c(0.025,0.5,0.975), na.rm=TRUE) -neelower95 <- quantiles[1,] -neemeans <- quantiles[2,] -neeupper95 <- quantiles[3,] -# Determines outliers... not requested anymore -# for (i in 1:ncol(neemat)) { -# without_outliers <- neemat[,i] -# without_outliers <- without_outliers[!without_outliers %in% boxplot.stats(without_outliers)$out] -# neemins <- c(neemins, min(without_outliers)) -# neemaxes <- c(neemaxes, max(without_outliers)) -#} -needf <- data.frame(time = time, lower = neelower95, means = neemeans, upper = neeupper95) -quantiles <- apply(qlemat,2,quantile,c(0.025,0.5,0.975), na.rm=TRUE) -qlelower95 <- quantiles[1,] -qlemeans <- quantiles[2,] -qleupper95 <- quantiles[3,] -qledf <- data.frame(time = time, lower = qlelower95, means = qlemeans, upper = qleupper95) -# Reshape data for data frame -#time <- factor(rep(seq(6, 6 * 64, by=6), each=num_results)) -#nee = NULL; # An empty vector -#for (i in 1:ncol(neemat)) { -# nee <- c(nee, neemat[,i]) -#} -#qle = NULL; -#for (i in 1:ncol(qlemat)) { -# qle <- c(qle, qlemat[,i]) -#} -# -# Put data into data frame for ggplot -#needf <- data.frame(time = time, -# nee = nee) -#qledf <- data.frame(time = time, -# qle = qle) - -# Grab real data -real_data <- PEcAn.data.atmosphere::download.US_WCr(workflow$start_date, workflow$end_date, timestep=6) -needf$real_nee <- real_data$nee -qledf$real_qle <- real_data$qle - -# Create plots -neeplot <- ggplot(needf) + - # geom_ribbon(aes(x=time, ymin=neemins, ymax=neemaxes, fill="Spread of data (excluding outliers)"), alpha = 0.7) + - geom_ribbon(aes(x = time, ymin=neelower95, ymax=neeupper95, fill="95% confidence interval"), alpha = 0.4) + - geom_line(aes(x=time, y=neemeans, color="predicted mean")) + - geom_line(aes(x=time, y=real_data$nee, color="actual data")) + - ggtitle(paste0("Net Ecosystem Exchange for ", workflow$start_date, " to ", workflow$end_date, "")) + - scale_x_continuous(name="Time (hours)") + scale_y_continuous(name="NEE (kg C m-2 s-1)") + - scale_colour_manual(name='Legend', values=c("predicted mean"="lightskyblue1", "actual data"="darkorange3")) + - scale_fill_manual(name='Legend', values=c("95% confidence interval" = "blue3", "mean"="lightskyblue1")) - - qleplot <- ggplot(qledf) + - # geom_ribbon(aes(x=time, ymin=qlemins, ymax=qlemax, fill="Spread of data (excluding outliers)"), alpha=0.7) + - geom_ribbon(aes(x=time, ymin=qlelower95, ymax=qleupper95, fill="95% confidence interval"), alpha = 0.4) + - geom_line(aes(x=time, y=qlemeans, color="mean")) + - geom_line(aes(x=time, y=real_data$qle, color="actual data")) + - ggtitle(paste0("LE for ", workflow$start_date, " to ", workflow$end_date, ", \nSummary of All Ensembles")) + - scale_x_continuous(name="Time (hours)") + scale_y_continuous(name="LE (W m-2 s-1)") + - scale_color_manual(name='Legend', values=c("mean"="lightskyblue1", "actual data"="darkorange3")) + - scale_fill_manual(name='Legend', values=c("95% confidence interval" = "blue3")) - -if (!dir.exists(graph_dir)) { - dir.create(graph_dir, recursive = TRUE) -} -print("Saving plots") -# save(neeplot, file="plot.Rdata") -pdf(file.path(graph_dir, paste0(format(workflow$start_date, "%Y-%m-%dT%H:%M:%SNEE"), ".pdf")), width = 6, height = 3) -plot(neeplot) -plot(qleplot) -dev.off() diff --git a/modules/assim.sequential/inst/NEFI/graphs_timeframe.R b/modules/assim.sequential/inst/NEFI/graphs_timeframe.R deleted file mode 100644 index 255daee9df8..00000000000 --- a/modules/assim.sequential/inst/NEFI/graphs_timeframe.R +++ /dev/null @@ -1,238 +0,0 @@ -# Creates a plot of the nc files generated by the workflow. -# This version of graphs.R, graphs_timeframe.R, generates the graphs inside a consistent frame (a consistent x -# axis and y axis). -# This makes them easier to make into a gif. -# @author Luke Dramko - -library("ggplot2") - -args = commandArgs(trailingOnly = TRUE) -outfolder = "./graphs" # Where output graphs are put - -# These variables control the start and end dates of the x axis. -frame_start <- as.POSIXct('2018-09-11 00:00') -frame_end <- as.POSIXct('2018-10-06 00:00') - -# These variables control the start and end dates of the y axis -nee_upper = 1e-06 -nee_lower = -1e-06 -qle_upper = 350 -qle_lower = -50 - - -if (is.na(args[1])) { - print("Please include a start date or workflow id.") - exit("Missing input parameter") -} - -# Validate date -start_date <- tryCatch(as.POSIXct(args[1]), error = function(e) {NULL} ) - -in_wid = 0 -if (is.null(start_date)) { - in_wid <- as.integer(args[1]) -} - -if (is.na(in_wid)) { - print("First argument must be a date or workflow id") - quit("no") -} - -graph_for = "NEE" -if (!is.na(args[2]) && args[2] == "LE") { - graph_for = "LE" -} else if (!is.na(args[2]) && args[2] == "NEE") { - graph_for = "NEE" -} else { - print("Invalid second argument, must be NEE or LE. Defaulting to NEE.") -} - -# Set up database connection -dbparms = list() -dbparms$dbname = "bety" -dbparms$host = "128.197.168.114" -dbparms$user = "bety" -dbparms$password = "bety" - -#Connection code copied and pasted from met.process -bety <- dplyr::src_postgres(dbname = dbparms$dbname, - host = dbparms$host, - user = dbparms$user, - password = dbparms$password) - -con <- bety$con #Connection to the database. dplyr returns a list. - -# Identify the workflow with the proper information -if (!is.null(start_date)) { - workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE start_date='", format(start_date, "%Y-%m-%d %H:%M:%S"), - "' ORDER BY id"), con) -} else { - workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE id='", in_wid, "'"), con) -} - -print(workflows) - -if (nrow(workflows) == 0) { - print("No workflow found.") - quit("no") -} - -if (nrow(workflows) > 1) { - print("Multiple workflows found: Using the latest") - workflow <- workflows[nrow(workflows),] -} else { - workflow <- workflows -} - -print(paste0("Using workflow ", workflow$id)) - -wid <- workflow$id -pecan_out_dir <- paste0("/fs/data3/kzarada/output/PEcAn_", wid, "/out"); -pecan_out_dirs <- list.dirs(path = pecan_out_dir) - -if (is.na(pecan_out_dirs[1])) { - print(paste0(pecan_out_dirs, " does not exist.")) - quit("no") -} - -neemat <- matrix(1:64, nrow=1, ncol=64) # Proxy row, will be deleted later. -qlemat <- matrix(1:64, nrow=1, ncol=64) # Proxy row, will be deleted later. - -num_results <- 0; - -for (i in 2:length(pecan_out_dirs)) { - datafile <- file.path(pecan_out_dirs[i], format(workflow$start_date, "%Y.nc")) - if (!file.exists(datafile)) { - print(paste0("File ", datafile, " does not exist.")) - next - } - - num_results <- num_results + 1 - - #open netcdf file - ncptr <- ncdf4::nc_open(datafile); - - # Attach data to matricies - nee <- ncdf4::ncvar_get(ncptr, "NEE") - neemat <- rbind(neemat, nee) - - qle <- ncdf4::ncvar_get(ncptr, "Qle") - qlemat <- rbind(qlemat, qle) - - # Close netcdf file - ncdf4::nc_close(ncptr) -} - -if (num_results == 0) { - print("No results found.") - quit("no") -} else { - print(paste0(num_results, " results found.")) -} - -# Strip away proxy rows -neemat <- neemat[-1,] -qlemat <- qlemat[-1,] - -# Time -Time <- seq(frame_start, frame_end, by="6 hours") -Time <- Time[-1] # The start date is not included in the forecast - -# Caluclate means -neemins <- NULL -neemaxes <- NULL - -quantiles <- apply(neemat,2,quantile,c(0.025,0.5,0.975), na.rm=TRUE) -neelower95 <- quantiles[1,] -neemeans <- quantiles[2,] -neeupper95 <- quantiles[3,] - -quantiles <- apply(qlemat,2,quantile,c(0.025,0.5,0.975), na.rm=TRUE) -qlelower95 <- quantiles[1,] -qlemeans <- quantiles[2,] -qleupper95 <- quantiles[3,] - -# Grab real data as.POSIXct(workflow$end_date) -real_data <- PEcAn.data.atmosphere::download.US_WCr(frame_start, as.POSIXct(workflow$end_date), timestep = 6) - -real_nee <- real_data$nee -real_qle <- real_data$qle - -# Pad data with NA's to appropriately position the forecast in the graph. (For the forecast data) -# Pad NA's at the front -numNAs = lubridate::as.duration(lubridate::interval(frame_start, as.POSIXct(workflow$start_date))) -numNAs <- udunits2::ud.convert(numNAs, "s", "h") / 6 -if (floor(numNAs) != numNAs) { - print("Time scale incorrect.") - quit("no") -} - -for (i in seq_len(numNAs)) { - neelower95 <- c(NA, neelower95) - neemeans <- c(NA, neemeans) - neeupper95 <- c(NA, neeupper95) - qlelower95 <- c(NA, qlelower95) - qlemeans <- c(NA, qlemeans) - qleupper95 <- c(NA, qleupper95) -} - -# Pad NA's at the end -numNAs = lubridate::as.duration(lubridate::interval(as.POSIXct(workflow$end_date), frame_end)) -numNAs <- udunits2::ud.convert(numNAs, "s", "h") / 6 - -if (floor(numNAs) != numNAs) { - print("Time scale incorrect.") - quit("no") -} - -for (i in seq_len(numNAs)) { - neelower95 <- c(neelower95, NA) - neemeans <- c(neemeans, NA) - neeupper95 <- c(neeupper95, NA) - qlelower95 <- c(qlelower95, NA) - qlemeans <- c(qlemeans, NA) - qleupper95 <- c(qleupper95, NA) - real_nee <- c(real_nee, NA) - real_qle <- c(real_qle, NA) -} - -needf <- data.frame(Time = Time, lower = neelower95, means = neemeans, upper = neeupper95, real_nee = real_nee) -qledf <- data.frame(Time = Time, lower = qlelower95, means = qlemeans, upper = qleupper95, real_qle = real_qle) - -# Create better plots -neeplot <- ggplot(needf) + - # geom_ribbon(aes(x=time, ymin=neemins, ymax=neemaxes, fill="Spread of data (excluding outliers)"), alpha = 0.7) + - geom_ribbon(aes(x = Time, ymin=neelower95, ymax=neeupper95, fill="95% confidence interval"), alpha = 0.4) + - geom_line(aes(x=Time, y=neemeans, color="predicted mean")) + - geom_line(aes(x=Time, y=real_nee, color="observed data")) + - ggtitle(paste0("Net Ecosystem Exchange for ", workflow$start_date, " to ", workflow$end_date, ", Willow Creek, Wisconson")) + - xlim(frame_start, frame_end) + - theme(axis.text.x=element_text(angle=60, hjust=1)) + - scale_colour_manual(name='Legend', values=c("predicted mean"="lightskyblue1", "observed data"="orange1")) + - scale_fill_manual(name='Legend', values=c("Spread of data (excluding outliers)"="azure4", "95% confidence interval" = "blue3", "mean"="lightskyblue1")) + - scale_y_continuous(name="NEE (kg C m-2 s-1)", limits=c(nee_lower, nee_upper)) - - qleplot <- ggplot(qledf) + - geom_ribbon(aes(x=Time, ymin=qlelower95, ymax=qleupper95, fill="95% confidence interval"), alpha = 0.4) + - geom_line(aes(x=Time, y=qlemeans, color="mean")) + - geom_point(aes(x=Time, y=real_qle, color="observed data")) + - ggtitle(paste0("Latent Energy for ", workflow$start_date, " to ", workflow$end_date, ", Summary of All Ensembles")) + - xlim(frame_start, frame_end) + - theme(axis.text.x=element_text(angle=60, hjust=1)) + - scale_color_manual(name='Legend', values=c("mean"="lightskyblue1", "observed data"="orange2")) + - scale_fill_manual(name='Legend', values=c("95% confidence interval" = "blue3")) + - scale_y_discrete(name="LE (W m-2 s-1)", limits = c(qle_lower, qle_upper)) - -if (!dir.exists(outfolder)) { - dir.create(outfolder, recursive = TRUE) -} - -print("Saving plots") -if (graph_for == "LE") { - pdf(file.path(outfolder, format(workflow$start_date, "%Y-%m-%dT%H:%M:%SLE.pdf")), width = 12, height = 6) - plot(qleplot) -} else { - pdf(file.path(outfolder, format(workflow$start_date, "%Y-%m-%dT%H:%M:%SNEE.pdf")), width = 12, height = 6) - plot(neeplot) -} -dev.off() diff --git a/modules/assim.sequential/inst/NEFI/last12days.R b/modules/assim.sequential/inst/NEFI/last12days.R deleted file mode 100644 index b8ab05269dc..00000000000 --- a/modules/assim.sequential/inst/NEFI/last12days.R +++ /dev/null @@ -1,31 +0,0 @@ -# Grab the last 12 days worth of data -# Defaults to the midnight forecast. -# @author Luke Dramko - -cur_date <- as.POSIXct(Sys.time(), tz = "UTC") -print(cur_date) - -for (i in 1:1) { - cur_date_str <- paste0(format(cur_date, "%Y-%m-%d"), " 00:00"); - print(paste("Running PEcAn for NOAA_GEFS for date", cur_date_str)) - - #Generate the xml - system(paste0("Rscript generate.gefs.xml.R gefs.sipnet.source.xml ", cur_date_str)) - - #Run PEcAn - cmd <- "Rscript" - args <- c("/home/ldramko/pecan/web/workflow.R", "/home/ldramko/NEFI_tools/pecan_scripts/gefs.sipnet.source.xml") - cmd_out <- system2(cmd, args, stdout=TRUE, stderr=TRUE) - # cmd_out <- "Redirected to shell." - - #Obtain information about the run - settings <- PEcAn.settings::read.settings("/home/ldramko/NEFI_tools/pecan_scripts/gefs.sipnet.source.xml") - workflowid <- settings$workflow$id - - #Write workflow output to a file - basefolder <- paste0("/fs/data3/ldramko/output/PEcAn_", workflowid); - write(cmd_out, append = TRUE, file = file.path(basefolder, "workflow.log.txt")) - - #Run for the previous day - cur_date <- cur_date - lubridate::days(1) -} \ No newline at end of file diff --git a/modules/assim.sequential/inst/NEFI/run.gefs.sipnet.EXAMPLE.sh b/modules/assim.sequential/inst/NEFI/run.gefs.sipnet.EXAMPLE.sh deleted file mode 100644 index 872aed955e9..00000000000 --- a/modules/assim.sequential/inst/NEFI/run.gefs.sipnet.EXAMPLE.sh +++ /dev/null @@ -1,29 +0,0 @@ -# This script first runs a program which sets up the xml file for a current -# NOAA_GEFS PEcAn run, then runs PEcAn with that file. -# @author Luke Dramko - -# REPLACE < username > WITH YOUR USERNAME -# If running from a CRON job, these paths MUST be absolute paths. This is because CRON assumes that the directory it is in is the working directory. -xmlfile="./gefs.sipnet.source.xml" #Path to, and name of, the base xml file. -workflow_path="./../../../../scripts/" #Path to workflow.R (in pecan/web for the standard version or pecan/scripts for the custom version). -output_path="/fs/data3/kzarada/output/" #Path to the directory where all PEcAn output is put. -xmlscript="./generate.gefs.xml.R" #Path to, and name of, the script that modifies the xml. -workflow_name="workflow.wcr.assim.R" #"workflow.wcr.assim.R" Name of the workflow.R version# Could also be just workflow.R in pecan/web - -# Generates the xml file based on a given input file. Overwrites the -# input file. -Rscript $xmlscript $xmlfile $1 &> /dev/null -if [ $? -eq 11 ]; -then - echo "xml file not found." -elif [ $? -eq 12 ] -then - echo "Database connection failed." -else - # Find the most recently created output directory. This system is kind of hack-y, and is messed up if anything after - # "PEcAn", alphabetically, is put in the directory. Fortunately, that is unlikely to happen. - output_dir=$(ls $output_path | sort -V | tail -n 1) - # Runs the PEcAn workflow. - Rscript ${workflow_path}${workflow_name} $xmlfile &> ${output_path}/${output_dir}/workflow.log.txt - echo "Workflow completed." -fi diff --git a/modules/assim.sequential/inst/RemoteLauncher/SDA_launcher.R b/modules/assim.sequential/inst/RemoteLauncher/SDA_launcher.R index ad0b38b4247..8d481157a51 100644 --- a/modules/assim.sequential/inst/RemoteLauncher/SDA_launcher.R +++ b/modules/assim.sequential/inst/RemoteLauncher/SDA_launcher.R @@ -7,8 +7,12 @@ library(PEcAn.uncertainty) library(lubridate) library(purrr) library(dplyr) -library(reshape2) library(furrr) +library(nimble) +library(reshape2) +library(tictoc) + +plan(multiprocess) #---------------------------------------------------------------- # Reading settings and paths #--------------------------------------------------------------- @@ -31,16 +35,44 @@ if (is.na(args[2])){ # Setup #--------------------------------------------------------------- setwd(settings$outdir) -unlink(c('run', 'out', 'SDA'), recursive = TRUE) +# This is how I delete large folders +# In case there is an SDA run already performed in this dir and you're planning to use the same dir for some reason +# These next lines could be uncommented to delete the necessary dirs. +# c('run', 'out', 'SDA') %>% +# map(function(dir.delete) { +# if (dir.exists(file.path(settings$outdir, dir.delete))) { +# setwd(settings$outdir) +# list.dirs(dir.delete, full.names = T) %>% +# furrr::future_map(function(del.dir) { +# setwd(file.path(settings$outdir, del.dir)) +# system(paste0("perl -e 'for(<*>){((stat)[9]<(unlink))}'")) +# }) +# PEcAn.logger::logger.info(paste0("I just deleted ", dir.delete, " folder !")) +# } +# }) +# +# unlink(c('run', 'out', 'SDA'), recursive = TRUE) #---------------------------------------------------------------- # Find what sites we are running for #--------------------------------------------------------------- -if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() +if (inherits(settings, "MultiSettings")) site.ids <- settings %>% map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() #---------------------------------------------------------------- # samples should be ready if not lets make it #--------------------------------------------------------------- -if (!("samples.Rdata" %in% list.files())) get.parameter.samples(settings, - ens.sample.method = settings$ensemble$samplingspace$parameters$method) ## Aside: if method were set to unscented, would take minimal changes to do UnKF +if (!("samples.Rdata" %in% list.files())) { + #check to see if there are posterior.files tags under pft + + posterior.files.vec<-settings$pfts %>% + purrr::map(purrr::possibly('posterior.files', NA_character_)) %>% + purrr::modify_depth(1, function(x) { + ifelse(is.null(x), NA_character_, x) + }) %>% + unlist() + + get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method, + posterior.files=posterior.files.vec) ## Aside: if method were set to unscented, would take minimal changes to do UnKF +} #---------------------------------------------------------------- # OBS data preparation #--------------------------------------------------------------- diff --git a/modules/assim.sequential/inst/Site_XMLS/bart.xml b/modules/assim.sequential/inst/Site_XMLS/bart.xml new file mode 100644 index 00000000000..bdfc9fa4378 --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/bart.xml @@ -0,0 +1,83 @@ + + + + EFI Forecast + 1000012038 + ahelgeso + 2021/05/05 13:20:05 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /projectnb/dietzelab/ahelgeso/EFI_Forecast_Challenge/Bartlett/noaa/ + + + + temperate.deciduous.HPDA + + 1 + + 1000022311 + /fs/data2/output//PEcAn_1000010530/pft/temperate.deciduous.HPDA + + + soil.HPDA + + 1 + + 1000022310 + /fs/data2/output//PEcAn_1000010530/pft/soil.HPDA + + + + 3000 + FALSE + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + + + + 1000004924 + + + + NOAA_GEFS + SIPNET + + + /projectnb/dietzelab/ahelgeso/EFI_Forecast_Challenge/Bartlett/soil.nc + + + + + localhost + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + diff --git a/modules/assim.sequential/inst/Site_XMLS/harvard.xml b/modules/assim.sequential/inst/Site_XMLS/harvard.xml new file mode 100755 index 00000000000..b6f181bf97a --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/harvard.xml @@ -0,0 +1,92 @@ + + + + Daily Forecast SIPNET Site + 1000012038 + ahelgeso + 2021/05/10 20:42:37 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.deciduous.HPDA + + 1 + + 1000022311 + /fs/data2/output//PEcAn_1000010530/pft/temperate.deciduous.HPDA + + + soil.ALL + + 1 + + 1000022310 + /fs/data2/output//PEcAn_1000010530/pft/soil.HPDA + + + + 3000 + + FALSE + FALSE + + 1.2 + AUTO + + + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + SIPNET + FALSE + /fs/data5/pecan.models/sipnet_unk/sipnet + + + + 646 + + + + NOAA_GEFS + SIPNET + + + + + localhost + + diff --git a/modules/assim.sequential/inst/Site_XMLS/konz.xml b/modules/assim.sequential/inst/Site_XMLS/konz.xml new file mode 100644 index 00000000000..7820dbc3727 --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/konz.xml @@ -0,0 +1,82 @@ + + + + EFI Forecast + 1000012038 + ahelgeso + 2021/05/06 15:06:40 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + TRUE + + /projectnb/dietzelab/EFI_Forecast_Challenge/Konza/noaa/ + + + + semiarid.grassland_HPDA + + 1 + + 1000016525 + /projectnb/dietzelab/hamzed/HPDA/Outputs/Grass-Arid/pft/semiarid.grassland + + + soil.ALL_Arid_GrassHPDA + + 1 + + 1000016524 + /projectnb/dietzelab/hamzed/HPDA/Outputs/Grass-Arid/pft/soil.ALL + + + + 3000 + FALSE + + + 1000000030 + + + + 1000004927 + + + + NOAA_GEFS + SIPNET + + + /projectnb/dietzelab/ahelgeso/EFI_Forecast_Challenge/Konza/soil.nc + + + + + localhost + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + diff --git a/modules/assim.sequential/inst/Site_XMLS/los.xml b/modules/assim.sequential/inst/Site_XMLS/los.xml new file mode 100755 index 00000000000..25bdec748de --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/los.xml @@ -0,0 +1,79 @@ + + + + Daily Forecast SIPNET Site + 1000012038 + ahelgeso + 2021/05/10 20:44:50 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.deciduous.HPDA + + 1 + + 1000022311 + /fs/data2/output//PEcAn_1000010530/pft/temperate.deciduous.HPDA + + + soil.HPDA + + 1 + + 1000016485 + /fs/data2/output//PEcAn_1000010530/pft/soil.HPDA + + + + 3000 + FALSE + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + + + + 679 + + + + NOAA_GEFS + SIPNET + + + + + localhost + + diff --git a/modules/assim.sequential/inst/Site_XMLS/ordway.xml b/modules/assim.sequential/inst/Site_XMLS/ordway.xml new file mode 100644 index 00000000000..e24f7804763 --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/ordway.xml @@ -0,0 +1,82 @@ + + + + EFI Forecast + 1000012038 + ahelgeso + 2021/05/05 13:47:07 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /projectnb/dietzelab/EFI_Forecast_Challenge/Ordway/noaa/ + + + + temperate.coniferous + + 1 + + 1000016486 + /fs/data3/hamzed/Projects/HPDA/Helpers/Sites/Me4-Ameri/pft/boreal.coniferous + + + soil.HPDA + + 1 + + 1000016485 + /fs/data2/output//PEcAn_1000010530/pft/soil.HPDA + + + + 3000 + FALSE + + + 1000000030 + + + + 1000004916 + + + + NOAA_GEFS + SIPNET + + + /projectnb/dietzelab/ahelgeso/EFI_Forecast_Challenge/Ordway/soil.nc + + + + + localhost + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + diff --git a/modules/assim.sequential/inst/Site_XMLS/potato.xml b/modules/assim.sequential/inst/Site_XMLS/potato.xml new file mode 100644 index 00000000000..16d8f2bfd16 --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/potato.xml @@ -0,0 +1,79 @@ + + + + Daily Forecast SIPNET Site + 1000012038 + ahelgeso + 2021/05/10 20:21:05 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + semiarid.grassland_HPDA + + 1 + + 1000016525 + /projectnb/dietzelab/hamzed/HPDA/Outputs/Grass-Arid/pft/semiarid.grassland + + + soil.ALL_Arid_GrassHPDA + + 1 + + 1000016524 + /projectnb/dietzelab/hamzed/HPDA/Outputs/Grass-Arid/pft/soil.ALL + + + + 3000 + FALSE + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + + + + 1000026756 + + + + NOAA_GEFS + SIPNET + + + + + localhost + + diff --git a/modules/assim.sequential/inst/Site_XMLS/santarita.xml b/modules/assim.sequential/inst/Site_XMLS/santarita.xml new file mode 100644 index 00000000000..1bd31fd696e --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/santarita.xml @@ -0,0 +1,82 @@ + + + + EFI Forecast + 1000012038 + ahelgeso + 2021/04/20 15:32:55 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /projectnb/dietzelab/EFI_Forecast_Challenge/Santa_Rita/noaa/ + + + + semiarid.grassland_HPDA + + 1 + + 1000016525 + /projectnb/dietzelab/hamzed/HPDA/Outputs/Grass-Arid/pft/semiarid.grassland + + + soil.ALL_Arid_GrassHPDA + + 1 + + 1000016524 + /projectnb/dietzelab/hamzed/HPDA/Outputs/Grass-Arid/pft/soil.ALL + + + + 3000 + FALSE + + + 1000000030 + + + + 1000004876 + + + + NOAA_GEFS + SIPNET + + + /projectnb/dietzelab/ahelgeso/EFI_Forecast_Challenge/Santa_Rita/soil.nc + + + + + localhost + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + diff --git a/modules/assim.sequential/inst/Site_XMLS/syv.xml b/modules/assim.sequential/inst/Site_XMLS/syv.xml new file mode 100755 index 00000000000..9d2fe33d664 --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/syv.xml @@ -0,0 +1,80 @@ + + + + Daily Forecast SIPNET Site + 1000012038 + ahelgeso + 2021/05/10 20:47:17 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.coniferous + + 1 + + 1000016486 + /fs/data3/hamzed/Projects/HPDA/Helpers/Sites/Me4-Ameri/pft/boreal.coniferous + + + soil.HPDA + + 1 + + 1000016485 + /fs/data2/output//PEcAn_1000010530/pft/soil.HPDA + + + + 3000 + FALSE + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + + + + 622 + + + + NOAA_GEFS + SIPNET + + + + + localhost + + diff --git a/modules/assim.sequential/inst/Site_XMLS/wcr.xml b/modules/assim.sequential/inst/Site_XMLS/wcr.xml new file mode 100644 index 00000000000..71a1675e4de --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/wcr.xml @@ -0,0 +1,80 @@ + + + + Daily Forecast SIPNET Site + 1000012038 + ahelgeso + 2021/05/10 20:48:20 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.deciduous.HPDA + + 1 + + 1000022311 + /fs/data2/output//PEcAn_1000010530/pft/temperate.deciduous.HPDA + + + soil.HPDA + + 1 + + 1000022310 + /fs/data2/output//PEcAn_1000010530/pft/soil.HPDA + + + + 3000 + FALSE + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + + + + 676 + + + + NOAA_GEFS + SIPNET + + + + + localhost + + diff --git a/modules/assim.sequential/inst/Site_XMLS/wlef.xml b/modules/assim.sequential/inst/Site_XMLS/wlef.xml new file mode 100755 index 00000000000..2792e5db7f1 --- /dev/null +++ b/modules/assim.sequential/inst/Site_XMLS/wlef.xml @@ -0,0 +1,92 @@ + + + + Daily Forecast SIPNET Site + 1000012038 + ahelgeso + 2021/05/10 20:49:09 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + true + + /fs/data3/kzarada/pecan.data/dbfiles/ + + + + temperate.deciduous.HPDA + + 1 + + 1000022311 + /fs/data2/output//PEcAn_1000010530/pft/temperate.deciduous.HPDA + + + soil.ALL + + 1 + + 1000022310 + /fs/data2/output//PEcAn_1000010530/pft/soil.HPDA + + + + 3000 + + FALSE + FALSE + + 1.2 + AUTO + + + + + 100 + NEE + 2021 + 2021 + + + uniform + + + sampling + + + parameters + + + soil + + + + + + + 1000000030 + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + SIPNET + FALSE + /fs/data5/pecan.models/SIPNET/1023/sipnet + + + + 678 + + + + NOAA_GEFS + SIPNET + + + + + localhost + + diff --git a/modules/assim.sequential/inst/WillowCreek/NoDataWorkflow.R b/modules/assim.sequential/inst/WillowCreek/NoDataWorkflow.R new file mode 100644 index 00000000000..af07b3b03e1 --- /dev/null +++ b/modules/assim.sequential/inst/WillowCreek/NoDataWorkflow.R @@ -0,0 +1,329 @@ +# ---------------------------------------------------------------------- +#------------------------------------------ Load required libraries----- +# ---------------------------------------------------------------------- +library("PEcAn.all") +library("PEcAn.utils") +library("RCurl") +library("REddyProc") +library("tidyverse") +library("furrr") +library("R.utils") +library("dynutils") +plan(multisession) + + +# ---------------------------------------------------------------------------------------------- +#------------------------------------------ That's all we need xml path and the out folder ----- +# ---------------------------------------------------------------------------------------------- + +outputPath <- "/projectnb/dietzelab/kzarada/US_WCr_SDA_output/NoData/" +nodata <- TRUE +restart <- FALSE +days.obs <- 1 #how many of observed data to include -- not including today +setwd(outputPath) + +c( + 'Utils.R', + 'download_WCr.R', + "gapfill_WCr.R", + 'prep.data.assim.R' +) %>% walk( ~ source( + system.file("WillowCreek", + .x, + package = "PEcAn.assim.sequential") +)) + + +#------------------------------------------------------------------------------------------------ +#------------------------------------------ Preparing the pecan xml ----------------------------- +#------------------------------------------------------------------------------------------------ +#--------------------------- Finding old sims + + +setwd("/projectnb/dietzelab/kzarada/US_WCr_SDA_output/NoData/") + +#reading xml +settings <- read.settings("/fs/data3/kzarada/pecan/modules/assim.sequential/inst/WillowCreek/nodata.xml") + +#connecting to DB +con <-try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) + + + +# all.previous.sims <- list.dirs(outputPath, recursive = F) +# if (length(all.previous.sims) > 0 & !inherits(con, "try-error")) { +# +# tryCatch({ +# # Looking through all the old simulations and find the most recent +# all.previous.sims <- all.previous.sims %>% +# map(~ list.files(path = file.path(.x, "SDA"))) %>% +# setNames(all.previous.sims) %>% +# discard( ~ !"sda.output.Rdata" %in% .x) # I'm throwing out the ones that they did not have a SDA output +# +# last.sim <- +# names(all.previous.sims) %>% +# map_chr( ~ strsplit(.x, "_")[[1]][5]) %>% +# map_dfr(~ db.query( +# query = paste("SELECT * FROM workflows WHERE id =", .x), +# con = con +# ) %>% +# mutate(ID=.x)) %>% +# mutate(start_date = as.Date(start_date)) %>% +# arrange(desc(start_date), desc(ID)) %>% +# head(1) +# # pulling the date and the path to the last SDA +# restart.path <-grep(last.sim$ID, names(all.previous.sims), value = T) +# sda.start <- last.sim$start_date + lubridate::days(1) +# }, +# error = function(e) { +# restart.path <- NULL +# sda.start <- Sys.Date() - 1 +# PEcAn.logger::logger.warn(paste0("There was a problem with finding the last successfull SDA.",conditionMessage(e))) +# }) +# +# # if there was no older sims +# if (is.na(sda.start)) +# sda.start <- Sys.Date() - 9 +# } +sda.start <- Sys.Date() +sda.end <- sda.start + lubridate::days(3) +#----------------------------------------------------------------------------------------------- +#------------------------------------------ Download met and flux ------------------------------ +#----------------------------------------------------------------------------------------------- + + +# Finding the right end and start date +met.start <- sda.start - lubridate::days(2) +met.end <- met.start + lubridate::days(16) + + +#pad Observed Data to match met data + +date <- + seq( + from = lubridate::with_tz(as.POSIXct(sda.start, format = "%Y-%m-%d %H:%M:%S"), tz = "UTC"), + to = lubridate::with_tz(as.POSIXct(sda.end, format = "%Y-%m-%d %H:%M:%S"), tz = "UTC"), + by = "1 hour" + ) + +pad.prep <- as.data.frame(cbind(Date = as.character(date), means = rep("NA", length(date)), covs = rep("NA", length(date)))) %>% + dynutils::tibble_as_list() + +names(pad.prep) <-date + + +prep.data = pad.prep + + + +obs.mean <- prep.data %>% + purrr::map('means') %>% + setNames(names(prep.data)) +obs.cov <- prep.data %>% purrr::map('covs') %>% setNames(names(prep.data)) + +if (nodata) { + obs.mean <- obs.mean %>% purrr::map(function(x) + return(NA)) + obs.cov <- obs.cov %>% purrr::map(function(x) + return(NA)) +} + + +#----------------------------------------------------------------------------------------------- +#------------------------------------------ Fixing the settings -------------------------------- +#----------------------------------------------------------------------------------------------- +#unlink existing IC files +sapply(paste0("/projectnb/dietzelabe/pecan.data/dbfiles/IC_site_0-676_", 1:100, ".nc"), unlink) +#Using the found dates to run - this will help to download mets +settings$run$start.date <- as.character(met.start) +settings$run$end.date <- as.character(met.end) +settings$run$site$met.start <- as.character(met.start) +settings$run$site$met.end <- as.character(met.end) +#info +settings$info$date <- paste0(format(Sys.time(), "%Y/%m/%d %H:%M:%S"), " +0000") +# -------------------------------------------------------------------------------------------------- +#---------------------------------------------- PEcAn Workflow ------------------------------------- +# -------------------------------------------------------------------------------------------------- +#Update/fix/check settings. Will only run the first time it's called, unless force=TRUE +settings <- PEcAn.settings::prepare.settings(settings, force=FALSE) +setwd(settings$outdir) + + +#Write pecan.CHECKED.xml +PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") +# start from scratch if no continue is passed in +statusFile <- file.path(settings$outdir, "STATUS") +if (length(which(commandArgs() == "--continue")) == 0 && file.exists(statusFile)) { + file.remove(statusFile) +} +# Do conversions +settings <- PEcAn.workflow::do_conversions(settings, T, T, T) + +# Query the trait database for data and priors +if (PEcAn.utils::status.check("TRAIT") == 0) { + PEcAn.utils::status.start("TRAIT") + settings <- PEcAn.workflow::runModule.get.trait.data(settings) + PEcAn.settings::write.settings(settings, outputfile = 'pecan.TRAIT.xml') + PEcAn.utils::status.end() +} else if (file.exists(file.path(settings$outdir, 'pecan.TRAIT.xml'))) { + settings <- + PEcAn.settings::read.settings(file.path(settings$outdir, 'pecan.TRAIT.xml')) +} +# Run the PEcAn meta.analysis +if (!is.null(settings$meta.analysis)) { + if (PEcAn.utils::status.check("META") == 0) { + PEcAn.utils::status.start("META") + PEcAn.MA::runModule.run.meta.analysis(settings) + PEcAn.utils::status.end() + } +} +#sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, ens.sample.method = settings$ensemble$samplingspace$parameters$method) +# Setting dates in assimilation tags - This will help with preprocess split in SDA code +settings$state.data.assimilation$start.date <-as.character(first(names(obs.mean))) +settings$state.data.assimilation$end.date <-as.character(last(names(obs.mean))) + +#- lubridate::hms("06:00:00") + +# -------------------------------------------------------------------------------------------------- +#--------------------------------- Restart ------------------------------------- +# -------------------------------------------------------------------------------------------------- + +if(restart == TRUE){ + if(!dir.exists("SDA")) dir.create("SDA",showWarnings = F) + + #Update the SDA Output to just have last time step + temp<- new.env() + load(file.path(restart.path, "SDA", "sda.output.Rdata"), envir = temp) + temp <- as.list(temp) + + #we want ANALYSIS, FORECAST, and enkf.parms to match up with how many days obs data we have + # +24 because it's hourly now and we want the next day as the start + if(length(temp$ANALYSIS) > 1){ + + for(i in 1:days.obs + 1){ + temp$ANALYSIS[[i]] <- temp$ANALYSIS[[i + 24]] + } + for(i in rev((days.obs + 2):length(temp$ANALYSIS))){ + temp$ANALYSIS[[i]] <- NULL + } + + for(i in 1:days.obs + 1){ + temp$FORECAST[[i]] <- temp$FORECAST[[i + 24]] + } + for(i in rev((days.obs + 2):length(temp$FORECAST))){ + temp$FORECAST[[i]] <- NULL + } + + for(i in 1:days.obs + 1){ + temp$enkf.params[[i]] <- temp$enkf.params[[i + 24]] + } + for(i in rev((days.obs + 2):length(temp$enkf.params))){ + temp$enkf.params[[i]] <- NULL + } + + } + temp$t = 1 + + #change inputs path to match sampling met paths + + for(i in 1: length(temp$inputs$ids)){ + + temp$inputs$samples[i] <- settings$run$inputs$met$path[temp$inputs$ids[i]] + + } + + temp1<- new.env() + list2env(temp, envir = temp1) + save(list = c("ANALYSIS", "enkf.params", "ensemble.id", "ensemble.samples", 'inputs', 'new.params', 'new.state', 'run.id', 'site.locs', 't', 'Viz.output', 'X'), + envir = temp1, + file = file.path(settings$outdir, "SDA", "sda.output.Rdata")) + + + + temp.out <- new.env() + load(file.path(restart.path, "SDA", 'outconfig.Rdata'), envir = temp.out) + temp.out <- as.list(temp.out) + temp.out$outconfig$samples <- NULL + + temp.out1 <- new.env() + list2env(temp.out, envir = temp.out1) + save(list = c('outconfig'), + envir = temp.out1, + file = file.path(settings$outdir, "SDA", "outconfig.Rdata")) + + + + #copy over run and out folders + + if(!dir.exists("run")) dir.create("run",showWarnings = F) + + files <- list.files(path = file.path(restart.path, "run/"), full.names = T, recursive = T, include.dirs = T, pattern = "sipnet.clim") + readfiles <- list.files(path = file.path(restart.path, "run/"), full.names = T, recursive = T, include.dirs = T, pattern = "README.txt") + + newfiles <- gsub(pattern = restart.path, settings$outdir, files) + readnewfiles <- gsub(pattern = restart.path, settings$outdir, readfiles) + + rundirs <- gsub(pattern = "/sipnet.clim", "", files) + rundirs <- gsub(pattern = restart.path, settings$outdir, rundirs) + for(i in 1 : length(rundirs)){ + dir.create(rundirs[i]) + file.copy(from = files[i], to = newfiles[i]) + file.copy(from = readfiles[i], to = readnewfiles[i])} + file.copy(from = paste0(restart.path, '/run/runs.txt'), to = paste0(settings$outdir,'/run/runs.txt' )) + + if(!dir.exists("out")) dir.create("out",showWarnings = F) + + files <- list.files(path = file.path(restart.path, "out/"), full.names = T, recursive = T, include.dirs = T, pattern = "sipnet.out") + newfiles <- gsub(pattern = restart.path, settings$outdir, files) + outdirs <- gsub(pattern = "/sipnet.out", "", files) + outdirs <- gsub(pattern = restart.path, settings$outdir, outdirs) + for(i in 1 : length(outdirs)){ + dir.create(outdirs[i]) + file.copy(from = files[i], to = newfiles[i])} + +} + +# -------------------------------------------------------------------------------------------------- +#--------------------------------- Run state data assimilation ------------------------------------- +# -------------------------------------------------------------------------------------------------- + + +settings$host$name <- "geo.bu.edu" +settings$host$user <- 'kzarada' +settings$host$folder <- "/projectnb/dietzelab/kzarada/US_WCr_SDA_output" +settings$host$job.sh <- "module load udunits/2.2.26 R/3.5.1" +settings$host$qsub <- 'qsub -l h_rt=24:00:00 -V -N @NAME@ -o @STDOUT@ -e @STDERR@' +settings$host$qsub.jobid <- 'Your job ([0-9]+) .*' +settings$host$qstat <- 'qstat -j @JOBID@ || echo DONE' +settings$host$tunnel <- '/tmp/tunnel' +settings$model$binary = "/usr2/postdoc/istfer/SIPNET/1023/sipnet" + + +unlink(c('run','out'), recursive = T) + +#debugonce(PEcAn.assim.sequential::sda.enkf) +if ('state.data.assimilation' %in% names(settings)) { + if (PEcAn.utils::status.check("SDA") == 0) { + PEcAn.utils::status.start("SDA") + PEcAn.assim.sequential::sda.enkf( + settings, + restart=restart, + Q=0, + obs.mean = obs.mean, + obs.cov = obs.cov, + control = list( + trace = TRUE, + interactivePlot =FALSE, + TimeseriesPlot =TRUE, + BiasPlot =FALSE, + debug = FALSE, + pause=FALSE + ) + ) + + PEcAn.utils::status.end() + } +} + + diff --git a/modules/assim.sequential/inst/WillowCreek/SDA_Workflow.R b/modules/assim.sequential/inst/WillowCreek/SDA_Workflow.R new file mode 100644 index 00000000000..75b0836ab19 --- /dev/null +++ b/modules/assim.sequential/inst/WillowCreek/SDA_Workflow.R @@ -0,0 +1,594 @@ +# ---------------------------------------------------------------------- +#------------------------------------------ Load required libraries----- +# ---------------------------------------------------------------------- +library("PEcAn.all") +library("PEcAn.utils") +library("PEcAn.data.remote") +library("PEcAn.assim.sequential") +library("RCurl") +library("REddyProc") +library("tidyverse") +library("furrr") +library("R.utils") +library("dynutils") +library('nimble') +plan(multisession) + + +# ---------------------------------------------------------------------------------------------- +#------------------------------------------Prepared SDA Settings ----- +# ---------------------------------------------------------------------------------------------- + +outputPath <- "/projectnb/dietzelab/kzarada/US_WCr_SDA_output/" +nodata <- FALSE #use this to run SDA with no data +restart <- FALSE#flag to start from previous run or not +days.obs <- 3 #how many of observed data *BY HOURS* to include -- not including today +setwd(outputPath) +options(warn=-1) + + +#------------------------------------------------------------------------------------------------ +#------------------------------------------ sourcing the required tools ------------------------- +#------------------------------------------------------------------------------------------------ +c( + 'Utils.R', + 'download_WCr.R', + "gapfill_WCr.R", + 'prep.data.assim.R' +) %>% walk( ~ source( + system.file("WillowCreek", + .x, + package = "PEcAn.assim.sequential") +)) + +#------------------------------------------------------------------------------------------------ +#------------------------------------------ Preparing the pecan xml ----------------------------- +#------------------------------------------------------------------------------------------------ + +#reading xml +settings <- read.settings("/fs/data3/kzarada/pecan/modules/assim.sequential/inst/WillowCreek/testing.xml") + +#connecting to DB +con <-try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) + +#Find last SDA Run to get new start date +all.previous.sims <- list.dirs(outputPath, recursive = F) +if (length(all.previous.sims) > 0 & !inherits(con, "try-error")) { + + tryCatch({ + # Looking through all the old simulations and find the most recent + all.previous.sims <- all.previous.sims %>% + map(~ list.files(path = file.path(.x, "SDA"))) %>% + setNames(all.previous.sims) %>% + discard( ~ !"sda.output.Rdata" %in% .x) # I'm throwing out the ones that they did not have a SDA output + + last.sim <- + names(all.previous.sims) %>% + map_chr( ~ strsplit(.x, "_")[[1]][5]) %>% + map_dfr(~ db.query( + query = paste("SELECT * FROM workflows WHERE id =", .x), + con = con + ) %>% + mutate(ID=.x)) %>% + mutate(start_date = as.Date(start_date)) %>% + arrange(desc(start_date), desc(ID)) %>% + head(1) + # pulling the date and the path to the last SDA + restart.path <-grep(last.sim$ID, names(all.previous.sims), value = T) + sda.start <- last.sim$start_date+ lubridate::days(3) + }, + error = function(e) { + restart.path <- NULL + sda.start <- Sys.Date() - 9 + PEcAn.logger::logger.warn(paste0("There was a problem with finding the last successfull SDA.",conditionMessage(e))) + }) + + # if there was no older sims + if (is.na(sda.start)) + sda.start <- Sys.Date() - 9 +} +#to manually change start date +sda.start <- Sys.Date() - lubridate::days(15) +sda.end <- sda.start + lubridate::days(5) + +# Finding the right end and start date +met.start <- sda.start - lubridate::days(2) +met.end <- met.start + lubridate::days(16) + + +#----------------------------------------------------------------------------------------------- +#------------------------------------------ Download met and flux ------------------------------ +#----------------------------------------------------------------------------------------------- +#Fluxes +prep.data <- prep.data.assim( + sda.start - lubridate::days(90),# it needs at least 90 days for gap filling + sda.end, + numvals = 100, + vars = c("NEE", "LE"), + data.len = days.obs, + sda.start) + +obs.raw <-prep.data$rawobs +prep.data<-prep.data$obs + +# if there is infinte value then take it out - here we want to remove any that just have one NA in the observed data +prep.data <- prep.data %>% + map(function(day.data){ + #cheking the mean + nan.mean <- which(is.infinite(day.data$means) | is.nan(day.data$means) | is.na(day.data$means)) + if ( length(nan.mean)>0 ) { + + day.data$means <- day.data$means[-nan.mean] + day.data$covs <- day.data$covs[-nan.mean, -nan.mean] %>% + as.matrix() %>% + `colnames <-`(c(colnames(day.data$covs)[-nan.mean])) + } + day.data + }) + + +# Changing LE to Qle which is what SIPNET expects +prep.data <- prep.data %>% + map(function(day.data) { + names(day.data$means)[names(day.data$means) == "LE"] <- "Qle" + dimnames(day.data$covs) <- dimnames(day.data$covs) %>% + map(function(name) { + name[name == "LE"] <- "Qle" + name + }) + + day.data + }) + + +# -------------------------------------------------------------------------------------------------- +#---------------------------------------------- LAI DATA ------------------------------------- +# -------------------------------------------------------------------------------------------------- + +site_info <- list( + site_id = 676, + site_name = "Willow Creek", + lat = 45.805925, + lon = -90.07961, + time_zone = "UTC") + +tryCatch({ + lai <- call_MODIS(outdir = NULL, + var = 'lai', + site_info = site_info, + product_dates = c(paste0(lubridate::year(met.start), strftime(met.start, format = "%j")),paste0(lubridate::year(met.end), strftime(met.end, format = "%j"))), + run_parallel = TRUE, + ncores = NULL, + product = "MOD15A2H", + band = "Lai_500m", + package_method = "MODISTools", + QC_filter = TRUE, + progress = TRUE) + lai <- lai %>% filter(qc == "000")}, + error = function(e) { + lai <- NULL + PEcAn.logger::logger.warn(paste0("MODIS Data not available for these dates",conditionMessage(e))) + } +) +if(!exists('lai')){lai = NULL} + + +tryCatch({ + lai_sd <- call_MODIS(outdir = NULL, + var = 'lai', + site_info = site_info, + product_dates = c(paste0(lubridate::year(met.start), strftime(met.start, format = "%j")),paste0(lubridate::year(met.end), strftime(met.end, format = "%j"))), + run_parallel = TRUE, + ncores = NULL, + product = "MOD15A2H", + band = "LaiStdDev_500m", + package_method = "MODISTools", + QC_filter = TRUE, + progress = TRUE) + lai_sd <- lai_sd %>% filter(qc == "000")}, + error = function(e) { + lai_sd <- NULL + PEcAn.logger::logger.warn(paste0("MODIS Data not available for these dates",conditionMessage(e))) + } +) +if(!exists('lai_sd')){lai_sd = NULL} + +###### Pad Observed Data to forecast ############# + +date <- + seq( + from = lubridate::force_tz(as.POSIXct(last(names(prep.data)), format = "%Y-%m-%d %H:%M:%S"), tz = "UTC") + lubridate::hours(1), + to = lubridate::with_tz(as.POSIXct(first(sda.end) + lubridate::days(1), format = "%Y-%m-%d %H:%M:%S"), tz = "UTC"), + by = "1 hour" + ) + +pad.prep <- obs.raw %>% + tidyr::complete(Date = date) %>% + filter(Date %in% date) %>% + mutate(means = NA, covs = NA) %>% + dplyr::select(Date, means, covs) %>% + dynutils::tibble_as_list() + +names(pad.prep) <-date + + +#Add in LAI info + +if(is.null(lai)){index <- rep(FALSE, length(names(prep.data)))}else{ + index <- as.Date(names(prep.data)) %in% as.Date(lai$calendar_date) +} + + +for(i in 1:length(index)){ + + if(index[i]){ + lai.date <- which(as.Date(lai$calendar_date) %in% as.Date(names(prep.data))) + LAI <- c(0,0) + prep.data[[i]]$means <- c(prep.data[[i]]$means, lai$data[lai.date]) + prep.data[[i]]$covs <- rbind(cbind(prep.data[[i]]$covs, c(0, 0)), c(0,0, lai_sd$data)) + + names(prep.data[[i]]$means) <- c("NEE", "Qle", "LAI") + rownames(prep.data[[i]]$covs) <- c("NEE", "Qle", "LAI") + colnames(prep.data[[i]]$covs) <- c("NEE", "Qle", "LAI") + + } +} + +#add forecast pad to the obs data +prep.data = c(prep.data, pad.prep) + +#split into means and covs + +obs.mean <- prep.data %>% + map('means') %>% + setNames(names(prep.data)) +obs.cov <- prep.data %>% map('covs') %>% setNames(names(prep.data)) + + + + +#----------------------------------------------------------------------------------------------- +#------------------------------------------ Fixing the settings -------------------------------- +#----------------------------------------------------------------------------------------------- +#unlink existing IC files +sapply(paste0("/projectnb/dietzelab/pecan.data/dbfiles/BADM_site_0-676/IC_site_0-676_", 1:100, ".nc"), unlink) +#Using the found dates to run - this will help to download mets +settings$run$start.date <- as.character(met.start) +settings$run$end.date <- as.character(met.end) +settings$run$site$met.start <- as.character(met.start) +settings$run$site$met.end <- as.character(met.end) +#info +settings$info$date <- paste0(format(Sys.time(), "%Y/%m/%d %H:%M:%S"), " +0000") + + + + +# -------------------------------------------------------------------------------------------------- +#---------------------------------------------- PEcAn Workflow ------------------------------------- +# -------------------------------------------------------------------------------------------------- +#Update/fix/check settings. Will only run the first time it's called, unless force=TRUE +settings <- PEcAn.settings::prepare.settings(settings, force=FALSE) +setwd(settings$outdir) +ggsave( + file.path(settings$outdir, "Obs_plot.pdf"), + ploting_fluxes(obs.raw) , + width = 16, + height = 9 +) + +#Write pecan.CHECKED.xml +PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") +# start from scratch if no continue is passed in +statusFile <- file.path(settings$outdir, "STATUS") +if (length(which(commandArgs() == "--continue")) == 0 && file.exists(statusFile)) { + file.remove(statusFile) +} +# Do conversions + +######### Check for input files and insert paths ############# + con <-try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) + +#checks for .nc files for NOAA GEFS + input_check <- PEcAn.DB::dbfile.input.check( + siteid=settings$run$site$id %>% as.character(), + startdate = settings$run$start.date %>% as.Date, + enddate = settings$run$end.date %>% as.Date, + parentid = NA, + mimetype="application/x-netcdf", + formatname="CF Meteorology", + con, + hostname = PEcAn.remote::fqdn(), + exact.dates = TRUE, + pattern = "NOAA_GEFS", + return.all=TRUE + ) + +#new NOAA GEFS files were going through gapfilled so the parent +#files of the clim files were the CF_gapfilled nc files + input_check_2 <- list() + + for(i in 1:length(input_check$id)){ + input_check_2[i] <- PEcAn.DB::dbfile.input.check( + siteid=settings$run$site$id %>% as.character(), + startdate = settings$run$start.date %>% as.Date, + enddate = settings$run$end.date %>% as.Date, + parentid = input_check$container_id[i], + mimetype="application/x-netcdf", + formatname="CF Meteorology", + con, + hostname = PEcAn.remote::fqdn(), + exact.dates = TRUE, + pattern = "NOAA_GEFS", + return.all=TRUE + )$container_id + } + +#this if statement deals with the NOAA GEFS files that +#were gapfilled, and allows for us to find the clim files of the ones that weren't +#the problem here is that when we get GEFS nc files -> clim files, +#the GEFS nc files are the parent ids for finding the clim files +#but with GEFS nc -> gapfilled nc -> clim, the gapfilled files are the parent ids for the clim files +if(length(input_check_2)>1){ +input_check_2 = unlist(input_check_2) + +clim_check = list() +for(i in 1:length(input_check$id)){ + clim_check[[i]] = file.path(PEcAn.DB::dbfile.input.check( + siteid=settings$run$site$id %>% as.character(), + startdate = settings$run$start.date %>% as.Date, + enddate = settings$run$end.date %>% as.Date, + parentid = input_check_2[i], + mimetype="text/csv", + formatname="Sipnet.climna", + con, + hostname = PEcAn.remote::fqdn(), + exact.dates = TRUE, + pattern = "NOAA_GEFS", + return.all=TRUE + )$file_path, PEcAn.DB::dbfile.input.check( + siteid=settings$run$site$id %>% as.character(), + startdate = settings$run$start.date %>% as.Date, + enddate = settings$run$end.date %>% as.Date, + parentid = input_check_2[i], + mimetype="text/csv", + formatname="Sipnet.climna", + con, + hostname = PEcAn.remote::fqdn(), + exact.dates = TRUE, + pattern = "NOAA_GEFS", + return.all=TRUE + )$file_name)}}else{ + for(i in 1:length(input_check$id)){ + clim_check[[i]] = file.path(PEcAn.DB::dbfile.input.check( + siteid=settings$run$site$id %>% as.character(), + startdate = settings$run$start.date %>% as.Date, + enddate = settings$run$end.date %>% as.Date, + parentid = input_check$container_id[i], + mimetype="text/csv", + formatname="Sipnet.climna", + con, + hostname = PEcAn.remote::fqdn(), + exact.dates = TRUE, + pattern = "NOAA_GEFS", + return.all=TRUE + )$file_path, PEcAn.DB::dbfile.input.check( + siteid=settings$run$site$id %>% as.character(), + startdate = settings$run$start.date %>% as.Date, + enddate = settings$run$end.date %>% as.Date, + parentid = input_check$container_id[i], + mimetype="text/csv", + formatname="Sipnet.climna", + con, + hostname = PEcAn.remote::fqdn(), + exact.dates = TRUE, + pattern = "NOAA_GEFS", + return.all=TRUE + )$file_name)} + }#end if/else look for making clim file paths + + #If INPUTS already exists, add id and met path to settings file + + if(length(input_check$id) > 0){ + index_id = list() + index_path = list() + for(i in 1:length(input_check$id)){ + index_id[[i]] = as.character(dbfile.id(type = "Input", + file = file.path(input_check$file_path, + input_check$file_name)[i], con = con))#get ids as list + + }#end i loop for making lists + names(index_id) = sprintf("id%s",seq(1:length(input_check$id))) #rename list + names(clim_check) = sprintf("path%s",seq(1:length(input_check$id))) + + settings$run$inputs$met$id = index_id + settings$run$inputs$met$path = clim_check + } + +#still want to run this to get the IC files +settings <- PEcAn.workflow::do_conversions(settings) #end if loop for existing inputs + + # if(is_empty(settings$run$inputs$met$path) & length(clim_check)>0){ +# settings$run$inputs$met$id = index_id +# settings$run$inputs$met$path = clim_check +# } + + +# PEcAn.DB::db.close(con) +# Query the trait database for data and priors +if (PEcAn.utils::status.check("TRAIT") == 0) { + PEcAn.utils::status.start("TRAIT") + settings <- PEcAn.workflow::runModule.get.trait.data(settings) + PEcAn.settings::write.settings(settings, outputfile = 'pecan.TRAIT.xml') + PEcAn.utils::status.end() +} else if (file.exists(file.path(settings$outdir, 'pecan.TRAIT.xml'))) { + settings <- + PEcAn.settings::read.settings(file.path(settings$outdir, 'pecan.TRAIT.xml')) +} +# Run the PEcAn meta.analysis +if (!is.null(settings$meta.analysis)) { + if (PEcAn.utils::status.check("META") == 0) { + PEcAn.utils::status.start("META") + PEcAn.MA::runModule.run.meta.analysis(settings) + PEcAn.utils::status.end() + } +} +#sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, ens.sample.method = settings$ensemble$samplingspace$parameters$method) +# Setting dates in assimilation tags - This will help with preprocess split in SDA code +settings$state.data.assimilation$start.date <-as.character(first(names(obs.mean))) +settings$state.data.assimilation$end.date <-as.character(last(names(obs.mean))) + +if (nodata) { + obs.mean <- obs.mean %>% map(function(x) + return(NA)) + obs.cov <- obs.cov %>% map(function(x) + return(NA)) +} + +# -------------------------------------------------------------------------------------------------- +#--------------------------------- Restart ------------------------------------- +# -------------------------------------------------------------------------------------------------- + +if(restart == TRUE){ + if(!dir.exists("SDA")) dir.create("SDA",showWarnings = F) + + #Update the SDA Output to just have last time step + temp<- new.env() + load(file.path(restart.path, "SDA", "sda.output.Rdata"), envir = temp) + temp <- as.list(temp) + + #we want ANALYSIS, FORECAST, and enkf.parms to match up with how many days obs data we have + # +24 because it's hourly now and we want the next day as the start + if(length(temp$ANALYSIS) > 1){ + + for(i in 1:days.obs + 1){ + temp$ANALYSIS[[i]] <- temp$ANALYSIS[[i + 24]] + } + for(i in rev((days.obs + 2):length(temp$ANALYSIS))){ + temp$ANALYSIS[[i]] <- NULL + } + + + for(i in 1:days.obs + 1){ + temp$FORECAST[[i]] <- temp$FORECAST[[i + 24]] + } + for(i in rev((days.obs + 2):length(temp$FORECAST))){ + temp$FORECAST[[i]] <- NULL + } + + for(i in 1:days.obs + 1){ + temp$enkf.params[[i]] <- temp$enkf.params[[i + 24]] + } + for(i in rev((days.obs + 2):length(temp$enkf.params))){ + temp$enkf.params[[i]] <- NULL + } + + } + temp$t = 1 + + #change inputs path to match sampling met paths + + for(i in 1: length(temp$inputs$ids)){ + + temp$inputs$samples[i] <- settings$run$inputs$met$path[temp$inputs$ids[i]] + + } + + temp1<- new.env() + list2env(temp, envir = temp1) + save(list = c("ANALYSIS", 'FORECAST', "enkf.params", "ensemble.id", "ensemble.samples", 'inputs', 'new.params', 'new.state', 'run.id', 'site.locs', 't', 'Viz.output', 'X'), + envir = temp1, + file = file.path(settings$outdir, "SDA", "sda.output.Rdata")) + + + + temp.out <- new.env() + load(file.path(restart.path, "SDA", 'outconfig.Rdata'), envir = temp.out) + temp.out <- as.list(temp.out) + temp.out$outconfig$samples <- NULL + + temp.out1 <- new.env() + list2env(temp.out, envir = temp.out1) + save(list = c('outconfig'), + envir = temp.out1, + file = file.path(settings$outdir, "SDA", "outconfig.Rdata")) + + + + #copy over run and out folders + + if(!dir.exists("run")) dir.create("run",showWarnings = F) + + files <- list.files(path = file.path(restart.path, "run/"), full.names = T, recursive = T, include.dirs = T, pattern = "sipnet.clim") + readfiles <- list.files(path = file.path(restart.path, "run/"), full.names = T, recursive = T, include.dirs = T, pattern = "README.txt") + + newfiles <- gsub(pattern = restart.path, settings$outdir, files) + readnewfiles <- gsub(pattern = restart.path, settings$outdir, readfiles) + + rundirs <- gsub(pattern = "/sipnet.clim", "", files) + rundirs <- gsub(pattern = restart.path, settings$outdir, rundirs) + for(i in 1 : length(rundirs)){ + dir.create(rundirs[i]) + file.copy(from = files[i], to = newfiles[i]) + file.copy(from = readfiles[i], to = readnewfiles[i])} + file.copy(from = paste0(restart.path, '/run/runs.txt'), to = paste0(settings$outdir,'/run/runs.txt' )) + + if(!dir.exists("out")) dir.create("out",showWarnings = F) + + files <- list.files(path = file.path(restart.path, "out/"), full.names = T, recursive = T, include.dirs = T, pattern = "sipnet.out") + newfiles <- gsub(pattern = restart.path, settings$outdir, files) + outdirs <- gsub(pattern = "/sipnet.out", "", files) + outdirs <- gsub(pattern = restart.path, settings$outdir, outdirs) + for(i in 1 : length(outdirs)){ + dir.create(outdirs[i]) + file.copy(from = files[i], to = newfiles[i])} + +} +# -------------------------------------------------------------------------------------------------- +#--------------------------------- Run state data assimilation ------------------------------------- +# -------------------------------------------------------------------------------------------------- + +settings$host$name <- "geo.bu.edu" +settings$host$user <- 'kzarada' +settings$host$folder <- "/projectnb/dietzelab/kzarada/US_WCr_SDA_output" +settings$host$job.sh <- "module load udunits/2.2.26 R/3.5.1" +settings$host$qsub <- 'qsub -l h_rt=24:00:00 -V -N @NAME@ -o @STDOUT@ -e @STDERR@' +settings$host$qsub.jobid <- 'Your job ([0-9]+) .*' +settings$host$qstat <- 'qstat -j @JOBID@ || echo DONE' +settings$host$tunnel <- '/tmp/tunnel' +settings$model$binary = "/usr2/postdoc/istfer/SIPNET/1023/sipnet" + + +source('/fs/data3/kzarada/pecan/modules/assim.sequential/R/Nimble_codes.R') + + +if(restart == FALSE) unlink(c('run','out','SDA'), recursive = T) +debugonce(PEcAn.assim.sequential::sda.enkf) + +if ('state.data.assimilation' %in% names(settings)) { + if (PEcAn.utils::status.check("SDA") == 0) { + PEcAn.utils::status.start("SDA") + PEcAn.assim.sequential::sda.enkf( + settings, + restart=restart, + Q=0, + obs.mean = obs.mean, + obs.cov = obs.cov, + control = list( + trace = TRUE, + interactivePlot =FALSE, + TimeseriesPlot =TRUE, + BiasPlot =FALSE, + debug = FALSE, + pause=FALSE + ) + ) + + PEcAn.utils::status.end() + } +} + + + + + diff --git a/modules/assim.sequential/inst/WillowCreek/download_WCr.R b/modules/assim.sequential/inst/WillowCreek/download_WCr.R index daae2ce711d..9a541b63f8a 100644 --- a/modules/assim.sequential/inst/WillowCreek/download_WCr.R +++ b/modules/assim.sequential/inst/WillowCreek/download_WCr.R @@ -28,8 +28,14 @@ download_US_WCr_met <- function(start_date, end_date) { mutate_all(funs(as.numeric)) #Constructing the date based on the columns we have - raw.data$date <-as.POSIXct(paste0(raw.data$V1,"/",raw.data$V2,"/",raw.data$V3," ", raw.data$V4 %>% as.integer(), ":",(raw.data$V4-as.integer(raw.data$V4))*60), - format="%Y/%m/%d %H:%M", tz="UTC") + #Converting the WCR data from CST to UTC + raw.data$date <-lubridate::with_tz(as.POSIXct(paste0(raw.data$V1,"/",raw.data$V2,"/",raw.data$V3," ", raw.data$V4 %>% as.integer(), ":",(raw.data$V4-as.integer(raw.data$V4))*60), + format="%Y/%m/%d %H:%M", tz="US/Central"), tz = "UTC") + + + + start_date <- as.POSIXct(start_date, format = "%Y-%m-%d", tz = "UTC") + end_date <- as.POSIXct(end_date, format = "%Y-%m-%d", tz = "UTC") # Some cleaning and filtering raw.data <- raw.data %>% dplyr::select(V1,V2,V3,V4,V5, V6, V26, V35, V40, V59, date) %>% @@ -37,7 +43,7 @@ download_US_WCr_met <- function(start_date, end_date) { #Colnames changed colnames(raw.data) <- c("Year", "Month", "Day", "Hour", "DoY", "FjDay", "Tair", "rH", "Tsoil", "Rg", "date") - + return(raw.data) } @@ -73,13 +79,16 @@ download_US_WCr_flux <- function(start_date, end_date) { #Constructing the date based on the columns we have raw.data$date <-as.POSIXct(paste0(raw.data$V1,"/",raw.data$V2,"/",raw.data$V3," ", raw.data$V4 %>% as.integer(), ":",(raw.data$V4-as.integer(raw.data$V4))*60), format="%Y/%m/%d %H:%M", tz="UTC") + + start_date <- as.POSIXct(start_date, format = "%Y-%m-%d", tz = "UTC") + end_date <- as.POSIXct(end_date, format = "%Y-%m-%d", tz = "UTC") + # Some cleaning and filtering raw.data <- raw.data %>% # select(-V5, -V6) %>% - filter(date >= start_date & date <=end_date) - + filter(date >= start_date & date <=end_date) #Colnames changed colnames(raw.data) <- c("Year", "Month", "Day", "Hour", "DoY", "FjDay", "SC", "FC", "NEE", "LE", "H", "Ustar", "Flag", "date") return(raw.data) -} \ No newline at end of file +} diff --git a/modules/assim.sequential/inst/WillowCreek/download_soilmoist_WCr.R b/modules/assim.sequential/inst/WillowCreek/download_soilmoist_WCr.R new file mode 100644 index 00000000000..1d4063160cb --- /dev/null +++ b/modules/assim.sequential/inst/WillowCreek/download_soilmoist_WCr.R @@ -0,0 +1,45 @@ +download_soilmoist_WCr <- function(start_date, end_date) { + base_url <- "http://co2.aos.wisc.edu/data/cheas/wcreek/flux/prelim/clean/ameriflux/US-WCr_HH_" + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + + # Reading in the data + raw.data <- start_year:end_year %>% + purrr::map_df(function(syear) { + influx <- + tryCatch( + read.table( + paste0(base_url, syear, "01010000_", syear+1, "01010000.csv"), + sep = ",", + header = TRUE, stringsAsFactors = F + ) %>% + apply(2, trimws) %>% + apply(2, as.character) %>% + data.frame(stringsAsFactors = F), + error = function(e) { + NULL + }, + warning = function(e) { + NULL + } + ) + }) %>% + mutate_all(funs(as.numeric)) + + #Constructing the date based on the columns we have + if(dim(raw.data)[1] > 0 & dim(raw.data)[2] > 0){ + raw.data$Time <-as.POSIXct(as.character(raw.data$TIMESTAMP_START), + format="%Y%m%d%H%M", tz="UTC") + # Some cleaning and filtering + raw.data <- raw.data %>% + dplyr::select(SWC_1_1_1, SWC_1_2_1, SWC_1_3_1, SWC_1_4_1, SWC_1_5_1, Time) %>% + na_if(-9999) %>% + filter(Time >= start_date & Time <=end_date) + + #get average soil moisture + + raw.data$avgsoil <- raw.data$SWC_1_2_1*0.12 + raw.data$SWC_1_3_1*0.16 + raw.data$SWC_1_4_1*0.32 + raw.data$SWC_1_5_1*0.4 + raw.data <- raw.data %>% dplyr::select(Time, avgsoil) + }else(raw.data <- NULL) + return(raw.data) +} \ No newline at end of file diff --git a/modules/assim.sequential/inst/WillowCreek/forecast.sh b/modules/assim.sequential/inst/WillowCreek/forecast.sh new file mode 100755 index 00000000000..bff7dad77d2 --- /dev/null +++ b/modules/assim.sequential/inst/WillowCreek/forecast.sh @@ -0,0 +1 @@ +Rscript "/fs/data3/kzarada/pecan/modules/assim.sequential/inst/WillowCreek/workflow.template.R" \ No newline at end of file diff --git a/modules/assim.sequential/inst/WillowCreek/gapfill_WCr.R b/modules/assim.sequential/inst/WillowCreek/gapfill_WCr.R index 4c8ca90df3d..6d1ecca1358 100644 --- a/modules/assim.sequential/inst/WillowCreek/gapfill_WCr.R +++ b/modules/assim.sequential/inst/WillowCreek/gapfill_WCr.R @@ -16,61 +16,55 @@ gapfill_WCr <- function(start_date, end_date, FUN.flux=download_US_WCr_flux){ -start_date <- as.Date(start_date) -end_date <- as.Date(end_date) - -#download WCr flux and met date -flux <- FUN.flux(start_date, end_date) -met <- FUN.met(start_date, end_date) -# converting NEE and LE -#change -999 to NA's -flux[flux == -999] <- NA -flux$NEE<-PEcAn.utils::misc.convert(flux$NEE, "umol C m-2 s-1", "kg C m-2 s-1") -flux$LE<-flux$LE*1e-6 -#join met and flux data by date (which includes time and day) -met <- met %>% dplyr::select(date, Tair, Rg, Tsoil) -flux <- left_join(flux, met, by = "date") %>% - dplyr::select(-FjDay, -SC, -FC) -#print(str(flux)) - - -#Start REddyProc gapfilling -suppressWarnings({ - - EddyDataWithPosix.F <- - fConvertTimeToPosix(flux, - 'YDH', - Year.s = 'Year' - , - Day.s = 'DoY', - Hour.s = 'Hour') %>% - dplyr::select(-date,-Month,-Day) -}) - - -EddyProc.C <- sEddyProc$new('WCr', EddyDataWithPosix.F, - c(var,'Rg','Tair', 'Ustar')) - -tryCatch( - { - EddyProc.C$sMDSGapFill(var) - }, - error = function(e) { - PEcAn.logger::logger.warn(e) - } -) - -#Merging the output -FilledEddyData.F <- EddyProc.C$sExportResults() -CombinedData.F <- cbind(flux, FilledEddyData.F) - -return(CombinedData.F) - + start_date <- as.Date(start_date) + end_date <- as.Date(end_date) + + #download WCr flux and met date + flux <- FUN.flux(start_date, end_date) + met <- FUN.met(start_date, end_date) + # converting NEE and LE + #change -999 to NA's + flux[flux == -999] <- NA #want both NEE and LE to be larger numbers + #flux$NEE<-PEcAn.utils::misc.convert(flux$NEE, "umol C m-2 s-1", "kg C m-2 s-1") + #flux$LE<-flux$LE*1e-6 + #join met and flux data by date (which includes time and day) + met <- met %>% dplyr::select(date, Tair, Rg, Tsoil) + flux <- left_join(flux, met, by = "date") %>% + dplyr::select(-FjDay, -SC, -FC) %>% + distinct(date, .keep_all = TRUE) + #print(str(flux)) + + + #Start REddyProc gapfilling + suppressWarnings({ + + EddyDataWithPosix.F <- + fConvertTimeToPosix(flux, + 'YDH', + Year.s = 'Year' + , + Day.s = 'DoY', + Hour.s = 'Hour') %>% + dplyr::select(-date,-Month,-Day) %>% + distinct(DateTime, .keep_all = TRUE) + }) + + + EddyProc.C <- sEddyProc$new('WCr', EddyDataWithPosix.F, + c(var,'Rg','Tair', 'Ustar')) + + tryCatch( + { + EddyProc.C$sMDSGapFill(var) + }, + error = function(e) { + PEcAn.logger::logger.warn(e) + } + ) + + #Merging the output + FilledEddyData.F <- EddyProc.C$sExportResults() + CombinedData.F <- cbind(flux, FilledEddyData.F) + + return(CombinedData.F) } - - - - - - - diff --git a/modules/assim.sequential/inst/WillowCreek/nodata.xml b/modules/assim.sequential/inst/WillowCreek/nodata.xml new file mode 100644 index 00000000000..2623ae9571a --- /dev/null +++ b/modules/assim.sequential/inst/WillowCreek/nodata.xml @@ -0,0 +1,191 @@ + + + + FALSE + TRUE + TRUE + + 1000000040 + 1000013298 + + + + 1000013298 + direct + 0 + 9999 + + AbvGrndWood + + + + 1000013298 + direct + -9999 + 9999 + + NEE + + + + 1000013298 + direct + 0 + 9999 + + Qle + + + + 1000013298 + direct + 0 + 9999 + + LAI + + + + 1000013298 + direct + 0 + 9999 + + TotSoilCarb + + + + 1000013298 + direct + 0 + 1 + + SoilMoistFrac + + + + 1000013298 + direct + 0 + 9999 + + litter_carbon_content + + + + + + AbvGrndWood + 0 + 9999 + + + NEE + umol C m-2 s-1 + -9999 + 9999 + + + Qle + 0 + 9999 + + + LAI + 0 + 9999 + + + TotSoilCarb + 0 + 9999 + + + SoilMoistFrac + 0 + 1 + + + litter_carbon_content + 0 + 9999 + + + day + 2017-01-01 + 2018-11-05 + 1 + + + LE fix + -1 + + 2019/01/04 10:19:35 +0000 + + + + bety + bety + psql-pecan.bu.edu + bety + PostgreSQL + TRUE + + /projectnb/dietzelab/pecan.data/dbfiles/ + + + + temperate.deciduous.ALL + + 1 + + 1000012409 + + + + 3000 + FALSE + + + 100 + NEE + 2020 + 2020 + + + uniform + + + sampling + + + sampling + + + + + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + 1000000030 + + + + 676 + 2018-08-26 + 2018-09-23 + + + + BADM + + + NOAA_GEFS + SIPNET + + + 2018-12-05 + 2018-12-20 + + + localhost + + \ No newline at end of file diff --git a/modules/assim.sequential/inst/WillowCreek/prep.data.assim.R b/modules/assim.sequential/inst/WillowCreek/prep.data.assim.R index 06f470a6946..6791d97112a 100644 --- a/modules/assim.sequential/inst/WillowCreek/prep.data.assim.R +++ b/modules/assim.sequential/inst/WillowCreek/prep.data.assim.R @@ -10,35 +10,33 @@ ##'@return None ##'@export ##'@author Luke Dramko and K. Zarada and Hamze Dokoohaki -prep.data.assim <- function(start_date, end_date, numvals, vars, data.len = 48) { - - data.len = data.len *2 #turn hour time steps into half hour +prep.data.assim <- function(start_date, end_date, numvals, vars, data.len = 3, sda.start) { Date.vec <-NULL - - gapfilled.vars <- vars %>% - purrr::map_dfc(function(var) { - - field_data <- gapfill_WCr(start_date, end_date, var) - PEcAn.logger::logger.info(paste(var, " is done")) - #I'm sending the date out to use it later on - return(field_data) + gapfilled.vars <- vars %>% + purrr::map_dfc(function(var) { + + field_data <- gapfill_WCr(start_date, end_date, var) + + PEcAn.logger::logger.info(paste(var, " is done")) + #I'm sending the date out to use it later on + return(field_data) }) - - + + #gapfilled.vars$NEE_f = PEcAn.utils::misc.convert(gapfilled.vars$NEE_f, "kg C m-2 s-1", "umol C m-2 s-1") + #Reading the columns we need cols <- grep(paste0("_*_f$"), colnames(gapfilled.vars), value = TRUE) - gapfilled.vars <- gapfilled.vars %>% dplyr::select(Date=date, Flag,cols) - - #Creating NEE and LE filled output + gapfilled.vars <- gapfilled.vars %>% dplyr::select(Date=date...11, Flag = Flag...10,cols) + + #Creating NEE and LE filled output gapfilled.vars.out <- gapfilled.vars %>% dplyr::select(-Flag) %>% - tail(data.len) - - #Pecan Flux Uncertainty + filter(Date >= (sda.start - lubridate::days(data.len)) & Date < sda.start) + + #Pecan Flux Uncertainty processed.flux <- 3:(3+length(vars)-1) %>% purrr::map(function(col.num) { - field_data <- gapfilled.vars[,c(1,2,col.num)] uncertainty_vals <- list() @@ -53,7 +51,7 @@ prep.data.assim <- function(start_date, end_date, numvals, vars, data.len = 48) # Create proxy row for rbinding random_mat = NULL new_col = rep(0, dim(field_data)[1]) - + # Create a new column # i: the particular variable being worked with; j: the column number; k: the row number for (j in 1:numvals) { @@ -70,53 +68,53 @@ prep.data.assim <- function(start_date, end_date, numvals, vars, data.len = 48) random_multiplier <- sample(c(-1, 1), length(res), replace = TRUE) simulated <- obs + (random_multiplier * res) - - random_mat = cbind(random_mat, simulated) - } # end j - obs.mean <- c(obs.mean, mean(field_data[, 3], na.rm = TRUE)) - # this keeps the mean of each day for the whole time series and all variables - sums = c(sums, list(random_mat)) - - data.frame(Date=field_data$Date,sums) + random_mat = cbind(random_mat, simulated) + } # end j + + obs.mean <- c(obs.mean, mean(field_data[, 3], na.rm = TRUE)) + # this keeps the mean of each day for the whole time series and all variables + sums = c(sums, list(random_mat)) + + data.frame(Date=field_data$Date[!is.na(field_data[, 3])],sums) }) # end of map - - #I'm sending mixing up simulations of vars to aggregate them first and then estimate their var/cov + + + #I'm sending mixing up simulations of vars to aggregate them first and then estimate their var/cov outlist<-processed.flux %>% - map2_dfc(vars, function(x, xnames) { - names(x)[2:numvals] <- paste0(names(x)[2:numvals], xnames) - - x %>% - tail(data.len) %>% - mutate(Interval = lubridate::round_date(Date, "6 hour")) %>% - dplyr::select(-Date) - }) %>% - split(.$Interval) %>% - map(function(row) { - - #fidning the interval cols / taking them out - colsDates <- grep(paste0("Interval"), colnames(row), value = FALSE) - Date1 <- row[, colsDates[1]] - row <- row[, -c(colsDates)] - # finding the order of columns in dataframe - var.order <- split(1:ncol(row), - ceiling(seq_along(1:ncol(row))/(ncol(row)/length(vars)))) - - #combine all the numbers for this time interval - alldata <- var.order %>% - map_dfc(~row[,.x] %>% unlist %>% as.numeric) %>% - setNames(vars) - # mean and the cov between all the state variables is estimated here - return(list( - Date = Date1 %>% unique(), - covs = cov(alldata), - means = apply(alldata, 2, mean) - )) - }) + map2_dfc(vars, function(x, xnames) { + names(x)[2:numvals] <- paste0(names(x)[2:numvals], xnames) + + x %>% + filter(Date >= (sda.start - lubridate::hours(data.len)) & Date < sda.start) %>% + mutate(Interval = lubridate::round_date(Date, "1 hour")) %>% + dplyr::select(-Date) + }) %>% + split(.$Interval...202) %>% + map(function(row) { + + #fidning the interval cols / taking them out + colsDates <- grep(paste0("Interval"), colnames(row), value = FALSE) + Date1 <- row[, colsDates[1]] + row <- row[, -c(colsDates)] + # finding the order of columns in dataframe + var.order <- split(1:ncol(row), + ceiling(seq_along(1:ncol(row))/(ncol(row)/length(vars)))) + + #combine all the numbers for this time interval + alldata <- var.order %>% + map_dfc(~row[,.x] %>% unlist %>% as.numeric) %>% + setNames(vars) + # mean and the cov between all the state variables is estimated here + return(list( + Date = Date1 %>% unique(), + covs = cov(alldata), + means = apply(alldata, 2, mean) + )) + }) outlist <- list(obs=outlist, rawobs=gapfilled.vars.out ) return(outlist) - + } # prep.data.assim - diff --git a/modules/assim.sequential/inst/WillowCreek/gefs.sipnet.template.xml b/modules/assim.sequential/inst/WillowCreek/testing.xml similarity index 50% rename from modules/assim.sequential/inst/WillowCreek/gefs.sipnet.template.xml rename to modules/assim.sequential/inst/WillowCreek/testing.xml index 48b2dec67a2..722984b9677 100644 --- a/modules/assim.sequential/inst/WillowCreek/gefs.sipnet.template.xml +++ b/modules/assim.sequential/inst/WillowCreek/testing.xml @@ -1,53 +1,84 @@ - FALSE + TRUE TRUE + TRUE 1000000040 1000013298 + + + 1000013298 + direct + -9999 + 9999 + + NEE + + + + 1000013298 + direct + 0 + 9999 + + Qle + + + NEE - MgC/ha/yr + umol C m-2 s-1 -9999 9999 + 1000000000 - + Qle - MW/m2 - -9999 + mW m-2 + 0 + 9999 + 100 + + + AbvGrndWood + 0 9999 + + LAI + 0 + 9999 + + + TotSoilCarb + 0 + 9999 + SoilMoistFrac - m/m 0 - 9999 - - - SWE - kg/m^2 - 0 - 9999 + 1 - litter_carbon_content - kgC/m2 - 0 - 9999 + litter_carbon_content + 0 + 9999 year 2017-01-01 2018-11-05 + 50 - + LE fix -1 - 2018/09/07 14:52:35 +0000 + 2019/01/04 10:19:35 +0000 @@ -58,14 +89,15 @@ PostgreSQL TRUE - /fs/data3/kzarada/pecan.data/dbfiles/ + /projectnb/dietzelab/pecan.data/dbfiles/ - - temperate.deciduous + + temperate.deciduous.ALL 1 + 1000012409 @@ -84,11 +116,14 @@ sampling + + sampling + - 10 - /fs/data3/kzarada/US_WCr/data/WillowCreek.param + /fs/data3/kzarada/US_WCr/data/WillowCreek.param + 1000000030 @@ -97,15 +132,18 @@ 2018-09-23 + + BADM + NOAA_GEFS SIPNET - 2018-11-05 - 2018-11-20 + 2018-12-05 + 2018-12-20 - - localhost - + + localhost + diff --git a/modules/assim.sequential/inst/WillowCreek/workflow.template.R b/modules/assim.sequential/inst/WillowCreek/workflow.template.R old mode 100644 new mode 100755 index ca27c78d7bc..b4adcacce38 --- a/modules/assim.sequential/inst/WillowCreek/workflow.template.R +++ b/modules/assim.sequential/inst/WillowCreek/workflow.template.R @@ -1,17 +1,20 @@ # ---------------------------------------------------------------------- #------------------------------------------ Load required libraries----- # ---------------------------------------------------------------------- -library(PEcAn.all) -library(PEcAn.utils) -library(RCurl) -library(REddyProc) -library(tidyverse) -library(furrr) +library("PEcAn.all") +library("PEcAn.utils") +library("RCurl") +library("REddyProc") +library("tidyverse") +library("furrr") +library("R.utils") +library("dynutils") plan(multiprocess) + # ---------------------------------------------------------------------------------------------- #------------------------------------------ That's all we need xml path and the out folder ----- # ---------------------------------------------------------------------------------------------- -args <- commandArgs(trailingOnly = TRUE) +args = c("/fs/data3/kzarada/ouput", FALSE, "gefs.sipnet.template.xml", TRUE, 3) if (is.na(args[1])){ outputPath <- "/fs/data3/kzarada/ouput" @@ -30,6 +33,19 @@ if (is.na(args[3])){ } else { xmlTempName <- args[3] } + +if (is.na(args[4])){ + restart <-TRUE +} else { + restart <- args[4] +} + +if (is.na(args[5])){ + days.obs <- 3 #how many of observed data to include -- not including today +} else { + days.obs <- as.numeric(args[5]) +} + setwd(outputPath) #------------------------------------------------------------------------------------------------ #------------------------------------------ sourcing the required tools ------------------------- @@ -45,9 +61,7 @@ c( package = "PEcAn.assim.sequential") )) #reading xml -settings <- read.settings(system.file("WillowCreek", - xmlTempName, - package ="PEcAn.assim.sequential" )) +settings <- read.settings("/fs/data3/kzarada/pecan/modules/assim.sequential/inst/WillowCreek/gefs.sipnet.template.xml") #connecting to DB con <-try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) @@ -57,7 +71,6 @@ con <-try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) #------------------------------------------------------------------------------------------------ #--------------------------- Finding old sims all.previous.sims <- list.dirs(outputPath, recursive = F) - if (length(all.previous.sims) > 0 & !inherits(con, "try-error")) { tryCatch({ @@ -76,25 +89,24 @@ if (length(all.previous.sims) > 0 & !inherits(con, "try-error")) { ) %>% mutate(ID=.x)) %>% mutate(started_at = as.Date(started_at)) %>% - arrange(desc(started_at)) %>% + arrange(desc(started_at), desc(ID)) %>% head(1) # pulling the date and the path to the last SDA restart.path <-grep(last.sim$ID, names(all.previous.sims), value = T) sda.start <- last.sim$started_at - }, - error = function(e) { - restart.path <- NULL - sda.start <- Sys.Date() - 14 - PEcAn.logger::logger.warn(paste0("There was a problem with finding the last successfull SDA.",conditionMessage(e))) - }) - + }, + error = function(e) { + restart.path <- NULL + sda.start <- Sys.Date() - 12 + PEcAn.logger::logger.warn(paste0("There was a problem with finding the last successfull SDA.",conditionMessage(e))) + }) + # if there was no older sims if (is.na(sda.start)) - sda.start <- Sys.Date() - 14 + sda.start <- Sys.Date() - 12 } sda.end <- Sys.Date() - #----------------------------------------------------------------------------------------------- #------------------------------------------ Download met and flux ------------------------------ #----------------------------------------------------------------------------------------------- @@ -105,23 +117,111 @@ if(!exists('prep.data')) sda.end, numvals = 100, vars = c("NEE", "LE"), - data.len = 168 # This is 7 days + data.len = days.obs * 24 ) obs.raw <-prep.data$rawobs prep.data<-prep.data$obs + + +# if there is infinte value then take it out - here we want to remove any that just have one NA in the observed data +prep.data <- prep.data %>% + map(function(day.data){ + #cheking the mean + nan.mean <- which(is.infinite(day.data$means) | is.nan(day.data$means) | is.na(day.data$means)) + if ( length(nan.mean)>0 ) { + + day.data$means <- day.data$means[-nan.mean] + day.data$covs <- day.data$covs[-nan.mean, -nan.mean] %>% + as.matrix() %>% + `colnames <-`(c(colnames(day.data$covs)[-nan.mean])) + } + day.data + }) + + +# Changing LE to Qle which is what sipnet expects +prep.data <- prep.data %>% + map(function(day.data) { + names(day.data$means)[names(day.data$means) == "LE"] <- "Qle" + dimnames(day.data$covs) <- dimnames(day.data$covs) %>% + map(function(name) { + name[name == "LE"] <- "Qle" + name + }) + + day.data + }) + + + +# Finding the right end and start date +met.start <- obs.raw$Date%>% head(1) %>% lubridate::floor_date(unit = "day") +met.end <- met.start + lubridate::days(16) + +#pad Observed Data to match met data + +date <- + seq( + from = lubridate::with_tz(as.POSIXct(first(sda.end), format = "%Y-%m-%d"), tz = "UTC") + lubridate::days(1), + to = lubridate::with_tz(as.POSIXct(met.end - lubridate::days(1), format = "%Y-%m-%d"), tz = "UTC"), + by = "6 hour" + ) +pad.prep <- obs.raw %>% + tidyr::complete(Date = seq( + from = lubridate::with_tz(as.POSIXct(first(sda.end), format = "%Y-%m-%d"), tz = "UTC") + lubridate::days(1), + to = lubridate::with_tz(as.POSIXct(met.end - lubridate::days(1), format = "%Y-%m-%d"), tz = "UTC"), + by = "6 hour" + )) %>% + mutate(means = NA, covs = NA) %>% + dplyr::select(Date, means, covs) %>% + dynutils::tibble_as_list() + +names(pad.prep) <-date + +#create the data type to match the other data +pad.cov <- matrix(data = c(rep(NA, 4)), nrow = 2, ncol = 2, dimnames = list(c("NEE", "Qle"), c("NEE", "Qle"))) +pad.means = c(NA, NA) +names(pad.means) <- c("NEE", "Qle") + +#cycle through and populate the list + +pad <- pad.prep %>% + map(function(day.data){ + day.data$means <- pad.means + day.data$covs <- pad.cov + day.data + }) + + +#add onto end of prep.data list + +prep.data = c(prep.data, pad) + + # This line is what makes the SDA to run daily ***** IMPORTANT CODE OVER HERE prep.data<-prep.data %>% discard(~lubridate::hour(.x$Date)!=0) -# Finding the right end and start date -met.start <- obs.raw$Date%>% head(1) %>% lubridate::floor_date(unit = "day") -met.end <- obs.raw$Date %>% tail(1) %>% lubridate::ceiling_date(unit = "day") + +obs.mean <- prep.data %>% map('means') %>% setNames(names(prep.data)) +obs.cov <- prep.data %>% map('covs') %>% setNames(names(prep.data)) + + + + + + + + + #----------------------------------------------------------------------------------------------- #------------------------------------------ Fixing the settings -------------------------------- #----------------------------------------------------------------------------------------------- #Using the found dates to run - this will help to download mets settings$run$start.date <- as.character(met.start) -settings$run$end.date <- as.character(met.end) +settings$run$end.date <- as.character(last(date)) +settings$run$site$met.start <- as.character(met.start) +settings$run$site$met.end <- as.character(met.end) #info settings$info$date <- paste0(format(Sys.time(), "%Y/%m/%d %H:%M:%S"), " +0000") # -------------------------------------------------------------------------------------------------- @@ -170,21 +270,6 @@ get.parameter.samples(settings, ens.sample.method = settings$ensemble$samplingsp # Setting dates in assimilation tags - This will help with preprocess split in SDA code settings$state.data.assimilation$start.date <-as.character(met.start) settings$state.data.assimilation$end.date <-as.character(met.end - lubridate::hms("06:00:00")) -# Changing LE to Qle which is what sipnet expects -prep.data <- prep.data %>% - map(function(day.data) { - names(day.data$means)[names(day.data$means) == "LE"] <- "Qle" - dimnames(day.data$covs) <- dimnames(day.data$covs) %>% - map(function(name) { - name[name == "LE"] <- "Qle" - name - }) - - day.data - }) - -obs.mean <- prep.data %>% map('means') %>% setNames(names(prep.data)) -obs.cov <- prep.data %>% map('covs') %>% setNames(names(prep.data)) if (nodata) { obs.mean <- obs.mean %>% map(function(x) @@ -192,18 +277,90 @@ if (nodata) { obs.cov <- obs.cov %>% map(function(x) return(NA)) } + +# -------------------------------------------------------------------------------------------------- +#--------------------------------- Restart ------------------------------------- # -------------------------------------------------------------------------------------------------- + +#@Hamze - should we add a if statement here for the times that we don't want to copy the path? +# @Hamze: Yes if restart == TRUE +if(restart == TRUE){ + if(!dir.exists("SDA")) dir.create("SDA",showWarnings = F) + + #Update the SDA Output to just have last time step + temp<- new.env() + load(file.path(restart.path, "SDA", "sda.output.Rdata"), envir = temp) + temp <- as.list(temp) + + #we want ANALYSIS, FORECAST, and enkf.parms to match up with how many days obs data we have + # +2 for days.obs since today is not included in the number. So we want to keep today and any other obs data + if(length(temp$ANALYSIS) > 1){ + for(i in rev((days.obs + 2):length(temp$ANALYSIS))){ + temp$ANALYSIS[[i]] <- NULL + } + + for(i in rev((days.obs + 2):length(temp$FORECAST))){ + temp$FORECAST[[i]] <- NULL + } + + + for(i in rev((days.obs + 2):length(temp$enkf.params))){ + temp$enkf.params[[i]] <- NULL + } + } + + temp$t = 1 + + #change inputs path to match sampling met paths + + for(i in 1: length(temp$inputs$ids)){ + + temp$inputs$samples[i] <- settings$run$inputs$met$path[temp$inputs$ids[i]] + + } + + temp1<- new.env() + list2env(temp, envir = temp1) + save(list = c("ANALYSIS", 'FORECAST', "enkf.params", "ensemble.id", "ensemble.samples", 'inputs', 'new.params', 'new.state', 'run.id', 'site.locs', 't', 'Viz.output', 'X'), + envir = temp1, + file = file.path(settings$outdir, "SDA", "sda.output.Rdata")) + + + + temp.out <- new.env() + load(file.path(restart.path, "SDA", 'outconfig.Rdata'), envir = temp.out) + temp.out <- as.list(temp.out) + temp.out$outconfig$samples <- NULL + + temp.out1 <- new.env() + list2env(temp.out, envir = temp.out1) + save(list = c('outconfig'), + envir = temp.out1, + file = file.path(settings$outdir, "SDA", "outconfig.Rdata")) + + + +#copy over run and out folders + + if(!dir.exists("run")) dir.create("run",showWarnings = F) + copyDirectory(from = file.path(restart.path, "run/"), + to = file.path(settings$outdir, "run/")) + if(!dir.exists("out")) dir.create("out",showWarnings = F) + copyDirectory(from = file.path(restart.path, "out/"), + to = file.path(settings$outdir, "out/")) +} #restart == TRUE + # -------------------------------------------------------------------------------------------------- #--------------------------------- Run state data assimilation ------------------------------------- # -------------------------------------------------------------------------------------------------- -unlink(c('run','out','SDA'), recursive = T) +if(restart == FALSE) unlink(c('run','out','SDA'), recursive = T) if ('state.data.assimilation' %in% names(settings)) { if (PEcAn.utils::status.check("SDA") == 0) { PEcAn.utils::status.start("SDA") - PEcAn.assim.sequential::sda.enkf( - settings, - restart=restart.path, + PEcAn.assim.sequential::sda.enkf( + settings, + restart=restart, Q=0, obs.mean = obs.mean, obs.cov = obs.cov, @@ -212,10 +369,12 @@ if ('state.data.assimilation' %in% names(settings)) { interactivePlot =FALSE, TimeseriesPlot =TRUE, BiasPlot =FALSE, - debug = FALSE, + debug =FALSE, pause=FALSE ) ) PEcAn.utils::status.end() } } + + \ No newline at end of file diff --git a/modules/assim.sequential/inst/sda.rewind.R b/modules/assim.sequential/inst/sda.rewind.R index 3a747be7f7f..ff4f4d94ea2 100644 --- a/modules/assim.sequential/inst/sda.rewind.R +++ b/modules/assim.sequential/inst/sda.rewind.R @@ -64,22 +64,24 @@ sda_rewind <- function(settings,run.id,time_to_rewind){ files.last.sda <- list.files.nodir(file.path(settings$outdir,"SDA")) #copying - file.copy(file.path(file.path(settings$outdir,"SDA"),files.last.sda), - file.path(file.path(settings$outdir,"SDA"),paste0(as.numeric(time_to_rewind)-1,"/",files.last.sda))) - - load(file.path(settings$outdir,"SDA",'sda.output.Rdata')) - - X <- FORECAST[[t]] - FORECAST[t] <- NULL - ANALYSIS[t] <- NULL - enkf.params[t] <- NULL - - for(i in 1:length(new.state)) new.state[[i]] <- ANALYSIS[[t]][,i] - - t = t-1 - - save(site.locs, t, X, FORECAST, ANALYSIS, enkf.params, new.state, new.params, run.id, - ensemble.id, ensemble.samples, inputs, Viz.output, file = file.path(settings$outdir,"SDA", "sda.output.Rdata")) + if(file.exists(file.path(settings$outdir,"SDA"))){ + file.copy(file.path(file.path(settings$outdir,"SDA"),files.last.sda), + file.path(file.path(settings$outdir,"SDA"),paste0(as.numeric(time_to_rewind)-1,"/",files.last.sda))) + + load(file.path(settings$outdir,"SDA",'sda.output.Rdata')) + + X <- FORECAST[[t]] + FORECAST[t] <- NULL + ANALYSIS[t] <- NULL + enkf.params[t] <- NULL + + for(i in 1:length(new.state)) new.state[[i]] <- ANALYSIS[[t-1]][,i] #not sure if this should be t or t-1 + + t = t-1 + + save(site.locs, t, X, FORECAST, ANALYSIS, enkf.params, new.state, new.params, run.id, + ensemble.id, ensemble.samples, inputs, Viz.output, file = file.path(settings$outdir,"SDA", "sda.output.Rdata")) + } ### Paleon specific with leading zero dates if(nchar(time_to_rewind) == 3){ diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multi_Site_Constructors.R b/modules/assim.sequential/inst/sda_backup/bmorrison/Multi_Site_Constructors.R new file mode 100755 index 00000000000..12f3f50b9e7 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multi_Site_Constructors.R @@ -0,0 +1,246 @@ +##' @title Contruct.Pf +##' @name Contruct.Pf +##' @author Hamze Dokoohaki +##' +##' @param site.ids a vector name of site ids. +##' @param var.names vector names of state variable names. +##' @param X a matrix of state variables. In this matrix rows represent ensembles, while columns show the variables for different sites. +##' @param localization.FUN This is the function that performs the localization of the Pf matrix and it returns a localized matrix with the same dimensions. +##' @description The argument X needs to have an attribute pointing the state variables to their corresponding site. This attribute needs to be called `Site`. +##' At the moment, the cov between state variables at blocks defining the cov between two sites are assumed zero. +##' @return It returns the var-cov matrix of state variables at multiple sites. +##' @export + + +Contruct.Pf <- function(site.ids, var.names, X, localization.FUN=NULL, t=1, blocked.dis=NULL, ...) { + #setup + nsite <- length(site.ids) + nvariable <- length(var.names) + # I will make a big cov matrix and then I will populate it with the cov of each site + pf.matrix <-matrix(0,(nsite*nvariable),(nsite*nvariable)) + + ## This makes the diagonal of our big matrix - first filters out each site, estimates the cov and puts it where it needs to go. + for (site in site.ids){ + #let's find out where this cov (for the current site needs to go in the main cov matrix) + pos.in.matrix <- which(attr(X,"Site") %in% site) + #foreach site let's get the Xs + pf.matrix [pos.in.matrix, pos.in.matrix] <- cov( X [, pos.in.matrix] ,use="complete.obs") + } + + # This is where we estimate the cov between state variables of different sites + #I put this into a sperate loop so we can have more control over it + site.cov.orders <- expand.grid(site.ids,site.ids) %>% + filter( Var1 != Var2) + + for (i in 1:nrow(site.cov.orders)){ + # first we need to find out where to put it in the big matrix + rows.in.matrix <- which(attr(X,"Site") %in% site.cov.orders[i,1]) + cols.in.matrix <- which(attr(X,"Site") %in% site.cov.orders[i,2]) + #estimated between these two sites + two.site.cov <- cov( X [, c(rows.in.matrix, cols.in.matrix)],use="complete.obs" )[(nvariable+1):(2*nvariable),1:nvariable] + # I'm setting the off diag to zero + two.site.cov [which(lower.tri(two.site.cov, diag = FALSE),TRUE) %>% rbind (which(upper.tri(two.site.cov,FALSE),TRUE))] <- 0 + #putting it back to the main matrix + pf.matrix [rows.in.matrix, cols.in.matrix] <- two.site.cov + } + + # if I see that there is a localization function passed to this - I run it by the function. + if (!is.null(localization.FUN)) { + pf.matrix.out <- localization.FUN (pf.matrix, blocked.dis, ...) + } else{ + pf.matrix.out <- pf.matrix + } + + # adding labels to rownames and colnames + labelss <- paste0(rep(var.names, length(site.ids)) %>% as.character(),"(", + rep(site.ids, each=length(var.names)),")") + + colnames(pf.matrix.out ) <-labelss + rownames(pf.matrix.out ) <-labelss + + return(pf.matrix.out) + +} + +##' @title Construct.R +##' @name Construct.R +##' @author Hamze Dokoohaki +##' +##' @param site.ids a vector name of site ids +##' @param var.names vector names of state variable names +##' @param obs.t.mean list of vector of means for the time t for different sites. +##' @param obs.t.cov list of list of cov for the time for different sites. +##’ +##' +##' @description Make sure that both lists are named with siteids. +##' +##' @return This function returns a list with Y and R ready to be sent to the analysis functions. +##' @export + +Construct.R<-function(site.ids, var.names, obs.t.mean, obs.t.cov){ + + # keeps Hs of sites + site.specific.Rs <-list() + # + nsite <- length(site.ids) + # + nvariable <- length(var.names) + Y<-c() + + for (site in site.ids){ + choose <- sapply(var.names, agrep, x=names(obs.t.mean[[site]]), max=1, USE.NAMES = FALSE) %>% unlist + # if there is no obs for this site + if(length(choose)==0){ + next; + }else{ + Y <- c(Y, unlist(obs.t.mean[[site]][choose])) + # collecting them + site.specific.Rs <- c(site.specific.Rs, list(as.matrix(obs.t.cov[[site]][choose,choose])) ) + } + #make block matrix out of our collection + R <- Matrix::bdiag(site.specific.Rs) %>% as.matrix() + } + + return(list(Y=Y, R=R)) +} + + +##' @title block_matrix +##' @name block_matrix +##' @author Guy J. Abel +##' +##' @param x Vector of numbers to identify each block. +##' @param b Numeric value for the size of the blocks within the matrix ordered depending on byrow +##' @param byrow logical value. If FALSE (the default) the blocks are filled by columns, otherwise the blocks in the matrix are filled by rows. +##' @param dimnames Character string of name attribute for the basis of the blcok matrix. If NULL a vector of the same length of b provides the basis of row and column names.#'. +##’ +##' +##' @description This function is adopted from migest package. +##' +##' @return Returns a matrix with block sizes determined by the b argument. Each block is filled with the same value taken from x. +##' @export +block_matrix <- function (x = NULL, b = NULL, byrow = FALSE, dimnames = NULL) { + n <- length(b) + bb <- rep(1:n, times = b) + dn <- NULL + if (is.null(dimnames)) { + dn <- rep(1:n, times = b) + dd <- unlist(sapply(b, seq, from = 1)) + dn <- paste0(dn, dd) + dn <- list(dn, dn) + } + if (!is.null(dimnames)) { + dn <- dimnames + } + xx <- matrix(NA, nrow = sum(b), ncol = sum(b), dimnames = dn) + k <- 1 + if (byrow == TRUE) { + for (i in 1:n) { + for (j in 1:n) { + xx[i == bb, j == bb] <- x[k] + k <- k + 1 + } + } + } + if (byrow == FALSE) { + for (j in 1:n) { + for (i in 1:n) { + xx[i == bb, j == bb] <- x[k] + k <- k + 1 + } + } + } + return(xx) +} + +##' @title Construct.H.multisite +##' @name Construct.H.multisite +##' @author Hamze +##' +##' @param site.ids a vector name of site ids +##' @param var.names vector names of state variable names +##' @param obs.t.mean list of vector of means for the time t for different sites. +##' +##' @description This function is makes the blocked mapping function. +##' +##' @return Returns a matrix with block sizes determined by the b argument. Each block is filled with the same value taken from x. +##' @export +Construct.H.multisite <- function(site.ids, var.names, obs.t.mean){ + + site.ids.with.data <- names(obs.t.mean) + site.specific.Hs <- list() + + + nsite <- length(site.ids) # number of sites + nsite.ids.with.data <-length(site.ids.with.data) # number of sites with data + nvariable <- length(var.names) + #This is used inside the loop below for moving between the sites when populating the big H matrix + nobs <- obs.t.mean %>% map_dbl(~length(.x)) %>% max # this gives me the max number of obs at sites + nobstotal<-obs.t.mean %>% purrr::flatten() %>% length() # this gives me the total number of obs + + #Having the total number of obs as the row number + H <- matrix(0, nobstotal, (nvariable*nsite)) + j<-1 + + for(i in seq_along(site.ids)) + { + site <- site.ids[i] + obs.names <- names(obs.t.mean[[site]]) + + if(is.null(obs.names)) next; + + if (length(obs.names) == 1) + { + + # choose <- sapply(var.names, agrep, x = names(obs.t.mean[[site]]), + # max = 1, USE.NAMES = FALSE) %>% unlist + choose.col <- sapply(obs.names, agrep, x = var.names, max = 1, USE.NAMES = FALSE) %>% unlist + choose.row <- sapply(var.names, agrep, x = obs.names, max = 1, USE.NAMES = FALSE) %>% unlist + + # empty matrix for this site + H.this.site <- matrix(0, nrow(H), nvariable) + # fill in the ones based on choose + H.this.site [choose.row, choose.col] <- 1 + } + + if (length(obs.names) > 1) + { + # empty matrix for this site + H.this.site <- matrix(0, nobs, nvariable) + + for (n in seq_along(obs.names)) + { + choose.col <- sapply(obs.names[n], agrep, x = var.names, max = 1, USE.NAMES = FALSE) %>% unlist + H.this.site[n, choose.col] = 1 + + } + H.this.site = do.call(rbind, replicate(length(obs.names), H.this.site, simplify = FALSE)) + } + + # for (n in seq_along(obs.names)) + # { + # choose.col <- sapply(obs.names[n], agrep, x = var.names, max = 1, USE.NAMES = FALSE) %>% unlist + # H.this.obs[n, choose.col] = 1 + # + # } + # H.this.site = data.frame() + # for (x in seq_along(obs.names)) + # { + # test = do.call(rbind, replicate(length(obs.names), H.this.obs[x,], simplify = FALSE)) + # H.this.site = rbind(H.this.site, test) + # + # } + # H.this.site = as.matrix(H.this.site) + # } + # + pos.row = 1:nobstotal + #pos.row<- ((nobs*j)-(nobs-1)):(nobs*j) + pos.col<- ((nvariable*i)-(nvariable-1)):(nvariable*i) + + H[pos.row,pos.col] <-H.this.site + + j <- j +1 + } + + return(H) +} diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey.R b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey.R new file mode 100755 index 00000000000..5a5f2aeb815 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey.R @@ -0,0 +1,341 @@ +#################################################################################################### +# +# +# +# +# --- Last updated: 02.01.2019 By Shawn P. Serbin +#################################################################################################### + + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + + +# temporary step until we get this code integrated into pecan +# library(RCurl) +# script <- getURL("https://raw.githubusercontent.com/serbinsh/pecan/download_osu_agb/modules/data.remote/R/LandTrendr.AGB.R", +# ssl.verifypeer = FALSE) +# eval(parse(text = script)) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## set run options, some of these should be tweaked or removed as requirements +work_dir <- "/data/bmorrison/sda/lai" +setwd(work_dir) # best not to require setting wd and instead just providing full paths in functions + +# Deifine observation - use existing or generate new? +# set to a specific file, use that. +#observation <- "" +#observation = c("1000000048", "796") +#observation = c("1000000048", "796", "1100", "71", "954", "39") + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA.xml") + +# doesn't work for one site +# observation <- c() +# for (i in seq_along(1:length(settings$run))) { +# command <- paste0("settings$run$settings.",i,"$site$id") +# obs <- eval(parse(text=command)) +# observation <- c(observation,obs) +# } + +observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# + + +#---------AGB----------# +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs")) +sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs")) + + + +med_agb_data_sda <- med_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +sdev_agb_data_sda <- sdev_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(med_agb_data_sda$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +med_agb_data_sda <- med_agb_data_sda[site.order,] +sdev_agb_data_sda <- sdev_agb_data_sda[site.order,] + + +#----------LAI----------# +#set directory to output MODIS data too +data_dir <- "/data/bmorrison/sda/lai/modis_lai_data" + +# get the site location information to grab the correct lat/lons for site + add info to the point_list +# ################ Not working on interactive job on MODEX +bety <- list(user='bety', password='bety', host='localhost',dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con + +site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = observation, .con = con) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +# site_info = data.frame() +# for (i in seq_along(1:length(settings$run))) { +# id <- eval(parse(text = paste0("settings$run$settings.",i,"$site$id"))) +# name = eval(parse(text = paste0("settings$run$settings.", i, "$site$name"))) +# lat = eval(parse(text = paste0("settings$run$settings.", i, "$site$lat"))) +# lon = eval(parse(text = paste0("settings$run$settings.", i, "$site$lon"))) +# site_info = rbind(site_info,(cbind(id, name, lon, lat)), stringsAsFactors = F) +# } +site_IDs <- qry_results$id +site_names <- qry_results$sitename +site_coords <- data.frame(cbind(qry_results$lon, qry_results$lat)) +site_info = as.data.frame(cbind(site_IDs, site_names, site_coords)) +names(site_info) = c("IDs", "Names", "Longitude", "Latitude") +site_info$Longitude = as.numeric(site_info$Longitude) +site_info$Latitude = as.numeric(site_info$Latitude) + + +library(doParallel) +cl <- parallel::makeCluster(5, outfile="") +doParallel::registerDoParallel(cl) + +start = Sys.time() +data = foreach(i=1:nrow(site_info)) %dopar% PEcAn.data.remote::call_MODIS(start_date = "2000/01/01", end_date = "2010/12/31", band = "Lai_500m", product = "MOD15A2H", lat = site_info$Latitude[i], lon = site_info$Longitude[i], size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools", QC_filter = T) +end = Sys.time() +difference = end-start +stopCluster(cl) + +output = as.data.frame(data) + +# LAI is every 7 days --> calculate the peak LAI for a year for each site +load('/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_5site.RData') + +for (i in 1:nrow(site_info)) +{ + name = as.character(site_info$Names[i], stringsAsFactor = F) + g = which(round(output$lat, digits = 3) == round(site_info$Latitude[i], digits = 3)) + output$tile[g] = name +} + + + +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$calendar_date, "%Y-%m-%d"))) +for (i in 1:length(years)) +{ + year = years[i] + g = grep(data$calendar_date, pattern = year) + d = data[g,] + sites = unique(data$tile) + for (j in 1:length(sites)) + { + info = site_info[which(site_info$Names == sites[j]),] + index = which(round(d$lat, digits = 3) == round(info$Latitude, digits = 3) & round(d$lon, digits = 3) == round(info$Longitude, digits = 3)) + + if (length(index) > 0) + { + site = d[index,] + site$band = info$ID + max = which(site$data == max(site$data, na.rm = T)) + peak = site[max[1],] + #peak$data = max + #peak$sd = mean + peak$calendar_date = paste("Year", year, sep = "_") + peak$tile = sites[j] + peak_lai = rbind(peak_lai, peak) + } + + } + +} + + +# sort the data by site so the correct values are placed into the resized data frames below. + +peak_lai = peak_lai[order(peak_lai$tile), ] + +# # separate data into hotdog style dataframes with row == site and columns = info/data for each site +med_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$data)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(med_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) + +sdev_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$sd)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(sdev_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) + +point_list$med_lai_data <- point_list$med_lai_data[[1]] %>% filter(Site_ID %in% site.ids) +point_list$stdv_lai <- point_list$stdv_lai[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(point_list$median_lai$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +point_list$median_lai <- point_list$median_lai[site.order,] +point_list$stdv_lai <- point_list$stdv_lai[site.order,] + +peak_lai_data_sda = point_list$median_lai +sdev_lai_data_sda = point_list$stdv_lai +# +# +# +# # make sure agb and lai only use same dates (for now just to test sda, will fix later) +# date_agb = colnames(med_agb_data_sda) +# date_lai = colnames(peak_lai_data_sda) +# +# if (length(date_agb) > length(date_lai)) +# { +# index = which(!(date_agb %in% date_lai)) +# med_agb_data_sda = med_agb_data_sda[,-index] +# sdev_agb_data_sda = sdev_agb_data_sda[,-index] +# } +# if (length(date_lai) > length(date_agb)) +# { +# index = which(!(date_lai %in% date_agb)) +# peak_lai_data_sda = peak_lai_data_sda[,-index] +# sdev_lai_data_sda = sdev_lai_data_sda[,-index] +# } +# +# # combine agb and lai datasets +# med_data_sda = list() +# med_data_da +# # point_list = list() +# # point_list$agb$median_agb = med_agb_data_sda +# # point_list$agb$stdv_agb = sdev_agb_data_sda +# # point_list$lai$peak_lai = peak_lai_data_sda +# # point_list$lai$stdv_lai = sdev_lai_data_sda +# +# # +# #point_list$agb$median_agb = as.character(point_list$agb$median_agb[[1]]) %>% filter(site_ID %in% site.ids) +# + +point_list = list() +point_list$median_lai = med_lai_data +point_list$sdev_lai = sdev_lai_data + +point_list$median_lai <- point_list$median_lai[[1]] %>% filter(site_ID %in% site.ids) +point_list$stdv_lai <- point_list$stdv_lai[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(point_list$median_lai$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +point_list$median_lai <- point_list$median_lai[site.order,] +point_list$stdv_lai <- point_list$stdv_lai[site.order,] + +med_lai_data_sda = point_list$median_lai +sdev_lai_data_sda = point_list$sdev_lai + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(med_lai_data_sda),"_")[3:length(med_lai_data_sda)] %>% map_chr(~.x[2]) %>% paste0(.,"/12/31") + +obs.mean <- names(med_lai_data_sda)[3:length(med_lai_data_sda)] %>% + map(function(namesl){ + ((med_lai_data_sda)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('LAI'))) %>% + setNames(site.ids[1:length(.)])) + }) %>% setNames(date.obs) + +obs.cov <-names(sdev_lai_data_sda)[3:length(sdev_lai_data_sda)] %>% + map(function(namesl) { + ((sdev_lai_data_sda)[[namesl]] %>% + map( ~ (.x) ^ 2%>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + }) %>% setNames(date.obs) + +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## generate new settings object +new.settings <- PEcAn.settings::prepare.settings(settings) +#--------------------------------------------------------------------------------------------------# + +#Construct.R(site.ids, "LAI", obs.mean[[1]], obs.cov[[1]]) + + + +#--------------------------------------------------------------------------------------------------# +## Run SDA + + +# sda.enkf(settings, obs.mean =obs.mean ,obs.cov = obs.cov, +# control=list(trace=T, +# FF=F, +# interactivePlot=F, +# TimeseriesPlot=T, +# BiasPlot=F, +# plot.title="LAI SDA, 1 site", +# facet.plots=T, +# debug=F, +# pause=F)) + +#unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + interactivePlot=F, + TimeseriesPlot=T, + BiasPlot=F, + plot.title="Sobol sampling - 5sites/15 Ensemble - LAI", + facet.plots=T, + debug=T, + pause=F)) + + +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Wrap up +# Send email if configured +if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { + sendmail(settings$email$from, settings$email$to, + paste0("SDA workflow has finished executing at ", base::date())) +} +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +### EOF diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI.R b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI.R new file mode 100755 index 00000000000..bb74cff9cbc --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI.R @@ -0,0 +1,334 @@ +#################################################################################################### +# +# +# +# +# --- Last updated: 02.01.2019 By Shawn P. Serbin +#################################################################################################### + + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + + +# temporary step until we get this code integrated into pecan +# library(RCurl) +# script <- getURL("https://raw.githubusercontent.com/serbinsh/pecan/download_osu_agb/modules/data.remote/R/LandTrendr.AGB.R", +# ssl.verifypeer = FALSE) +# eval(parse(text = script)) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## set run options, some of these should be tweaked or removed as requirements +work_dir <- "/data/bmorrison/sda/lai" +setwd(work_dir) # best not to require setting wd and instead just providing full paths in functions + +# Deifine observation - use existing or generate new? +# set to a specific file, use that. +#observation <- "" +#observation = c("1000000048", "796") +#observation = c("1000000048", "796", "1100", "71", "954", "39") + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB.xml") + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +#observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# + + +#---------AGB----------# +data_dir <- "/data/bmorrison/sda/lai/modis_lai_data" + +# get the site location information to grab the correct lat/lons for site + add info to the point_list +# ################ Not working on interactive job on MODEX + +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs")) +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs")) +# +# +# +# med_agb_data_sda <- med_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +# sdev_agb_data_sda <- sdev_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +# site.order <- sapply(site.ids,function(x) which(med_agb_data_sda$Site_ID %in% x)) %>% +# as.numeric() %>% na.omit() +# med_agb_data_sda <- med_agb_data_sda[site.order,] +# sdev_agb_data_sda <- sdev_agb_data_sda[site.order,] +# +# save(med_agb_data_sda, file = '/data/bmorrison/sda/lai/modis_lai_data/med_agb_data_5sites.Rdata') +# save(sdev_agb_data_sda, file = '/data/bmorrison/sda/lai/modis_lai_data/sdev_agb_data_5sites.Rdata') + +load('/data/bmorrison/sda/lai/modis_lai_data/med_agb_data_5sites.Rdata') +load( '/data/bmorrison/sda/lai/modis_lai_data/sdev_agb_data_5sites.Rdata') +# med_agb_data_sda = med_agb_data_sda[1,] +# sdev_agb_data_sda = sdev_agb_data_sda[1,] + +#----------LAI----------# + +# library(doParallel) +# cl <- parallel::makeCluster(5, outfile="") +# doParallel::registerDoParallel(cl) +# +# start = Sys.time() +# data = foreach(i=1:length(site_info$site_id), .combine = rbind) %dopar% PEcAn.data.remote::call_MODIS(start_date = "2000/01/01", end_date = "2017/12/31", band = "Lai_500m", product = "MOD15A2H", lat = site_info$lat[i], lon = site_info$lon[i], size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools", QC_filter = T, progress = T) +# end = Sys.time() +# difference = end-start +# stopCluster(cl) + +#for 1 site +#output2 = PEcAn.data.remote::call_MODIS(start_date = "2000/01/01", end_date = "2010/12/31", band = "Lai_500m", product = "MOD15A2H", lat = site_info$lat[i], lon = site_info$lon[i], size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools", QC_filter = T) + +# output = as.data.frame(data) +# save(output, file = '/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_5sites.Rdata') + +load('/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_5sites.Rdata') + +#rename tiles by actual site name +for (i in 1:length(site_info$site_name)) +{ + name = as.character(site_info$site_name[i], stringsAsFactor = F) + g = which(round(output$lat, digits = 3) == round(site_info$lat[i], digits = 3)) + output$tile[g] = name +} + +# compute peak lai per year +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$calendar_date, "%Y-%m-%d"))) +for (i in 1:length(years)) +{ + year = years[i] + g = grep(data$calendar_date, pattern = year) + d = data[g,] + sites = unique(data$tile) + for (j in 1:length(sites)) + { + index = which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) + #info = site_info[which(site_info$site_name == sites[j]),] + #index = which(round(d$lat, digits = 3) == round(site_info$lat, digits = 3) & round(d$lon, digits = 3) == round(site_info$lon, digits = 3)) + + if (length(index) > 0) + { + site = d[index,] + site$band = site_info$site_id[j] + max = which(site$data == max(site$data, na.rm = T)) + peak = site[max[1],] + #peak$data = max + #peak$sd = mean + peak$calendar_date = paste("Year", year, sep = "_") + peak$tile = sites[j] + peak_lai = rbind(peak_lai, peak) + } + + } + +} + + +# sort the data by site so the correct values are placed into the resized data frames below. + +peak_lai = peak_lai[order(peak_lai$tile), ] + +# # separate data into hotdog style dataframes with row == site and columns = info/data for each site +med_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$data)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(med_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) +med_lai_data$Site_ID = as.character(med_lai_data$Site_ID) +med_lai_data = list(med_lai_data) + +sdev_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$sd)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(sdev_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) +sdev_lai_data$Site_ID = as.character(sdev_lai_data$Site_ID) +sdev_lai_data = list(sdev_lai_data) + +#med_lai_data = list(med_lai_data) +med_lai_data_sda <- med_lai_data[[1]] %>% filter(Site_ID %in% site.ids) +sdev_lai_data_sda <- sdev_lai_data[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(med_lai_data_sda$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +med_lai_data_sda <- med_lai_data_sda[site.order,] +sdev_lai_data_sda <- sdev_lai_data_sda[site.order,] + + +#make sure agb and lai only use same dates (for now just to test sda, will fix later) +date_agb = colnames(med_agb_data_sda) +date_lai = colnames(med_lai_data_sda) + +if (length(date_agb) > length(date_lai)) +{ + index = which(!(date_agb %in% date_lai)) + med_agb_data_sda = med_agb_data_sda[,-index] + sdev_agb_data_sda = sdev_agb_data_sda[,-index] +} +if (length(date_lai) > length(date_agb)) +{ + index = which(!(date_lai %in% date_agb)) + med_lai_data_sda = med_lai_data_sda[,-index] + sdev_lai_data_sda = sdev_lai_data_sda[,-index] +} + +### REFORMAT ALL DATA BY YEAR INSTEAD OF SITE HOTDOG STYLE. COMBINE AGB + LAI INTO 1 MED + 1 SDEV LIST(S). +med_data = as.data.frame(cbind(colnames(med_lai_data_sda[,3:ncol(med_lai_data_sda)]), med_lai_data_sda$Site_ID, unlist(med_lai_data_sda[,3:ncol(med_lai_data_sda)]), unlist(med_agb_data_sda[,3:ncol(med_agb_data_sda)])), row.names = F, stringsAsFactors = F) +names(med_data) = c("date", "site_id", "med_lai", "med_agb") +med_data = med_data[order(med_data$date),] +med_data$date = as.character(med_data$date) +med_data$site_id = as.character(med_data$site_id, stringsAsFactors = F) +med_data$med_lai = as.numeric(med_data$med_lai, stringsAsFactors = F) +med_data$med_agb = as.numeric(med_data$med_agb, stringsAsFactors = F) +med_data = med_data %>% + split(.$date) + +date.obs <- strsplit(names(med_data), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + + +med_data = names(med_data) %>% + map(function(namesl){ + med_data[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("LAI", "AbvGrndWood"))) %>% + setNames(site.ids) + }) %>% setNames(date.obs) + +names = names(med_data) +for (i in 1:length(names)) +{ + for (j in 1:length(names(med_data[[names[1]]]))) + { + rownames(med_data[[i]][[j]]) = NULL + } +} + + +sdev_data = as.data.frame(cbind(colnames(sdev_lai_data_sda[,3:ncol(sdev_lai_data_sda)]), sdev_lai_data_sda$Site_ID, unlist(sdev_lai_data_sda[,3:ncol(sdev_lai_data_sda)]), rep(0, nrow(sdev_lai_data_sda)), rep(0, nrow(sdev_lai_data_sda)),unlist(sdev_agb_data_sda[,3:ncol(sdev_agb_data_sda)])), row.names = F, stringsAsFactors =F) +names(sdev_data) = c("date", "site_id", "sdev_lai", "h1", "h2", "sdev_agb") +sdev_data = sdev_data[order(sdev_data$date),] +sdev_data$date = as.character(sdev_data$date, stringsAsFactors = F) +sdev_data$site_id = as.character(sdev_data$site_id, stringsAsFactors = F) +sdev_data$sdev_lai = as.numeric(sdev_data$sdev_lai, stringsAsFactors = F) +sdev_data$sdev_agb = as.numeric(sdev_data$sdev_agb, stringsAsFactors = F) +sdev_data$h1 = as.numeric(sdev_data$h1) +sdev_data$h2 = as.numeric(sdev_data$h2) +sdev_data = sdev_data %>% + split(.$date) + + + +sdev_data = names(sdev_data) %>% + map(function(namesl){ + sdev_data[[namesl]] %>% + split(.$site_id) %>% + map(~matrix(data = .x[3:6]^2, nrow = 2, ncol = 2)) %>% + setNames(site.ids) + }) %>% setNames(date.obs) + + +obs.mean = med_data + +obs.cov = sdev_data +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## generate new settings object +new.settings <- PEcAn.settings::prepare.settings(settings) +#--------------------------------------------------------------------------------------------------# + +#Construct.R(site.ids, "LAI", obs.mean[[1]], obs.cov[[1]]) + + + +#--------------------------------------------------------------------------------------------------# +## Run SDA + + +#unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=TRUE, + FF=FALSE, + interactivePlot=FALSE, + TimeseriesPlot=FALSE, + BiasPlot=FALSE, + plot.title=NULL, + facet.plots=4, + debug=F, + pause=FALSE)) + +#-----------------------------------------------------------------------------------------------# +load('/data/bmorrison/sda/lai/SDA/sda.output.Rdata', verbose = T) +obs.times <- names(obs.mean) +post.analysis.multisite.ggplot(settings, t, obs.times, obs.mean, obs.cov, FORECAST, ANALYSIS, plot.title=NULL, facetg=4, readsFF=NULL) + + +#--------------------------------------------------------------------------------------------------# +## Wrap up +# Send email if configured +if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { + sendmail(settings$email$from, settings$email$to, + paste0("SDA workflow has finished executing at ", base::date())) +} +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +### EOF diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_2_sites.R b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_2_sites.R new file mode 100755 index 00000000000..2cd058b917e --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_2_sites.R @@ -0,0 +1,233 @@ + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + +#--------------------------------------------------------------------------------------------------# + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_2_Sites.xml") + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +#observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +# get the site location information to grab the correct lat/lons for site + add info to the point_list +# ################ Not working on interactive job on MODEX + +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + +load('/data/bmorrison/sda/lai/modis_lai_data/med_agb_data.Rdata') +load( '/data/bmorrison/sda/lai/modis_lai_data/sdev_agb_data.Rdata') +load('/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_2_site.Rdata') + +#rename tiles by actual site name +for (i in 1:length(site_info$site_name)) +{ + name = as.character(site_info$site_name[i], stringsAsFactor = F) + g = which(round(output$lat, digits = 3) == round(site_info$lat[i], digits = 3)) + output$tile[g] = name +} + +# compute peak lai per year +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$calendar_date, "%Y-%m-%d"))) +for (i in 1:length(years)) +{ + year = years[i] + g = grep(data$calendar_date, pattern = year) + d = data[g,] + sites = unique(data$tile) + for (j in 1:length(sites)) + { + #info = site_info[which(site_info$site_name == sites[j]),] + index = which(round(d$lat, digits = 3) == round(site_info$lat, digits = 3) & round(d$lon, digits = 3) == round(site_info$lon, digits = 3)) + + if (length(index) > 0) + { + site = d[index,] + site$band = site_info$site_id + max = which(site$data == max(site$data, na.rm = T)) + peak = site[max[1],] + #peak$data = max + #peak$sd = mean + peak$calendar_date = paste("Year", year, sep = "_") + peak$tile = sites[j] + peak_lai = rbind(peak_lai, peak) + } + + } + +} + + +# sort the data by site so the correct values are placed into the resized data frames below. + +peak_lai = peak_lai[order(peak_lai$tile), ] + +# # separate data into hotdog style dataframes with row == site and columns = info/data for each site +med_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$data)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(med_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) +med_lai_data$Site_ID = as.character(med_lai_data$Site_ID) +med_lai_data = list(med_lai_data) + +sdev_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$sd)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(sdev_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) +sdev_lai_data$Site_ID = as.character(sdev_lai_data$Site_ID) +sdev_lai_data = list(sdev_lai_data) + + +#med_lai_data = list(med_lai_data) +med_lai_data_sda <- med_lai_data[[1]] %>% filter(Site_ID %in% site.ids) +sdev_lai_data_sda <- sdev_lai_data[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(med_lai_data_sda$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +med_lai_data_sda <- med_lai_data_sda[site.order,] +sdev_lai_data_sda <- sdev_lai_data_sda[site.order,] + + +#make sure agb and lai only use same dates (for now just to test sda, will fix later) +date_agb = colnames(med_agb_data_sda) +date_lai = colnames(med_lai_data_sda) + +if (length(date_agb) > length(date_lai)) +{ + index = which(!(date_agb %in% date_lai)) + med_agb_data_sda = med_agb_data_sda[,-index] + sdev_agb_data_sda = sdev_agb_data_sda[,-index] +} +if (length(date_lai) > length(date_agb)) +{ + index = which(!(date_lai %in% date_agb)) + med_lai_data_sda = med_lai_data_sda[,-index] + sdev_lai_data_sda = sdev_lai_data_sda[,-index] +} + + +### REFORMAT ALL DATA BY YEAR INSTEAD OF SITE HOTDOG STYLE. COMBINE AGB + LAI INTO 1 MED + 1 SDEV LIST(S). +med_data = as.data.frame(cbind(colnames(med_lai_data_sda[,3:ncol(med_lai_data_sda)]), med_lai_data_sda$Site_ID, unlist(med_agb_data_sda[,3:ncol(med_agb_data_sda)]), unlist(med_lai_data_sda[,3:ncol(med_lai_data_sda)])), row.names = F, stringsAsFactors = F) +names(med_data) = c("date", "site_id", "med_agb", "med_lai") +med_data = med_data[order(med_data$date),] +med_data$date = as.character(med_data$date) +med_data$site_id = as.character(med_data$site_id, stringsAsFactors = F) +med_data$med_lai = as.numeric(med_data$med_lai, stringsAsFactors = F) +med_data$med_agb = as.numeric(med_data$med_agb, stringsAsFactors = F) +med_data = med_data %>% + split(.$date) + +date.obs <- strsplit(names(med_data), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + + +med_data = names(med_data) %>% + map(function(namesl){ + med_data[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI"))) %>% + setNames(site.ids) + }) %>% setNames(date.obs) + +names = names(med_data) +for (i in 1:length(names)) +{ + for (j in 1:length(names(med_data[[names[1]]]))) + { + rownames(med_data[[i]][[j]]) = NULL + } +} + + +sdev_data = as.data.frame(cbind(colnames(sdev_lai_data_sda[,3:ncol(sdev_lai_data_sda)]), sdev_lai_data_sda$Site_ID, unlist(sdev_agb_data_sda[,3:ncol(sdev_agb_data_sda)]), rep(0, nrow(sdev_lai_data_sda)), rep(0, nrow(sdev_lai_data_sda)),unlist(sdev_lai_data_sda[,3:ncol(sdev_lai_data_sda)])), row.names = F, stringsAsFactors =F) +names(sdev_data) = c("date", "site_id", "sdev_agb", "h1", "h2", "sdev_lai") +sdev_data = sdev_data[order(sdev_data$date),] +sdev_data$date = as.character(sdev_data$date, stringsAsFactors = F) +sdev_data$site_id = as.character(sdev_data$site_id, stringsAsFactors = F) +sdev_data$sdev_lai = as.numeric(sdev_data$sdev_lai, stringsAsFactors = F) +sdev_data$sdev_agb = as.numeric(sdev_data$sdev_agb, stringsAsFactors = F) +sdev_data$h1 = as.numeric(sdev_data$h1) +sdev_data$h2 = as.numeric(sdev_data$h2) +sdev_data = sdev_data %>% + split(.$date) + +sdev_data = names(sdev_data) %>% + map(function(namesl){ + sdev_data[[namesl]] %>% + split(.$site_id) %>% + map(~matrix(data = .x[3:6]^2, nrow = 2, ncol = 2)) %>% + setNames(site.ids) + }) %>% setNames(date.obs) + + +obs.mean = med_data + +obs.cov = sdev_data + +new.settings <- PEcAn.settings::prepare.settings(settings) + +#unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=TRUE, + FF=FALSE, + interactivePlot=FALSE, + TimeseriesPlot=FALSE, + BiasPlot=FALSE, + plot.title=NULL, + facet.plots=4, + debug=F, + pause=FALSE)) + + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_2_sites_with_NA.R b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_2_sites_with_NA.R new file mode 100755 index 00000000000..4e1f19e3190 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_2_sites_with_NA.R @@ -0,0 +1,347 @@ + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + +#--------------------------------------------------------------------------------------------------# + +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_2_Sites.xml") + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +#observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +# get the site location information to grab the correct lat/lons for site + add info to the point_list +# ################ Not working on interactive job on MODEX + +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + +load('/data/bmorrison/sda/lai/modis_lai_data/med_agb_data.Rdata') +load( '/data/bmorrison/sda/lai/modis_lai_data/sdev_agb_data.Rdata') +load('/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_2_site.Rdata') + +#rename tiles by actual site name +for (i in 1:length(site_info$site_name)) +{ + name = as.character(site_info$site_name[i], stringsAsFactor = F) + g = which(round(output$lat, digits = 3) == round(site_info$lat[i], digits = 3)) + output$tile[g] = name +} + +# compute peak lai per year +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$calendar_date, "%Y-%m-%d"))) +for (i in 1:length(years)) +{ + year = years[i] + g = grep(data$calendar_date, pattern = year) + d = data[g,] + sites = unique(data$tile) + for (j in 1:length(sites)) + { + #info = site_info[which(site_info$site_name == sites[j]),] + index = which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) + + if (length(index) > 0) + { + site = d[index,] + site$band = site_info$site_id[j] + max = which(site$data == max(site$data[which(site$data <= quantile(site$data, probs = 0.95))], na.rm = T))#max(site$data, na.rm = T)) + peak = site[max[1],] + + peak$calendar_date = paste("Year", year, sep = "_") + peak$tile = sites[j] + peak_lai = rbind(peak_lai, peak) + } + + } + +} + + +# sort the data by site so the correct values are placed into the resized data frames below. + +peak_lai = peak_lai[order(peak_lai$tile), ] + +# following the methods of Viskari et al 2015 for LAI sd values +peak_lai$sd[peak_lai$sd <0.66] = 0.66 + +# # separate data into hotdog style dataframes with row == site and columns = info/data for each site +med_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$data)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(med_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) +med_lai_data$Site_ID = as.character(med_lai_data$Site_ID) +med_lai_data = list(med_lai_data) + +sdev_lai_data = cbind(unique(peak_lai$band), unique(peak_lai$tile), as.data.frame(matrix(unlist(t(peak_lai$sd)), byrow = T, length(unique(peak_lai$tile)), length(years)))) +colnames(sdev_lai_data) = c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) +sdev_lai_data$Site_ID = as.character(sdev_lai_data$Site_ID) +sdev_lai_data = list(sdev_lai_data) + + +#med_lai_data = list(med_lai_data) +med_lai_data_sda <- med_lai_data[[1]] %>% filter(Site_ID %in% site.ids) +sdev_lai_data_sda <- sdev_lai_data[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(med_lai_data_sda$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +med_lai_data_sda <- med_lai_data_sda[site.order,] +sdev_lai_data_sda <- sdev_lai_data_sda[site.order,] + + +#make sure agb and lai only use same dates (for now just to test sda, will fix later) +date_agb = colnames(med_agb_data_sda) +date_lai = colnames(med_lai_data_sda) + +# if (length(date_agb) > length(date_lai)) +# { +# index = which(!(date_agb %in% date_lai)) +# med_agb_data_sda = med_agb_data_sda[,-index] +# sdev_agb_data_sda = sdev_agb_data_sda[,-index] +# } +# if (length(date_lai) > length(date_agb)) +# { +# index = which(!(date_lai %in% date_agb)) +# med_lai_data_sda = med_lai_data_sda[,-index] +# sdev_lai_data_sda = sdev_lai_data_sda[,-index] +# } + +# fix missing data to feed into SDA +colnames = sort(unique(c(date_agb, date_lai))) + +blank = as.data.frame(matrix(NA, nrow = 2, ncol = length(colnames))) +colnames(blank) = colnames + +lai_same = which(colnames(blank) %in% colnames(med_lai_data_sda))[-(1:2)] +agb_same = which(colnames(blank) %in% colnames(med_agb_data_sda))[-(1:2)] + +if (length(agb_same) < length(colnames(blank)[-(1:2)])) +{ + agb_med= blank + agb_sdev = blank + agb_med[,1:2] = med_agb_data_sda[,1:2] + agb_sdev[,1:2] = sdev_agb_data_sda[,1:2] + agb_med[,agb_missing] = med_agb_data_sda[-agb_missing] + agb_sdev[,agb_missing] = sdev_agb_data_sda[-agb_missing] +} else { + agb_med = med_agb_data_sda + agb_sdev = sdev_agb_data_sda +} +if (length(lai_same) < length(colnames(blank)[-(1:2)])) +{ + lai_med = blank + lai_sdev = blank + lai_med[,1:2] = med_lai_data_sda[,1:2] + lai_sdev[,1:2] = sdev_lai_data_sda[,1:2] + lai_med[ ,lai_same] = med_lai_data_sda[,3:ncol(med_lai_data_sda)] + lai_sdev[ ,lai_same] = sdev_lai_data_sda[,3:ncol(sdev_lai_data_sda)] +} else { + lai_med = med_lai_data_sda + lai_sdev = sdev_lai_data_sda +} + +med_lai_data_sda = lai_med +med_agb_data_sda = agb_med +sdev_lai_data_sda = lai_sdev +sdev_agb_data_sda = agb_sdev + +### REFORMAT ALL DATA BY YEAR INSTEAD OF SITE HOTDOG STYLE. COMBINE AGB + LAI INTO 1 MED + 1 SDEV LIST(S). + +med_data = as.data.frame(cbind(sort(rep(colnames(med_lai_data_sda[,3:ncol(med_lai_data_sda)]), 2)), med_lai_data_sda$Site_ID, unlist(c(med_agb_data_sda[,3:ncol(med_agb_data_sda)]), use.names = F), unlist(c(med_lai_data_sda[,3:ncol(med_lai_data_sda)]), use.names = F))) +names(med_data) = c("date", "site_id", "med_agb", "med_lai") +#med_data = med_data[order(med_data$date),] +med_data$date = as.character(med_data$date) +med_data$site_id = as.character(med_data$site_id, stringsAsFactors = F) +med_data$med_lai = as.numeric(as.character(med_data$med_lai, stringsAsFactors = F))#as.numeric(levels(med_data$med_lai), stringsAsFactors = F)) +med_data$med_agb = as.numeric(as.character(med_data$med_agb, stringsAsFactors = F))#as.numeric(levels(med_data$med_agb), stringsAsFactors = F) +med_data = med_data %>% + split(.$date) + +date.obs <- strsplit(names(med_data), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + +med_data = names(med_data) %>% + map(function(namesl){ + med_data[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI"))) %>% + setNames(site.ids) + }) %>% setNames(date.obs) + +names = names(med_data) +for (i in 1:length(names)) +{ + for (j in 1:length(names(med_data[[names[i]]]))) + { + d = med_data[[i]][[j]] + + if (length(which(is.na(d)))>=1) + { + d = d[-which(is.na(d))] + } + med_data[[i]][[j]] = d + rownames(med_data[[i]][[j]]) = NULL + } +} + + +sdev_data = as.data.frame(cbind(sort(rep(colnames(sdev_lai_data_sda[,3:ncol(sdev_lai_data_sda)]), 2)), sdev_lai_data_sda$Site_ID, unlist(c(sdev_agb_data_sda[,3:ncol(sdev_agb_data_sda)]), use.names = F), rep(0, nrow(sdev_lai_data_sda)), rep(0, nrow(sdev_lai_data_sda)), unlist(c(sdev_lai_data_sda[,3:ncol(sdev_lai_data_sda)]), use.names = F))) # +names(sdev_data) = c("date", "site_id", "sdev_agb","h1", "h2", "sdev_lai") #c("date", "site_id", "sdev_agb", "h1", "h2", "sdev_lai") +sdev_data = sdev_data[order(sdev_data$date),] +sdev_data$date = as.character(sdev_data$date, stringsAsFactors = F) +sdev_data$site_id = as.character(sdev_data$site_id, stringsAsFactors = F) +sdev_data$sdev_lai = as.numeric(as.character(sdev_data$sdev_lai, stringsAsFactors = F)) #as.numeric(sdev_data$sdev_lai, stringsAsFactors = F) +sdev_data$sdev_agb = as.numeric(as.character(sdev_data$sdev_agb, stringsAsFactors = F))#as.numeric(sdev_data$sdev_agb, stringsAsFactors = F) +sdev_data$h1 = as.numeric(as.character(sdev_data$h1, stringsAsFactors = F)) +sdev_data$h2 = as.numeric(as.character(sdev_data$h2, stringsAsFactors = F)) + +#sdev_data[is.na(sdev_data$sdev_lai), 4:5] = NA + +sdev_data = sdev_data %>% + split(.$date) + +sdev_data = names(sdev_data) %>% + map(function(namesl){ + sdev_data[[namesl]] %>% + split(.$site_id) %>% + map(~matrix(data = .x[3:6]^2, nrow = 2, ncol = 2)) %>% + setNames(site.ids)}) %>% + setNames(date.obs) + + +names = names(sdev_data) +for (i in 1:length(names)) +{ + for (j in 1:length(names(sdev_data[[names[i]]]))) + { + d = matrix(unlist(sdev_data[[i]][[j]]), nrow = 2, ncol = 2) + + if (length(which(is.na(d)))>=1) + { + index = which(is.na(d)) + d = matrix(d[-index], nrow = 1, ncol = 1) + } + sdev_data[[i]][[j]] = d + # rownames(sdev_data[[i]][[j]]) = NULL + } +} + + + + +obs.mean = med_data + +obs.cov = sdev_data + +new.settings <- PEcAn.settings::prepare.settings(settings) + +# unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=TRUE, + FF=FALSE, + interactivePlot=FALSE, + TimeseriesPlot=FALSE, + BiasPlot=FALSE, + plot.title=NULL, + facet.plots=4, + debug=FALSE, + pause=FALSE)) + +### FOR PLOTTING ONLY +# load('/data/bmorrison/sda/lai/SDA/sda.output.Rdata') +# plot.title=NULL +# facetg=4 +# readsFF=NULL +# +# settings = new.settings +# +# obs.mean = Viz.output[[2]] +# obs.cov = Viz.output[[3]] +# obs.times = names(obs.mean) +# PEcAn.assim.sequential::post.analysis.multisite.ggplot(settings = new.settings, t, obs.times, obs.mean, obs.cov, FORECAST, ANALYSIS, plot.title=NULL, facetg=4, readsFF=NULL, observed_vars = c("AbvGrndWood", "LAI")) +# +# +# observed_vars = c("AbvGrndWood", "LAI") +# ## fix values in obs.mean/obs.cov to include NAs so there are the same number of columns for plotting purposes only +# for (name in names(obs.mean)) +# { +# data_mean = obs.mean[name] +# data_cov = obs.cov[name] +# sites = names(data[[1]]) +# for (site in sites) +# { +# d_mean = data_mean[[1]][[site]] +# d_cov = data_cov[[1]][[site]] +# colnames = names(d_mean) +# if (length(colnames) < length(observed_vars)) +# { +# missing = which(!(observed_vars %in% colnames)) +# missing_mean = as.data.frame(NA) +# colnames(missing_mean) = observed_vars[missing] +# d_mean = cbind(d_mean, missing_mean) +# +# missing_cov = matrix(0, nrow = length(observed_vars), ncol = length(observed_vars)) +# diag(missing_cov) = c(diag(d_cov), NA) +# d_cov = missing_cov +# } +# data_mean[[1]][[site]] = d_mean +# data_cov[[1]][[site]] = d_cov +# } +# obs.mean[name] = data_mean +# obs.cov[name] = data_cov +# } + +obs.times = names(obs.mean) diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_7_sites.r b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_7_sites.r new file mode 100755 index 00000000000..a5abc358235 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_AGB_LAI_7_sites.r @@ -0,0 +1,339 @@ + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +#--------------------------------------------------------------------------------------------------# +######################################## INTIAL SET UP STUFF ####################################### +work_dir <- "/data/bmorrison/sda/lai" +setwd(work_dir) +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("/data/bmorrison/sda/lai/pecan_MultiSite_SDA_LAI_AGB_8_Sites_2009.xml") + + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +#observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX + +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + +###################### EXTRACT AGB DATA + REFORMAT LONG VS. WIDE STYLE ##################################### +### this is for LandTrendr data ### + +# output folder for the data +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# +# # extract the data +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# +# ### temporary fix to make agb data long vs. wide format to match modis data. ### +ndates = colnames(med_agb_data)[-c(1:2)] + +med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) + +sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) + +agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +names(agb_data) = c("Site_ID", "Date", "Median", "SD") +agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) + +# save AGB data into long style +save(agb_data, file = '/data/bmorrison/sda/lai/modis_lai_data/agb_data_update_sites.Rdata') +# +# +# # ####################### Extract MODISTools LAI data ############################## +# +# library(doParallel) +# cl <- parallel::makeCluster(10, outfile="") +# doParallel::registerDoParallel(cl) +# +# start = Sys.time() +# # keep QC_filter on for this because bad LAI values crash the SDA. Progress can be turned off if it annoys you. +# data = foreach(i=1:length(site_info$site_id), .combine = rbind) %dopar% PEcAn.data.remote::call_MODIS(start_date = "2000/01/01", end_date = "2017/12/31", band = "Lai_500m", product = "MOD15A2H", lat = site_info$lat[i], lon = site_info$lon[i], size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools", QC_filter = T, progress = T) +# end = Sys.time() +# difference = end-start +# stopCluster(cl) +# +# # already in long format style for dataframe +# output = as.data.frame(data) +# save(output, file = '/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_update_sites.Rdata') +# +# # change tile names to the site name +# for (i in 1:length(site_info$site_name)) +# { +# name = as.character(site_info$site_id[i], stringsAsFactor = F) +# g = which(round(output$lat, digits = 3) == round(site_info$lat[i], digits = 3)) +# output$tile[g] = name +# } +# # remove extra data +# output = output[,c(4,2,8,10)] +# colnames(output) = names(agb_data) +# +# # compute peak lai per year +# data = output +# peak_lai = data.frame() +# years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +# for (i in seq_along(years)) +# { +# d = data[grep(data$Date, pattern = years[i]),] +# sites = unique(d$Site_ID) +# for (j in seq_along(sites)) +# { +# index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) +# site = d[index,] +# if (length(index) > 0) +# { +# # peak lai is the max value that is the value <95th quantile to remove potential outlier values +# max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] +# peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) +# peak_lai = rbind(peak_lai, peak) +# +# } +# } +# } +# +# # a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +# peak_lai$SD[peak_lai$SD < 0.66] = 0.66 +# +# #output data +# names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +# save(peak_lai, file = '/data/bmorrison/sda/lai/modis_lai_data/peak_lai_output_update_sites.Rdata') +# +# +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +# ################# +load('/data/bmorrison/sda/lai/modis_lai_data/agb_data_update_sites.Rdata') +load( '/data/bmorrison/sda/lai/modis_lai_data/peak_lai_output_update_sites.Rdata') +# output likes to make factors ..... :/... so this unfactors them +peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) + +observed_vars = c("AbvGrndWood", "LAI") + + +# merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") + +# order by year +observed_data = observed_data[order(observed_data$Date),] + +#sort by date +dates = sort(unique(observed_data$Date)) + +# create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) + +obs.mean = obs.mean %>% + split(.$date) + +# change the dates to be middle of the year +date.obs <- strsplit(names(obs.mean), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean = names(obs.mean) %>% + map(function(namesl){ + obs.mean[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI")) %>% `row.names<-`(NULL)) %>% + setNames(site.ids) + }) %>% setNames(date.obs) + +#remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +names = date.obs +for (name in names) +{ + for (site in names(obs.mean[[name]])) + { + na_index = which(!(is.na(obs.mean[[ name]][[site]]))) + colnames = names(obs.mean[[name]][[site]]) + if (length(na_index) > 0) + { + obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] + row.names(obs.mean[[name]][[site]]) = NULL + } + } +} + +# fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) + +# create obs.cov dataframe -->list by date +obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai)#, filler_0) +obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) + +obs.cov = obs.cov %>% + split(.$date) + +obs.cov = names(obs.cov) %>% + map(function(namesl){ + obs.cov[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4]^2 %>% unlist %>% diag(nrow = 2, ncol = 2) ) %>% + setNames(site.ids) + }) %>% setNames(date.obs) + + +names = date.obs +for (name in names) +{ + for (site in names(obs.cov[[name]])) + { + na_index = which(is.na(obs.cov[[ name]][[site]])) + #colnames = names(obs.cov[[name]][[site]]) + if (length(na_index) > 0) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][1] + # row.names(obs.cov[[name]][[site]]) = NULL + # colnames(obs.cov[[name]][[site]]) = NULL + } + } +} +# #sublist by date --> site +# obs.cov = names(obs.cov) %>% +# map(function(namesl){ +# obs.cov[[namesl]] %>% +# split(.$site_id) %>% +# map(~diag(.x[3:4]^2, nrow = 2, ncol = 2)) %>% +# setNames(site.ids)}) %>% +# setNames(date.obs) + +# remove NA/missing observations from covariance matrix and removes NA values to restructure size of covar matrix +# names = names(obs.cov) +# for (name in names) +# { +# for (site in names(obs.cov[[name]])) +# { +# na_index = which(is.na(obs.cov[[ name]][[site]])) +# if (length(na_index) > 0) +# { +# n_good_vars = length(observed_vars)-length(na_index) +# obs.cov[[name]][[site]] = matrix(obs.cov[[name]][[site]][-na_index], nrow = n_good_vars, ncol = n_good_vars) +# } +# } +# } + +# save these lists for future use. +save(obs.mean, file = '/data/bmorrison/sda/lai/obs_mean_8_sites_dif_dates.Rdata') +save(obs.cov, file = '/data/bmorrison/sda/lai/obs_cov_8_sites_dif_dates.Rdata') +save(date.obs, file = '/data/bmorrison/sda/lai/date_obs_8_sites_dif_dates.Rdata') + + + +################################ START THE SDA ######################################## +load('/data/bmorrison/sda/lai/obs_mean_8_sites_dif_dates.Rdata') +load('/data/bmorrison/sda/lai/obs_cov_8_sites_dif_dates.Rdata') +date.obs = names(obs.mean) + +outfolder = "/data/bmorrison/sda/lai/easy_run_8_sites" +unlink(c('run','out', outfolder),recursive = T) + +new.settings <- PEcAn.settings::prepare.settings(settings) + +settings = new.settings +Q = NULL +restart = F +keepNC = T +forceRun = T +daily = F +#unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(outfolder = outfolder, + settings = new.settings, + obs.mean = obs.mean, + obs.cov = obs.cov, + keepNC = TRUE, + forceRun = TRUE, + daily = F, + control=list(trace=TRUE, + FF=FALSE, + interactivePlot=FALSE, + TimeseriesPlot=FALSE, + BiasPlot=FALSE, + plot.title=NULL, + facet.plots=4, + debug=FALSE, + pause=FALSE, + Profiling = FALSE, + OutlierDetection=FALSE)) + + + + +### FOR PLOTTING after analysis if TimeseriesPlot == FALSE) +load('/data/bmorrison/sda/lai/8_sites_different_date/sda.output.Rdata') +facetg=4 +readsFF=NULL +plot.title=NULL + +obs.mean = Viz.output[[2]] +obs.cov = Viz.output[[3]] +obs.times = names(obs.mean) +PEcAn.assim.sequential::post.analysis.multisite.ggplot(settings = new.settings, t, obs.times, obs.mean, obs.cov, FORECAST, ANALYSIS, plot.title=NULL, facetg=4, readsFF=NULL) + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_LAI_8_days.R b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_LAI_8_days.R new file mode 100755 index 00000000000..a4f5a9b30be --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Bailey_LAI_8_days.R @@ -0,0 +1,129 @@ + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +#--------------------------------------------------------------------------------------------------# +######################################## INTIAL SET UP STUFF ####################################### +work_dir <- "/data/bmorrison/sda/lai" + +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_4_sites_8_days.xml") + + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +#observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX + +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + + +################################ START THE SDA ######################################## +load('/data/bmorrison/sda/lai/obs_mean_4_sites_8_days.Rdata') +load('/data/bmorrison/sda/lai/obs_cov_4_sites_8_days.Rdata') +date.obs = names(obs.mean) + + +outfolder = "/data/bmorrison/sda/lai/4_sites_8_days" +unlink(c('run','out', outfolder),recursive = T) + +new.settings <- PEcAn.settings::prepare.settings(settings) + +settings = new.settings +Q = NULL +restart = F +keepNC = T +forceRun = T +daily = TRUE +#unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(outfolder = outfolder, + settings = new.settings, + obs.mean = obs.mean, + obs.cov = obs.cov, + keepNC = TRUE, + forceRun = TRUE, + daily = TRUE, + control=list(trace=TRUE, + FF=FALSE, + interactivePlot=FALSE, + TimeseriesPlot=FALSE, + BiasPlot=FALSE, + plot.title=NULL, + facet.plots=2, + debug=FALSE, + pause=FALSE, + Profiling = FALSE, + OutlierDetection=FALSE)) + + + + +### FOR PLOTTING after analysis if TimeseriesPlot == FALSE) +load('/data/bmorrison/sda/lai/4_sites_8_days/sda.output.Rdata') +facetg=2 +readsFF=NULL +settings= new.settings +settings$outfolder = outfolder +obs.mean = Viz.output[[2]] +obs.cov = Viz.output[[3]] +obs.times = names(obs.mean) +PEcAn.assim.sequential::post.analysis.multisite.ggplot(settings = settings, t, obs.times, obs.mean, obs.cov, FORECAST, ANALYSIS, plot.title=NULL, facetg=2, readsFF=NULL) + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Shawn.R b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Shawn.R new file mode 100755 index 00000000000..780bcc21fa2 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/Multisite_SDA_Shawn.R @@ -0,0 +1,168 @@ +#################################################################################################### +# +# +# +# +# --- Last updated: 02.01.2019 By Shawn P. Serbin +#################################################################################################### + + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + + +# temporary step until we get this code integrated into pecan +library(RCurl) +script <- getURL("https://raw.githubusercontent.com/serbinsh/pecan/download_osu_agb/modules/data.remote/R/LandTrendr.AGB.R", + ssl.verifypeer = FALSE) +eval(parse(text = script)) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## set run options, some of these should be tweaked or removed as requirements +work_dir <- "/data/bmorrison/sda/lai" +setwd(work_dir) # best not to require setting wd and instead just providing full paths in functions + +# Deifine observation - use existing or generate new? +# set to a specific file, use that. +#observation <- "" +#observation <- c("1000025731","1000000048","796", "772", "763", "1000000146") +#observation <- c("1000025731","1000000048","763","796","772","764","765","1000000024","678","1000000146") + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB.xml") + +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Prepare observational data - still very hacky here +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs")) +sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs")) + +PEcAn.logger::logger.info("**** Preparing data for SDA ****") +#for multi site both mean and cov needs to be a list like this +# +date +# +siteid +# c(state variables)/matrix(cov state variables) +# +#reorder sites in obs +med_agb_data_sda <- med_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +sdev_agb_data_sda <- sdev_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(med_agb_data_sda$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +med_agb_data_sda <- med_agb_data_sda[site.order,] +sdev_agb_data_sda <- sdev_agb_data_sda[site.order,] + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(med_agb_data_sda),"_")[3:length(med_agb_data_sda)] %>% + map_chr(~.x[2]) %>% paste0(.,"/12/31") + +obs.mean <- names(med_agb_data_sda)[3:length(med_agb_data_sda)] %>% + map(function(namesl){ + ((med_agb_data_sda)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('AbvGrndWood'))) %>% + setNames(site.ids[1:length(.)])) + }) %>% setNames(date.obs) + +obs.cov <-names(sdev_agb_data_sda)[3:length(sdev_agb_data_sda)] %>% + map(function(namesl) { + ((sdev_agb_data_sda)[[namesl]] %>% + map( ~ (.x) ^ 2%>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + }) %>% setNames(date.obs) + +#--------------------------------------------------------------------------------------------------# + +#--------------------------------------------------------------------------------------------------# +## generate new settings object +new.settings <- PEcAn.settings::prepare.settings(settings) +#new.settings = settings +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Run SDA +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + plot = T, + interactivePlot=F, + TimeseriesPlot=T, + BiasPlot=F, + plot.title="Sobol sampling - 2 sites - AGB", + facet.plots=T, + debug=F, + pause=F) +) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Wrap up +# Send email if configured +if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { + sendmail(settings$email$from, settings$email$to, + paste0("SDA workflow has finished executing at ", base::date())) +} +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +### EOF diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/ecoregion_lai_CONUS.R b/modules/assim.sequential/inst/sda_backup/bmorrison/ecoregion_lai_CONUS.R new file mode 100755 index 00000000000..2e4f0849a87 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/ecoregion_lai_CONUS.R @@ -0,0 +1,317 @@ +library(raster) +library(shapefiles) +library(sp) +library(PEcAn.data.remote) +library(sf) +library(dplyr) +library(rgdal) +library(tidyr) +library(rgeos) +library(rgbif) +library(viridis) +library(gridExtra) +library(rasterVis) +library(doParallel) +library(PEcAn.utils) +set.seed(1) + +#eco = st_read(dsn = '/data/bmorrison/sda/ecoregion_site_analysis/shapefiles', layer = 'eco_conus_rename') +setwd('/data/bmorrison/sda/ecoregion_site_analysis/modis_data/CONUS') +states = st_read(dsn = "/data/bmorrison/sda/ecoregion_site_analysis/shapefiles/states_21basic/states.shp") +states = as(states, "Spatial") + +### testing on 1 ecoregion +region = states +region = st_read(dsn = "/data/bmorrison/sda/ecoregion_site_analysis/shapefiles/states_21basic/states.shp") +region = region[-c(1,28,51),] +#region = eco[eco$name == eco$name[11],] +region = st_union(region) +region = as(region, "Spatial") +region = spTransform(region, CRS = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs ") +region_ll = spTransform(region, CRS = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs ") + +# hexagonal tesellation random sampling + +# must be in meters +make_grid <- function(x, cell_diameter, cell_area, clip = FALSE) { + if (missing(cell_diameter)) { + if (missing(cell_area)) { + stop("Must provide cell_diameter or cell_area") + } else { + cell_diameter <- sqrt(2 * cell_area / sqrt(3)) + } + } + ext <- as(extent(x) + cell_diameter, "SpatialPolygons") + projection(ext) <- projection(x) + # generate array of hexagon centers + g <- spsample(ext, type = "hexagonal", cellsize = cell_diameter, + offset = c(0.5, 0.5)) + # convert center points to hexagons + g <- HexPoints2SpatialPolygons(g, dx = cell_diameter) + # clip to boundary of study area + if (clip) { + g <- gIntersection(g, x, byid = TRUE) + } else { + g <- g[x, ] + } + # clean up feature IDs + row.names(g) <- as.character(1:length(g)) + return(g) +} + +# trick to figure out how many polygons I want vs. cell area of hexagons +n <- 1000 + +area_of_region = raster::area(region) +cell_area= area_of_region/n + +# make hexagonal tesselation grid +hex_grid <- make_grid(region, cell_area = cell_area, clip = FALSE) +#hex_grid <- make_grid(region, cell_diameter = 37894.1, clip = FALSE) + +plot(region, col = "grey50", bg = "light blue") +plot(hex_grid, border = "orange", add = T) +# clip to ecogreion area + +save(hex_grid, file = paste("/data/bmorrison/sda/ecoregion_site_analysis/hex_grid_CONUS.Rdata", sep = "")) +load(paste("/data/bmorrison/sda/ecoregion_site_analysis/hex_grid_CONUS.Rdata", sep = "")) + +# randomly select one point from each hexagon (random) +samples = data.frame() +for (i in 1:length(names(hex_grid))) +{ + hex = hex_grid[i,] + sample = as.data.frame(spsample(hex, n = 1, type = 'random')) + names(sample) = c("x", "y") + samples = rbind(samples, sample) +} +coordinates(samples) = ~x+y +projection(samples) = crs(region) + +# clip out points outside of ecoregion area +samples <- gIntersection(samples, region, byid = TRUE) + +plot(region, col = "grey50", bg = "light blue", axes = TRUE) +plot(hex_grid, border = "orange", add = T) +plot(samples, pch = 20, add = T) +samples = spTransform(samples, CRS = crs(states)) +region = spTransform(region, CRS = crs(states)) + + +xy = as.data.frame(samples) +names(xy) = c("lon", "lat") +save(xy, file = paste('/data/bmorrison/sda/ecoregion_site_analysis/random_sites_CONUS.Rdata', sep = "")) +# extract MODIS data for location + +load("/data/bmorrison/sda/ecoregion_site_analysis/random_sites_CONUS.Rdata") + + +product = "MOD15A2H" + +dates = PEcAn.utils::retry.func(MODISTools::mt_dates(product, lat = xy$lat[1], lon = xy$lon[1]), maxError = 10, sleep = 2) + +starting_dates = dates$calendar_date[grep(dates$calendar_date, pattern = "2001-01")] +start_count = as.data.frame(table(starting_dates), stringsAsFactors = F) +start_date = gsub("-", "/", start_count$starting_dates[1]) + +ending_dates = dates$calendar_date[grep(dates$calendar_date, pattern = "2018-12")] +end_count = as.data.frame(table(ending_dates), stringsAsFactors = F) +end_date = gsub("-", "/", end_count$ending_dates[nrow(end_count)] ) + +# 10 cpu limit because THREADDS has 10 download limit +#xy = xy[1:nrow(xy),] + +cl <- parallel::makeCluster(10) #, outfile= "") +doParallel::registerDoParallel(cl) + +output = data.frame() +for (j in 1:ceiling(nrow(xy)/10)) +{ + if (j == ceiling(nrow(xy)/10)) + { + coords = xy[((j*10)-9):nrow(xy),] + working = print(paste("working on : ", ((j*10)-9), "-", nrow(xy), sep = "")) + + } else { + coords = xy[((j*10)-9):(j*10),] + working = print(paste("working on : ", ((j*10)-9), "-", (j*10), sep = "")) + + } + #siteID = paste(round(coords[i,], digits = 2), collapse = "_") + start = Sys.time() + data = PEcAn.utils::retry.func(foreach(i=1:nrow(coords), .combine = rbind) %dopar% PEcAn.data.remote::call_MODIS(outfolder = getwd(), iter = ((j*10-10)+i), product = "MOD15A2H",band = "Lai_500m", start_date = start_date, end_date = end_date, lat = coords$lat[i], lon = coords$lon[i],size = 0, band_qc = "FparLai_QC", band_sd = "", package_method = "MODISTools", QC_filter = T), maxError = 10, sleep = 2) + end = Sys.time() + difference = end-start + time = print(difference) + output = rbind(output, data) +} +stopCluster(cl) + + +save(output, file = paste('/data/bmorrison/sda/ecoregion_site_analysis/modis_data_output_', nrow(xy), '.Rdata', sep = "")) +# +# load(paste('/data/bmorrison/sda/ecoregion_site_analysis/modis_data_output_', nrow(output), '.Rdata', sep = "")) +# output = as.data.frame(output, row.names = NULL) + +# for large datasets to group together +files = list.files(path = '/data/bmorrison/sda/ecoregion_site_analysis/modis_data/CONUS', pattern = '.csv', include.dirs = T, full.names = T) +xy = data.frame() +for (i in 1:length(files)) +{ + f = read.csv(files[i]) + xy = rbind(xy, f) +} + +output = xy +# summarize into anual peak lai from 2001-2018 +years = lubridate::year(start_date):lubridate::year(end_date) + +data = output +sites = output +coordinates(sites) = ~lon+lat +projection(sites) = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs " +sites = as.data.frame(unique(coordinates(sites))) +coordinates(sites) = ~lon+lat +projection(sites) = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs " + + +compute_annual_lai = function(data, sites) +{ + index = which((round(data$lon, digits = 3)== round(sites$lon, digits = 3)) & (round(data$lat, digits = 3) == round(sites$lat, digits = 3))) + if (length(index) > 0) + { + site = data[index,] + years = unique(lubridate::year(site$calendar_date)) + + summary = data.frame() + for (j in 1:length(years)) + { + g = grep(site$calendar_date, pattern = years[j]) + if (length(g) > 0) + { + d = site[g,] + percentile = which(d$data <= quantile(d$data, probs = 0.95, na.rm = T)[1]) + peak = max(d$data[percentile], na.rm = T) + + info = d[1,] + info$data = peak + info$calendar_date = years[j] + + summary = rbind(summary, info) + } + } + peak_lai = summary[1,] + peak_lai$data = max(summary$data[which(summary$data <= quantile(summary$data, probs = 0.95))], na.rm = T) + return(peak_lai) + } +} + +cl <- parallel::makeCluster(10) #, outfile= "") +doParallel::registerDoParallel(cl) + +test = foreach(i=1:nrow(sites), .combine = rbind) %dopar% compute_annual_lai(data = data, sites = sites[i,]) + +stopCluster(cl) + +test = data.frame() +for (i in 1:nrow(coordinates(sites))) +{ + t = compute_annual_lai(data = data, sites = sites[i,]) + test = rbind(test, t) +} + + +# +# +# +# summary =data.frame() +# for (i in 1:nrow(xy)) +# { +# index = which(round(output$lon, digits =3) == round(xy$lon[i], digits = 3) & round(output$lat, digits = 3) == round(xy$lat[i], digits = 3)) +# if (length(index)>0) +# { +# site = output[index,] +# for (j in 1:length(years)) +# { +# g = grep(site$calendar_date, pattern = years[j]) +# if (length(g) > 0) +# { +# d = site[g,] +# percentile = which(d$data <= quantile(d$data, probs = 0.95, na.rm = T)[1]) +# peak = max(d$data[percentile], na.rm = T) +# +# info = d[1,] +# info$data = peak +# info$calendar_date = years[j] +# +# summary = rbind(summary, info) +# } +# } +# } +# } +# +# peak_lai = data.frame() +# for (i in 1:nrow(xy)) +# { +# index = which(round(summary$lat, digits = 3) == round(xy$lat[i], digits = 3) & round(summary$lon, digits = 3) == round(xy$lon[i], digits = 3)) +# +# if (length(index) >0) +# { +# site = summary[index,] +# +# peak = mean(site$data, na.rm = T) +# info = site[1,] +# info$data = peak +# peak_lai = rbind(peak_lai, info) +# } +# } +# +# peak_lai = as.data.frame(peak_lai, row.names = NULL) +# semivariogram analysis + +#1. reproject spatial data into aea so distances are in meteres +coordinates(test) = ~lon+lat +projection(test) = crs(sites) +test = spTransform(test, CRS = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs ") + +library(gstat) +# 1. check that data is normally distributed, if not, transform. +hist(test$data) + +library(MASS) +norm = fitdistr(x = test$data, densfun = "normal") +test$trans= rnorm(test$data, mean = norm$estimate[1], sd = norm$estimate[2]) + +v = variogram(trans~1, data = test) +v.data = v[order(v$dist),] +plot(v) + +v.vgm = vgm( psill = NA, range = NA, model = "Sph", nugget = 1) +v.fit = fit.variogram(v, v.vgm, fit.sills = T, fit.ranges = T, fit.kappa = T) +plot(v, model = v.fit) + + + +cell_area= 37894.1 + +# make hexagonal tesselation grid +hex_grid <- make_grid(region, cell_area = cell_area, clip = FALSE) + +plot(region, col = "grey50", bg = "light blue") +plot(hex_grid, border = "orange", add = T) +# clip to ecogreion area + +samples = data.frame() +for (i in 1:length(names(hex_grid))) +{ + hex = hex_grid[i,] + sample = as.data.frame(spsample(hex, n = 1, type = 'random')) + names(sample) = c("x", "y") + samples = rbind(samples, sample) +} +coordinates(samples) = ~x+y +projection(samples) = crs(region) + +# clip out points outside of ecoregion area +samples <- gIntersection(samples, region, byid = TRUE) + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/ecoregion_lai_agb_trends.R b/modules/assim.sequential/inst/sda_backup/bmorrison/ecoregion_lai_agb_trends.R new file mode 100755 index 00000000000..98885da3863 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/ecoregion_lai_agb_trends.R @@ -0,0 +1,326 @@ +library(raster) +library(shapefiles) +library(sp) +library(PEcAn.data.remote) +library(sf) +library(dplyr) +library(rgdal) +library(tidyr) +library(rgeos) +library(rgbif) +library(viridis) +library(gridExtra) +library(rasterVis) +library(doParallel) +library(PEcAn.utils) +set.seed(1) + +eco = st_read(dsn = '/data/bmorrison/sda/ecoregion_site_analysis/shapefiles', layer = 'eco_conus_rename') +setwd('/data/bmorrison/sda/ecoregion_site_analysis/modis_data') + +### testing on 1 ecoregion +region = eco[eco$name == eco$name[11],] +region = st_union(region) +region = as(region, "Spatial") +region = spTransform(region, CRS = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs ") + + +# hexagonal tesellation random sampling + +# must be in meters +make_grid <- function(x, cell_diameter, cell_area, clip = FALSE) { + if (missing(cell_diameter)) { + if (missing(cell_area)) { + stop("Must provide cell_diameter or cell_area") + } else { + cell_diameter <- sqrt(2 * cell_area / sqrt(3)) + } + } + ext <- as(extent(x) + cell_diameter, "SpatialPolygons") + projection(ext) <- projection(x) + # generate array of hexagon centers + g <- spsample(ext, type = "hexagonal", cellsize = cell_diameter, + offset = c(0.5, 0.5)) + # convert center points to hexagons + g <- HexPoints2SpatialPolygons(g, dx = cell_diameter) + # clip to boundary of study area + if (clip) { + g <- gIntersection(g, x, byid = TRUE) + } else { + g <- g[x, ] + } + # clean up feature IDs + row.names(g) <- as.character(1:length(g)) + return(g) +} + +# trick to figure out how many polygons I want vs. cell area of hexagons +n <- 1000 + +area_of_region = raster::area(region) +cell_area= area_of_region/n + +# make hexagonal tesselation grid +hex_grid <- make_grid(region, cell_area = cell_area, clip = FALSE) +hex_grid <- make_grid(region, cell_diameter = 37894.1, clip = FALSE) + +plot(region, col = "grey50", bg = "light blue", axes = TRUE) +plot(hex_grid, border = "orange", add = T) +# clip to ecogreion area + +save(hex_grid, file = paste("/data/bmorrison/sda/ecoregion_site_analysis/hex_grid_", length(names(hex_grid)), ".Rdata", sep = "")) +load(paste("/data/bmorrison/sda/ecoregion_site_analysis/hex_grid_1164.Rdata", sep = "")) + +# randomly select one point from each hexagon (random) +samples = data.frame() +for (i in 1:length(names(hex_grid))) +{ + hex = hex_grid[i,] + sample = as.data.frame(spsample(hex, n = 1, type = 'random')) + names(sample) = c("x", "y") + samples = rbind(samples, sample) +} +coordinates(samples) = ~x+y +projection(samples) = crs(region) + +# clip out points outside of ecoregion area +samples <- gIntersection(samples, region, byid = TRUE) + +plot(region, col = "grey50", bg = "light blue", axes = TRUE) +plot(hex_grid, border = "orange", add = T) +csamples = spTransform(samples, CRS = crs(eco)) +region = spTransform(region, CRS = crs(eco)) + + +xy = as.data.frame(samples) +names(xy) = c("lon", "lat") +save(xy, file = paste('/data/bmorrison/sda/ecoregion_site_analysis/random_sites_', nrow(xy), '.Rdata', sep = "")) +# extract MODIS data for location + +load("/data/bmorrison/sda/ecoregion_site_analysis/random_sites_989.Rdata") + + +product = "MOD15A2H" + +dates = PEcAn.utils::retry.func(MODISTools::mt_dates(product, lat = xy$lat[1], lon = xy$lon[1]), maxError = 10, sleep = 2) + +starting_dates = dates$calendar_date[grep(dates$calendar_date, pattern = "2001-01")] +start_count = as.data.frame(table(starting_dates), stringsAsFactors = F) +start_date = gsub("-", "/", start_count$starting_dates[1]) + +ending_dates = dates$calendar_date[grep(dates$calendar_date, pattern = "2018-12")] +end_count = as.data.frame(table(ending_dates), stringsAsFactors = F) +end_date = gsub("-", "/", end_count$ending_dates[nrow(end_count)] ) + +# 10 cpu limit because THREADDS has 10 download limit +# xy = xy[601:nrow(xy),] +# +# cl <- parallel::makeCluster(10) #, outfile= "") +# doParallel::registerDoParallel(cl) +# +# output = data.frame() +# for (j in 1:ceiling(nrow(xy)/10)) +# { +# if (j == ceiling(nrow(xy)/10)) +# { +# coords = xy[((j*10)-9):nrow(xy),] +# working = print(paste("working on : ", ((j*10)-9+600), "-", nrow(xy)+600, sep = "")) +# +# } else { +# coords = xy[((j*10)-9):(j*10),] +# working = print(paste("working on : ", ((j*10)-9+600), "-", (j*10+600), sep = "")) +# +# } +# # siteID = paste(round(coords[i,], digits = 2), collapse = "_") +# start = Sys.time() +# data = PEcAn.utils::retry.func(foreach(i=1:nrow(coords), .combine = rbind) %dopar% PEcAn.data.remote::call_MODIS(outfolder = getwd(), iter = ((j*10-10)+i+600), product = "MOD15A2H",band = "Lai_500m", start_date = start_date, end_date = end_date, lat = coords$lat[i], lon = coords$lon[i],size = 0, band_qc = "FparLai_QC", band_sd = "", package_method = "MODISTools", QC_filter = T), maxError = 10, sleep = 2) +# end = Sys.time() +# difference = end-start +# time = print(difference) +# output = rbind(output, data) +# } +# +# # end = Sys.time() +# # difference = end-start +# # difference +# stopCluster(cl) +# +# +# save(output, file = paste('/data/bmorrison/sda/ecoregion_site_analysis/modis_data_output_', nrow(xy), '.Rdata', sep = "")) +# +# load(paste('/data/bmorrison/sda/ecoregion_site_analysis/modis_data_output_', nrow(output), '.Rdata', sep = "")) +# output = as.data.frame(output, row.names = NULL) + + + +# extract AGB data +start_date = "2001/01/01" +end_date = "2018/01/01" + +library(RCurl) +script <- getURL("https://raw.githubusercontent.com/serbinsh/pecan/download_osu_agb/modules/data.remote/R/LandTrendr.AGB.R", + ssl.verifypeer = FALSE) +eval(parse(text = script)) + +# for large datasets to group together +files = list.files(path = '/data/bmorrison/sda/ecoregion_site_analysis/modis_data', pattern = '.csv', include.dirs = T, full.names = T) +xy = data.frame() +for (i in 1:length(files)) +{ + f = read.csv(files[i]) + xy = rbind(xy, f) +} + +output = xy +# summarize into anual peak lai from 2001-2018 +years = lubridate::year(start_date):lubridate::year(end_date) + +data = output +load("/data/bmorrison/sda/ecoregion_site_analysis/random_sites_989.Rdata") + +# sites = xy +# coordinates(sites) = ~lon+lat +# projection(sites) = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs " +# sites = as.data.frame(unique(coordinates(sites))) +sites = SpatialPointsDataFrame(data = xy, coords = xy, proj4string = CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs ")) +compute_annual_lai = function(data, sites) +{ + index = which((round(data$lon, digits = 3)== round(sites$lon, digits = 3)) & (round(data$lat, digits = 3) == round(sites$lat, digits = 3))) + if (length(index) > 0) + { + site = data[index,] + years = unique(lubridate::year(site$calendar_date)) + + summary = data.frame() + for (j in 1:length(years)) + { + g = grep(site$calendar_date, pattern = years[j]) + if (length(g) > 0) + { + d = site[g,] + percentile = which(d$data <= quantile(d$data, probs = 0.95, na.rm = T)[1]) + peak = max(d$data[percentile], na.rm = T) + + info = d[1,] + info$data = peak + info$calendar_date = years[j] + + summary = rbind(summary, info) + } + } + peak_lai = summary[1,] + peak_lai$data = max(summary$data[which(summary$data <= quantile(summary$data, probs = 0.95))], na.rm = T) + return(peak_lai) + } +} +test = data.frame() +for (i in 1:nrow(sites)) +{ + working = print(i) + site = sites[i,] + t = compute_annual_lai(data = data, sites = site) + test = rbind(test,t) +} + +# cl <- parallel::makeCluster(10) #, outfile= "") +# doParallel::registerDoParallel(cl) +# +# test = foreach(i=1:nrow(sites), .combine = rbind) %dopar% compute_annual_lai(data = data, sites = sites[i,]) +# +# stopCluster(cl) + + +# +# +# +# summary =data.frame() +# for (i in 1:nrow(xy)) +# { +# index = which(round(output$lon, digits =3) == round(xy$lon[i], digits = 3) & round(output$lat, digits = 3) == round(xy$lat[i], digits = 3)) +# if (length(index)>0) +# { +# site = output[index,] +# for (j in 1:length(years)) +# { +# g = grep(site$calendar_date, pattern = years[j]) +# if (length(g) > 0) +# { +# d = site[g,] +# percentile = which(d$data <= quantile(d$data, probs = 0.95, na.rm = T)[1]) +# peak = max(d$data[percentile], na.rm = T) +# +# info = d[1,] +# info$data = peak +# info$calendar_date = years[j] +# +# summary = rbind(summary, info) +# } +# } +# } +# } +# +# peak_lai = data.frame() +# for (i in 1:nrow(xy)) +# { +# index = which(round(summary$lat, digits = 3) == round(xy$lat[i], digits = 3) & round(summary$lon, digits = 3) == round(xy$lon[i], digits = 3)) +# +# if (length(index) >0) +# { +# site = summary[index,] +# +# peak = mean(site$data, na.rm = T) +# info = site[1,] +# info$data = peak +# peak_lai = rbind(peak_lai, info) +# } +# } +# +# peak_lai = as.data.frame(peak_lai, row.names = NULL) +# semivariogram analysis + +#1. reproject spatial data into aea so distances are in meteres +coordinates(test) = ~lon+lat +projection(test) = crs(eco) +test = spTransform(test, CRS = "+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +ellps=GRS80 +datum=NAD83 +units=m +no_defs ") + +library(gstat) +# 1. check that data is normally distributed, if not, transform. +hist(test$data) + +library(MASS) +norm = fitdistr(x = test$data, densfun = "normal") +test$trans= rnorm(test$data, mean = norm$estimate[1], sd = norm$estimate[2]) + +v = variogram(trans~1, data = test) +v.data = v[order(v$dist),] +plot(v) + +v.vgm = vgm( psill = NA, range = NA, model = "Sph", nugget = 0.9) +v.fit = fit.variogram(v, v.vgm, fit.sills = T, fit.ranges = T, fit.kappa = T) +plot(v, model = v.fit) + + + +cell_area= 37894.1 + +# make hexagonal tesselation grid +hex_grid <- make_grid(region, cell_area = cell_area, clip = FALSE) + +plot(region, col = "grey50", bg = "light blue") +plot(hex_grid, border = "orange", add = T) +# clip to ecogreion area + +samples = data.frame() +for (i in 1:length(names(hex_grid))) +{ + hex = hex_grid[i,] + sample = as.data.frame(spsample(hex, n = 1, type = 'random')) + names(sample) = c("x", "y") + samples = rbind(samples, sample) +} +coordinates(samples) = ~x+y +projection(samples) = crs(region) + +# clip out points outside of ecoregion area +samples <- gIntersection(samples, region, byid = TRUE) + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/extract_500_site_data.R b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_500_site_data.R new file mode 100755 index 00000000000..52f5e545282 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_500_site_data.R @@ -0,0 +1,288 @@ +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +work_dir <- "/data/bmorrison/sda/lai" + +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_sitegroup.xml") + +if ("sitegroup" %in% names(settings)){ + if (is.null(settings$sitegroup$nSite)){ + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite) + } + settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading +} + + + + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + + + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +# get.parameter.samples(settings, +# ens.sample.method = settings$ensemble$samplingspace$parameters$method) +# ## Aside: if method were set to unscented, would take minimal changes to do UnKF +# #--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX +observations = observation +lai_data = data.frame() +for (i in 1:5) +{ + start = (1+((i-1)*10)) + end = start+9 + + obs = observations[start:end] + + working = print(paste("working on: ", i)) + sites = print(obs) + PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") + bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) + con <- PEcAn.DB::db.open(bety) + bety$con <- con + site_ID <- obs + suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + + suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) + suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) + site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + + lai = call_MODIS(outdir = NULL, var = "LAI", site_info = site_info, product_dates = c("1980001", "2018365"), + run_parallel = TRUE, ncores = 10, product = "MOD15A2H", band = "Lai_500m", + package_method = "MODISTools", QC_filter = TRUE, progress = FALSE) + + lai_data = rbind(lai_data, lai) + +} +lai_sd = lai_data +save(lai_data, file = '/data/bmorrison/sda/lai/50_site_run/lai_data_sites.Rdata') + +observation = observations +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) +# # output folder for the data +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# +# # # extract the data +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# +# ndates = colnames(med_agb_data)[-c(1:2)] +# +# med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +# med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) +# +# sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +# sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) +# +# agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +# names(agb_data) = c("Site_ID", "Date", "Median", "SD") +# agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) +# +# save AGB data into long style +#save(agb_data, file = '/data/bmorrison/sda/lai/50_site_run/agb_data_sites.Rdata') + +######### calculate peak_lai +# already in long format style for dataframe +names(lai_sd) = c("modis_date", "calendar_date", "band", "tile", "site_id", "lat", "lon", "pixels", "sd", "qc") +output = cbind(lai_data, lai_sd$sd) +names(output) = c(names(lai_data), "sd") +#output = as.data.frame(data) +save(output, file = '/data/bmorrison/sda/lai/50_site_run/all_lai_data.Rdata') + +# change tile names to the site name +h +# remove extra data +output = output[,c(5, 2, 9, 11)] +colnames(output) = names(agb_data) + +# compute peak lai per year +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +for (i in seq_along(years)) +{ + d = data[grep(data$Date, pattern = years[i]),] + sites = unique(d$Site_ID) + for (j in seq_along(sites)) + { + index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) + site = d[index,] + if (length(index) > 0) + { + # peak lai is the max value that is the value <95th quantile to remove potential outlier values + max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] + peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) + peak_lai = rbind(peak_lai, peak) + + } + } +} + +# a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +peak_lai$SD[peak_lai$SD < 0.66] = 0.66 + +#output data +names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +save(peak_lai, file = '/data/bmorrison/sda/lai/50_site_run/peak_lai_data.Rdata') + + +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) + +observed_vars = c("AbvGrndWood", "LAI") + + +# merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") + +# order by year +observed_data = observed_data[order(observed_data$Date),] + +#sort by date +dates = sort(unique(observed_data$Date)) + +# create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) + +obs.mean = obs.mean %>% + split(.$date) + +# change the dates to be middle of the year +date.obs <- strsplit(names(obs.mean), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean = names(obs.mean) %>% + map(function(namesl){ + obs.mean[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI")) %>% `row.names<-`(NULL)) + #setNames(site.ids) + }) %>% setNames(date.obs) + +#remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +names = date.obs +for (name in names) +{ + for (site in names(obs.mean[[name]])) + { + na_index = which(!(is.na(obs.mean[[ name]][[site]]))) + colnames = names(obs.mean[[name]][[site]]) + if (length(na_index) > 0) + { + obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] + } + } +} + +# fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) + +# create obs.cov dataframe -->list by date +obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai)#, filler_0) +obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) + +obs.cov = obs.cov %>% + split(.$date) + +obs.cov = names(obs.cov) %>% + map(function(namesl){ + obs.cov[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4]^2 %>% unlist %>% diag(nrow = 2, ncol = 2) ) + }) %>% setNames(date.obs) + + +names = date.obs +for (name in names) +{ + for (site in names(obs.cov[[name]])) + { + bad = which(apply(obs.cov[[name]][[site]], 2, function(x) any(is.na(x))) == TRUE) + if (length(bad) > 0) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][,-bad] + if (is.null(dim(obs.cov[[name]][[site]]))) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad] + } else { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad,] + } + } + } +} + + +save(obs.mean, file = '/data/bmorrison/sda/lai/50_site_run/obs_mean_50.Rdata') +save(obs.cov, file = '/data/bmorrison/sda/lai/50_site_run/obs_cov_50.Rdata') + + + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/extract_50_sitegroup_data.R b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_50_sitegroup_data.R new file mode 100755 index 00000000000..f715a1261bf --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_50_sitegroup_data.R @@ -0,0 +1,289 @@ +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +work_dir <- "/data/bmorrison/sda/lai" + +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_sitegroup.xml") + +if ("sitegroup" %in% names(settings)){ + if (is.null(settings$sitegroup$nSite)){ + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite) + } + settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading +} + + + + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + + + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +# get.parameter.samples(settings, +# ens.sample.method = settings$ensemble$samplingspace$parameters$method) +# ## Aside: if method were set to unscented, would take minimal changes to do UnKF +# #--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX +observations = observation +lai_data = data.frame() +for (i in 1:5) +{ + start = (1+((i-1)*10)) + end = start+9 + + obs = observations[start:end] + + working = print(paste("working on: ", i)) + sites = print(obs) + PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") + bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) + con <- PEcAn.DB::db.open(bety) + bety$con <- con + site_ID <- obs + suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + + suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) + suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) + site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + + lai = call_MODIS(outdir = NULL, var = "LAI", site_info = site_info, product_dates = c("1980001", "2018365"), + run_parallel = TRUE, ncores = 10, product = "MOD15A2H", band = "Lai_500m", + package_method = "MODISTools", QC_filter = TRUE, progress = FALSE) + + lai_data = rbind(lai_data, lai) + +} +lai_sd = lai_data +save(lai_data, file = '/data/bmorrison/sda/lai/50_site_run/lai_data_sites.Rdata') + +observation = observations +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) +# # output folder for the data +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# +# # # extract the data +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# +# ndates = colnames(med_agb_data)[-c(1:2)] +# +# med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +# med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) +# +# sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +# sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) +# +# agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +# names(agb_data) = c("Site_ID", "Date", "Median", "SD") +# agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) +# +# save AGB data into long style +#save(agb_data, file = '/data/bmorrison/sda/lai/50_site_run/agb_data_sites.Rdata') + +######### calculate peak_lai +# already in long format style for dataframe +names(lai_sd) = c("modis_date", "calendar_date", "band", "tile", "site_id", "lat", "lon", "pixels", "sd", "qc") +output = cbind(lai_data, lai_sd$sd) +names(output) = c(names(lai_data), "sd") +#output = as.data.frame(data) +save(output, file = '/data/bmorrison/sda/lai/50_site_run/all_lai_data.Rdata') + +# change tile names to the site name +h +# remove extra data +output = output[,c(5, 2, 9, 11)] +colnames(output) = names(agb_data) + +# compute peak lai per year +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +for (i in seq_along(years)) +{ + d = data[grep(data$Date, pattern = years[i]),] + sites = unique(d$Site_ID) + for (j in seq_along(sites)) + { + index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) + site = d[index,] + if (length(index) > 0) + { + # peak lai is the max value that is the value <95th quantile to remove potential outlier values + max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] + peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) + peak_lai = rbind(peak_lai, peak) + + } + } +} + +# a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +peak_lai$SD[peak_lai$SD < 0.66] = 0.66 + +#output data +names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +save(peak_lai, file = '/data/bmorrison/sda/lai/50_site_run/peak_lai_data.Rdata') + + +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) + +observed_vars = c("AbvGrndWood", "LAI") + + +# merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") + +# order by year +observed_data = observed_data[order(observed_data$Date),] + +#sort by date +dates = sort(unique(observed_data$Date)) + +# create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) + +obs.mean = obs.mean %>% + split(.$date) + +# change the dates to be middle of the year +date.obs <- strsplit(names(obs.mean), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean = names(obs.mean) %>% + map(function(namesl){ + obs.mean[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI")) %>% `row.names<-`(NULL)) + #setNames(site.ids) + }) %>% setNames(date.obs) + +#remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +names = date.obs +for (name in names) +{ + for (site in names(obs.mean[[name]])) + { + na_index = which(!(is.na(obs.mean[[ name]][[site]]))) + colnames = names(obs.mean[[name]][[site]]) + if (length(na_index) > 0) + { + obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] + } + } +} + +# fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) + +# create obs.cov dataframe -->list by date +obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai)#, filler_0) +obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) + +obs.cov = obs.cov %>% + split(.$date) + +obs.cov = names(obs.cov) %>% + map(function(namesl){ + obs.cov[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4]^2 %>% unlist %>% diag(nrow = 2, ncol = 2) ) + }) %>% setNames(date.obs) + + +names = date.obs +for (name in names) +{ + for (site in names(obs.cov[[name]])) + { + bad = which(apply(obs.cov[[name]][[site]], 2, function(x) any(is.na(x))) == TRUE) + if (length(bad) > 0) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][,-bad] + if (is.null(dim(obs.cov[[name]][[site]]))) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad] + } else { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad,] + } + } + } +} + + +save(obs.mean, file = '/data/bmorrison/sda/lai/50_site_run/obs_mean_50.Rdata') +save(obs.cov, file = '/data/bmorrison/sda/lai/50_site_run/obs_cov_50.Rdata') + + + + \ No newline at end of file diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/extract_50_sitegroup_data_2.R b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_50_sitegroup_data_2.R new file mode 100755 index 00000000000..f715a1261bf --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_50_sitegroup_data_2.R @@ -0,0 +1,289 @@ +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +work_dir <- "/data/bmorrison/sda/lai" + +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_sitegroup.xml") + +if ("sitegroup" %in% names(settings)){ + if (is.null(settings$sitegroup$nSite)){ + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite) + } + settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading +} + + + + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + + + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +# get.parameter.samples(settings, +# ens.sample.method = settings$ensemble$samplingspace$parameters$method) +# ## Aside: if method were set to unscented, would take minimal changes to do UnKF +# #--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX +observations = observation +lai_data = data.frame() +for (i in 1:5) +{ + start = (1+((i-1)*10)) + end = start+9 + + obs = observations[start:end] + + working = print(paste("working on: ", i)) + sites = print(obs) + PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") + bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) + con <- PEcAn.DB::db.open(bety) + bety$con <- con + site_ID <- obs + suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + + suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) + suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) + site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + + lai = call_MODIS(outdir = NULL, var = "LAI", site_info = site_info, product_dates = c("1980001", "2018365"), + run_parallel = TRUE, ncores = 10, product = "MOD15A2H", band = "Lai_500m", + package_method = "MODISTools", QC_filter = TRUE, progress = FALSE) + + lai_data = rbind(lai_data, lai) + +} +lai_sd = lai_data +save(lai_data, file = '/data/bmorrison/sda/lai/50_site_run/lai_data_sites.Rdata') + +observation = observations +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) +# # output folder for the data +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# +# # # extract the data +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# +# ndates = colnames(med_agb_data)[-c(1:2)] +# +# med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +# med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) +# +# sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +# sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) +# +# agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +# names(agb_data) = c("Site_ID", "Date", "Median", "SD") +# agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) +# +# save AGB data into long style +#save(agb_data, file = '/data/bmorrison/sda/lai/50_site_run/agb_data_sites.Rdata') + +######### calculate peak_lai +# already in long format style for dataframe +names(lai_sd) = c("modis_date", "calendar_date", "band", "tile", "site_id", "lat", "lon", "pixels", "sd", "qc") +output = cbind(lai_data, lai_sd$sd) +names(output) = c(names(lai_data), "sd") +#output = as.data.frame(data) +save(output, file = '/data/bmorrison/sda/lai/50_site_run/all_lai_data.Rdata') + +# change tile names to the site name +h +# remove extra data +output = output[,c(5, 2, 9, 11)] +colnames(output) = names(agb_data) + +# compute peak lai per year +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +for (i in seq_along(years)) +{ + d = data[grep(data$Date, pattern = years[i]),] + sites = unique(d$Site_ID) + for (j in seq_along(sites)) + { + index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) + site = d[index,] + if (length(index) > 0) + { + # peak lai is the max value that is the value <95th quantile to remove potential outlier values + max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] + peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) + peak_lai = rbind(peak_lai, peak) + + } + } +} + +# a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +peak_lai$SD[peak_lai$SD < 0.66] = 0.66 + +#output data +names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +save(peak_lai, file = '/data/bmorrison/sda/lai/50_site_run/peak_lai_data.Rdata') + + +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) + +observed_vars = c("AbvGrndWood", "LAI") + + +# merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") + +# order by year +observed_data = observed_data[order(observed_data$Date),] + +#sort by date +dates = sort(unique(observed_data$Date)) + +# create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) + +obs.mean = obs.mean %>% + split(.$date) + +# change the dates to be middle of the year +date.obs <- strsplit(names(obs.mean), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean = names(obs.mean) %>% + map(function(namesl){ + obs.mean[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI")) %>% `row.names<-`(NULL)) + #setNames(site.ids) + }) %>% setNames(date.obs) + +#remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +names = date.obs +for (name in names) +{ + for (site in names(obs.mean[[name]])) + { + na_index = which(!(is.na(obs.mean[[ name]][[site]]))) + colnames = names(obs.mean[[name]][[site]]) + if (length(na_index) > 0) + { + obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] + } + } +} + +# fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) + +# create obs.cov dataframe -->list by date +obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai)#, filler_0) +obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) + +obs.cov = obs.cov %>% + split(.$date) + +obs.cov = names(obs.cov) %>% + map(function(namesl){ + obs.cov[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4]^2 %>% unlist %>% diag(nrow = 2, ncol = 2) ) + }) %>% setNames(date.obs) + + +names = date.obs +for (name in names) +{ + for (site in names(obs.cov[[name]])) + { + bad = which(apply(obs.cov[[name]][[site]], 2, function(x) any(is.na(x))) == TRUE) + if (length(bad) > 0) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][,-bad] + if (is.null(dim(obs.cov[[name]][[site]]))) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad] + } else { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad,] + } + } + } +} + + +save(obs.mean, file = '/data/bmorrison/sda/lai/50_site_run/obs_mean_50.Rdata') +save(obs.cov, file = '/data/bmorrison/sda/lai/50_site_run/obs_cov_50.Rdata') + + + + \ No newline at end of file diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/extract_lai_agb_data.R b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_lai_agb_data.R new file mode 100755 index 00000000000..23af11a8415 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_lai_agb_data.R @@ -0,0 +1,287 @@ +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +work_dir <- "/data/bmorrison/sda/500_site_run" + +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_sitegroup.xml") + +if ("sitegroup" %in% names(settings)){ + if (is.null(settings$sitegroup$nSite)){ + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite) + } + settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading +} + + + + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + + + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +# get.parameter.samples(settings, +# ens.sample.method = settings$ensemble$samplingspace$parameters$method) +# ## Aside: if method were set to unscented, would take minimal changes to do UnKF +# #--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX +observations = observation +lai_data = data.frame() +for (i in 1:16) +{ + start = (1+((i-1)*10)) + end = start+9 + obs = observations[start:end] + + working = print(paste("working on: ", i)) + sites = print(obs) + PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") + bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) + con <- PEcAn.DB::db.open(bety) + bety$con <- con + site_ID <- obs + suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + + suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) + suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) + site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + + lai = call_MODIS(outdir = NULL, var = "LAI", site_info = site_info, product_dates = c("1980001", "2018365"), + run_parallel = TRUE, ncores = 10, product = "MOD15A2H", band = "LaiStdDev_500m", + package_method = "MODISTools", QC_filter = TRUE, progress = FALSE) + + lai_data = rbind(lai_data, lai) + lai_sd = lai_data + save(lai_sd, file = paste('/data/bmorrison/sda/500_site_run/lai_sd_sites_', i, '.Rdata', sep = "")) + +} + +observation = observations +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) +# # output folder for the data +data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" + +# # extract the data +med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] + +sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] + +# +# ndates = colnames(med_agb_data)[-c(1:2)] +# +med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) + +sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) + +agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +names(agb_data) = c("Site_ID", "Date", "Median", "SD") +agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) + +save AGB data into long style +save(agb_data, file = '/data/bmorrison/sda/500_site_run/agb_data_sites.Rdata') + +######### calculate peak_lai +# already in long format style for dataframe +names(lai_sd) = c("modis_date", "calendar_date", "band", "tile", "site_id", "lat", "lon", "pixels", "sd", "qc") +output = cbind(lai_data, lai_sd$sd) +names(output) = c(names(lai_data), "sd") +#output = as.data.frame(data) +save(output, file = '/data/bmorrison/sda/lai/50_site_run/all_lai_data.Rdata') + +# change tile names to the site name +h +# remove extra data +output = output[,c(5, 2, 9, 11)] +colnames(output) = names(agb_data) + +# compute peak lai per year +data = output +peak_lai = data.frame() +years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +for (i in seq_along(years)) +{ + d = data[grep(data$Date, pattern = years[i]),] + sites = unique(d$Site_ID) + for (j in seq_along(sites)) + { + index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) + site = d[index,] + if (length(index) > 0) + { + # peak lai is the max value that is the value <95th quantile to remove potential outlier values + max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] + peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) + peak_lai = rbind(peak_lai, peak) + + } + } +} + +# a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +peak_lai$SD[peak_lai$SD < 0.66] = 0.66 + +#output data +names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +save(peak_lai, file = '/data/bmorrison/sda/lai/50_site_run/peak_lai_data.Rdata') + + +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) + +observed_vars = c("AbvGrndWood", "LAI") + + +# merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") + +# order by year +observed_data = observed_data[order(observed_data$Date),] + +#sort by date +dates = sort(unique(observed_data$Date)) + +# create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) + +obs.mean = obs.mean %>% + split(.$date) + +# change the dates to be middle of the year +date.obs <- strsplit(names(obs.mean), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean = names(obs.mean) %>% + map(function(namesl){ + obs.mean[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI")) %>% `row.names<-`(NULL)) + #setNames(site.ids) + }) %>% setNames(date.obs) + +#remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +names = date.obs +for (name in names) +{ + for (site in names(obs.mean[[name]])) + { + na_index = which(!(is.na(obs.mean[[ name]][[site]]))) + colnames = names(obs.mean[[name]][[site]]) + if (length(na_index) > 0) + { + obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] + } + } +} + +# fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) + +# create obs.cov dataframe -->list by date +obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai)#, filler_0) +obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) + +obs.cov = obs.cov %>% + split(.$date) + +obs.cov = names(obs.cov) %>% + map(function(namesl){ + obs.cov[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4]^2 %>% unlist %>% diag(nrow = 2, ncol = 2) ) + }) %>% setNames(date.obs) + + +names = date.obs +for (name in names) +{ + for (site in names(obs.cov[[name]])) + { + bad = which(apply(obs.cov[[name]][[site]], 2, function(x) any(is.na(x))) == TRUE) + if (length(bad) > 0) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][,-bad] + if (is.null(dim(obs.cov[[name]][[site]]))) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad] + } else { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad,] + } + } + } +} + + +save(obs.mean, file = '/data/bmorrison/sda/lai/50_site_run/obs_mean_50.Rdata') +save(obs.cov, file = '/data/bmorrison/sda/lai/50_site_run/obs_cov_50.Rdata') + + + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/extract_lai_agb_data_500.R b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_lai_agb_data_500.R new file mode 100755 index 00000000000..0ce0b06efcf --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/extract_lai_agb_data_500.R @@ -0,0 +1,368 @@ +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +work_dir <- "/data/bmorrison/sda/500_site_run" + +# delete an old run +#unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_sitegroup_500.xml") + +if ("sitegroup" %in% names(settings)){ + if (is.null(settings$sitegroup$nSite)){ + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite) + } + settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading +} + + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + + +sites_500 = observation +load('/data/bmorrison/sda/500_site_run/all_lai_data.Rdata') +sites_200 = sort(unique(output$site_id)) + +# list for 500 sites +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- sites_500 +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +sites_500 <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +# list for previous 200 sites +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- sites_200 +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +sites_200 <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +# remove sites that were done from the 200 site run +sites_500_xy = as.data.frame(cbind(sites_500$lon, sites_500$lat)) +sites_200_xy = as.data.frame(cbind(sites_200$lon, sites_200$lat)) + +remove = vector() +for (i in 1:nrow(sites_200_xy)) +{ + index = which(sites_500_xy$V1 == sites_200_xy$V1[i] & sites_500_xy$V2 == sites_200_xy$V2[i]) + remove = c(remove, index) +} + +observation = sort(c(sites_500$site_id[-remove])) + + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX +observations = observation +lai_data = data.frame() +for (i in :37) +{ + start = (1+((i-1)*10)) + end = start+9 + obs = observations[start:end] + + working = print(paste("working on: ", i)) + sites = print(obs) + PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") + bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) + con <- PEcAn.DB::db.open(bety) + bety$con <- con + site_ID <- obs + suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + + suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) + suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) + site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + + lai = call_MODIS(outdir = NULL, var = "LAI", site_info = site_info, product_dates = c("1980001", "2018365"), + run_parallel = TRUE, ncores = 10, product = "MOD15A2H", band = "LaiStdDev_500m", + package_method = "MODISTools", QC_filter = TRUE, progress = FALSE) + + #lai_data = rbind(lai_data, lai) + sd = lai + save(sd, file = paste('/data/bmorrison/sda/500_site_run/lai_sd_sites_', i+16, '.Rdata', sep = "")) + +} + +observation = observations +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) +# # output folder for the data +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# +# # # extract the data +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# # +# # ndates = colnames(med_agb_data)[-c(1:2)] +# # +# med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +# med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) +# +# sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +# sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) +# +# agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +# names(agb_data) = c("Site_ID", "Date", "Median", "SD") +# agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) +# +# #save AGB data into long style +# save(agb_data, file = '/data/bmorrison/sda/500_site_run/agb_data_sites_500.Rdata') + +######### calculate peak_lai +# already in long format style for dataframe +names(lai_sd) = c("modis_date", "calendar_date", "band", "tile", "site_id", "lat", "lon", "pixels", "sd", "qc") +output = cbind(lai_data, lai_sd$sd) +names(output) = c(names(lai_data), "sd") +#output = as.data.frame(data) +save(output, file = '/data/bmorrison/sda/lai/50_site_run/all_lai_data.Rdata') + +# remove extra data +output = output[,c(5, 2, 9, 11)] +colnames(output) = names(agb_data) # should be Site_ID, Date, Median, SD + +data = output +data = data[-which(data$SD > 6),] +peak_lai = data.frame() + + +### Mikes way to do peak LAI for the summer months (weighted precision) +years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +for (i in 1:length(years)) +{ + d = data[grep(data$Date, pattern = years[i]),] + sites = unique(d$Site_ID) + for (j in 1:length(sites)) + { + index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) + site = d[index,] + if (length(index) > 0) + { + dates = as.Date(site$Date, format = "%Y-%m-%d") + index = which(dates >= as.Date(paste(years[i], "06-15", sep = "-")) & dates <= as.Date(paste(years[i], "08-15", sep = "-"))) + info = site[index,] + + weights = info$SD/sum(info$SD) + mean = sum(info$Median*weights) + sd = sum(info$SD*weights) + + output = as.data.frame(cbind(sites[j], paste(years[i], "07-15", sep = "-"), mean, sd), stringsAsFactors = F) + names(output) = c("Site_ID", "Date", "Median", "SD") + peak_lai = rbind(peak_lai, output) + } + } +} + +peak_lai$Site_ID = as.numeric(peak_lai$Site_ID) +peak_lai$Date = as.Date(peak_lai$Date) +peak_lai$Median = as.numeric(peak_lai$Median) +peak_lai$SD = as.numeric(peak_lai$SD) +peak_lai$Date = paste("Year", year(peak_lai$Date), sep = "_") + + + + +# compute peak lai per year +# data = output +# peak_lai = data.frame() +# years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +# for (i in seq_along(years)) +# { +# d = data[grep(data$Date, pattern = years[i]),] +# sites = unique(d$Site_ID) +# for (j in seq_along(sites)) +# { +# index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) +# site = d[index,] +# #count = print(nrow(site)) +# if (length(index) > 0) +# { +# # peak lai is the max value that is the value <95th quantile to remove potential outlier values +# max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] +# peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) +# peak_lai = rbind(peak_lai, peak) +# +# } +# } +# } +# +# # a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +# peak_lai$SD[peak_lai$SD < 0.66] = 0.66 +# +# #output data +# names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +# save(peak_lai, file = '/data/bmorrison/sda/500_site_run/peak_lai_data_500.Rdata') + + +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) + +observed_vars = c("AbvGrndWood", "LAI") + + +# merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") + +# order by year +observed_data = observed_data[order(observed_data$Date),] + +#sort by date +dates = sort(unique(observed_data$Date)) + +# create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) + +obs.mean = obs.mean %>% + split(.$date) + +# change the dates to be middle of the year +date.obs <- strsplit(names(obs.mean), "_") %>% + map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean = names(obs.mean) %>% + map(function(namesl){ + obs.mean[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI")) %>% `row.names<-`(NULL)) + #setNames(site.ids) + }) %>% setNames(date.obs) + +#remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +names = date.obs +for (name in names) +{ + for (site in names(obs.mean[[name]])) + { + na_index = which(!(is.na(obs.mean[[ name]][[site]]))) + colnames = names(obs.mean[[name]][[site]]) + if (length(na_index) > 0) + { + obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] + } + } +} + +# fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) + +# create obs.cov dataframe -->list by date +obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai)#, filler_0) +obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) + +obs.cov = obs.cov %>% + split(.$date) + +obs.cov = names(obs.cov) %>% + map(function(namesl){ + obs.cov[[namesl]] %>% + split(.$site_id) %>% + map(~.x[3:4]^2 %>% unlist %>% diag(nrow = 2, ncol = 2) ) + }) %>% setNames(date.obs) + + +names = date.obs +for (name in names) +{ + for (site in names(obs.cov[[name]])) + { + bad = which(apply(obs.cov[[name]][[site]], 2, function(x) any(is.na(x))) == TRUE) + if (length(bad) > 0) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][,-bad] + if (is.null(dim(obs.cov[[name]][[site]]))) + { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad] + } else { + obs.cov[[name]][[site]] = obs.cov[[name]][[site]][-bad,] + } + } + } +} + + +save(obs.mean, file = '/data/bmorrison/sda/500_site_run/obs_mean_500_ave.Rdata') +save(obs.cov, file = '/data/bmorrison/sda/500_site_run/obs_cov_500_ave.Rdata') + + + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/general_sda_setup.R b/modules/assim.sequential/inst/sda_backup/bmorrison/general_sda_setup.R new file mode 100755 index 00000000000..174a14f3209 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/general_sda_setup.R @@ -0,0 +1,301 @@ + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(future) +library(tictoc) +#--------------------------------------------------------------------------------------------------# +######################################## INTIAL SET UP STUFF ####################################### +work_dir <- "/data/bmorrison/sda/lai" + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_8_Sites_2009.xml") + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +#observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX + +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +# +# ###################### EXTRACT AGB DATA + REFORMAT LONG VS. WIDE STYLE ##################################### +# ### this is for LandTrendr data ### +# +# # output folder for the data +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# +# # extract the data +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# +# ### temporary fix to make agb data long vs. wide format to match modis data. ### +# ndates = colnames(med_agb_data)[-c(1:2)] +# +# med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +# med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) +# +# sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +# sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) +# +# agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +# names(agb_data) = c("Site_ID", "Date", "Median", "SD") +# agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) +# +# # save AGB data into long style +# save(agb_data, file = '/data/bmorrison/sda/lai/modis_lai_data/agb_data_update_sites.Rdata') +# +# +# # ####################### Extract MODISTools LAI data ############################## +# +# library(doParallel) +# cl <- parallel::makeCluster(10, outfile="") +# doParallel::registerDoParallel(cl) +# +# start = Sys.time() +# # keep QC_filter on for this because bad LAI values crash the SDA. Progress can be turned off if it annoys you. +# data = foreach(i=1:length(site_info$site_id), .combine = rbind) %dopar% PEcAn.data.remote::call_MODIS(start_date = "2000/01/01", end_date = "2017/12/31", band = "Lai_500m", product = "MOD15A2H", lat = site_info$lat[i], lon = site_info$lon[i], size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools", QC_filter = T, progress = T) +# end = Sys.time() +# difference = end-start +# stopCluster(cl) +# +# # already in long format style for dataframe +# output = as.data.frame(data) +# save(output, file = '/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_update_sites.Rdata') +# +# # change tile names to the site name +# for (i in 1:length(site_info$site_name)) +# { +# name = as.character(site_info$site_id[i], stringsAsFactor = F) +# g = which(round(output$lat, digits = 3) == round(site_info$lat[i], digits = 3)) +# output$tile[g] = name +# } +# # remove extra data +# output = output[,c(4,2,8,10)] +# colnames(output) = names(agb_data) +# +# # compute peak lai per year +# data = output +# peak_lai = data.frame() +# years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +# for (i in seq_along(years)) +# { +# d = data[grep(data$Date, pattern = years[i]),] +# sites = unique(d$Site_ID) +# for (j in seq_along(sites)) +# { +# index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) +# site = d[index,] +# if (length(index) > 0) +# { +# # peak lai is the max value that is the value <95th quantile to remove potential outlier values +# max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] +# peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) +# peak_lai = rbind(peak_lai, peak) +# +# } +# } +# } +# +# # a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +# peak_lai$SD[peak_lai$SD < 0.66] = 0.66 +# +# #output data +# names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +# save(peak_lai, file = '/data/bmorrison/sda/lai/modis_lai_data/peak_lai_output_update_sites.Rdata') +# +# +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +# ################# +# load('/data/bmorrison/sda/lai/modis_lai_data/agb_data_update_sites.Rdata') +# load( '/data/bmorrison/sda/lai/modis_lai_data/peak_lai_output_update_sites.Rdata') +# # output likes to make factors ..... :/... so this unfactors them +# peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +# peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) +# +# observed_vars = c("AbvGrndWood", "LAI") +# +# +# # merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +# observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +# names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") +# +# # order by year +# observed_data = observed_data[order(observed_data$Date),] +# +# #sort by date +# dates = sort(unique(observed_data$Date)) +# +# # create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +# obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +# obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) +# +# obs.mean = obs.mean %>% +# split(.$date) +# +# # change the dates to be middle of the year +# date.obs <- strsplit(names(obs.mean), "_") %>% +# map_chr(~.x[2]) %>% paste0(.,"/07/15") +# +# obs.mean = names(obs.mean) %>% +# map(function(namesl){ +# obs.mean[[namesl]] %>% +# split(.$site_id) %>% +# map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI"))) %>% +# setNames(site.ids) +# }) %>% setNames(date.obs) +# +# # remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +# names = date.obs +# for (name in names) +# { +# for (site in names(obs.mean[[name]])) +# { +# na_index = which(!(is.na(obs.mean[[ name]][[site]]))) +# colnames = names(obs.mean[[name]][[site]]) +# if (length(na_index) > 0) +# { +# obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] +# row.names(obs.mean[[name]][[site]]) = NULL +# } +# } +# } +# +# # fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) +# +# # create obs.cov dataframe -->list by date +# obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai, filler_0) +# obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) +# +# obs.cov = obs.cov %>% +# split(.$date) +# +# #sublist by date --> site +# obs.cov = names(obs.cov) %>% +# map(function(namesl){ +# obs.cov[[namesl]] %>% +# split(.$site_id) %>% +# map(~diag(.x[3:4]^2, nrow = 2, ncol = 2)) %>% +# setNames(site.ids)}) %>% +# setNames(date.obs) +# +# # remove NA/missing observations from covariance matrix and removes NA values to restructure size of covar matrix +# names = names(obs.cov) +# for (name in names) +# { +# for (site in names(obs.cov[[name]])) +# { +# na_index = which(is.na(obs.cov[[ name]][[site]])) +# if (length(na_index) > 0) +# { +# n_good_vars = length(observed_vars)-length(na_index) +# obs.cov[[name]][[site]] = matrix(obs.cov[[name]][[site]][-na_index], nrow = n_good_vars, ncol = n_good_vars) +# } +# } +# } +# +# # save these lists for future use. +# save(obs.mean, file = '/data/bmorrison/sda/lai/obs_mean_update_sites.Rdata') +# save(obs.cov, file = '/data/bmorrison/sda/lai/obs_cov_update_sites.Rdata') +# save(date.obs, file = '/data/bmorrison/sda/lai/date_obs_update_sites.Rdata') + + + +################################ START THE SDA ######################################## +load('/data/bmorrison/sda/lai/obs_mean_update_sites.Rdata') +load('/data/bmorrison/sda/lai/obs_cov_update_sites.Rdata') +date.obs = names(obs.mean) + +new.settings <- PEcAn.settings::prepare.settings(settings) + +#unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(new.settings, + obs.mean =obs.mean, + obs.cov = obs.cov, + keepNC = TRUE, + forceRun = TRUE, + control=list(trace=TRUE, + FF=FALSE, + interactivePlot=FALSE, + TimeseriesPlot=TRUE, + BiasPlot=FALSE, + plot.title=NULL, + facet.plots=4, + debug=FALSE, + pause=FALSE, + Profiling = FALSE, + OutlierDetection=FALSE)) + + + + +### FOR PLOTTING after analysis if TimeseriesPlot == FALSE) +load('/data/bmorrison/sda/lai/SDA/sda.output.Rdata') +facetg=4 +readsFF=NULL + +obs.mean = Viz.output[[2]] +obs.cov = Viz.output[[3]] +obs.times = names(obs.mean) +PEcAn.assim.sequential::post.analysis.multisite.ggplot(settings = new.settings, t, obs.times, obs.mean, obs.cov, FORECAST, ANALYSIS, plot.title=NULL, facetg=facetg, readsFF=NULL) + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/general_sda_setup_2.R b/modules/assim.sequential/inst/sda_backup/bmorrison/general_sda_setup_2.R new file mode 100755 index 00000000000..174a14f3209 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/general_sda_setup_2.R @@ -0,0 +1,301 @@ + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(future) +library(tictoc) +#--------------------------------------------------------------------------------------------------# +######################################## INTIAL SET UP STUFF ####################################### +work_dir <- "/data/bmorrison/sda/lai" + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("pecan_MultiSite_SDA_LAI_AGB_8_Sites_2009.xml") + +# doesn't work for one site +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +#observation = "1000000048" + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +############################ EXTRACT SITE INFORMATION FROM XML TO DOWNLOAD DATA + RUN SDA ########################### +################ Not working on interactive job on MODEX + +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +# +# ###################### EXTRACT AGB DATA + REFORMAT LONG VS. WIDE STYLE ##################################### +# ### this is for LandTrendr data ### +# +# # output folder for the data +# data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +# +# # extract the data +# med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", +# data_dir, product_dates=NULL, file.path(work_dir,"Obs"))[[1]] +# +# +# ### temporary fix to make agb data long vs. wide format to match modis data. ### +# ndates = colnames(med_agb_data)[-c(1:2)] +# +# med_agb_data$Site_Name = as.character(med_agb_data$Site_Name, stringsAsFactors = FALSE) +# med_agb_data = reshape2::melt(med_agb_data, id.vars = "Site_ID", measure.vars = colnames(med_agb_data)[-c(1:2)]) +# +# sdev_agb_data$Site_Name = as.character(sdev_agb_data$Site_Name, stringsAsFactors = FALSE) +# sdev_agb_data = reshape2::melt(sdev_agb_data, id.vars = "Site_ID", measure.vars = colnames(sdev_agb_data)[-c(1:2)]) +# +# agb_data = as.data.frame(cbind(med_agb_data, sdev_agb_data$value)) +# names(agb_data) = c("Site_ID", "Date", "Median", "SD") +# agb_data$Date = as.character(agb_data$Date, stringsAsFactors = FALSE) +# +# # save AGB data into long style +# save(agb_data, file = '/data/bmorrison/sda/lai/modis_lai_data/agb_data_update_sites.Rdata') +# +# +# # ####################### Extract MODISTools LAI data ############################## +# +# library(doParallel) +# cl <- parallel::makeCluster(10, outfile="") +# doParallel::registerDoParallel(cl) +# +# start = Sys.time() +# # keep QC_filter on for this because bad LAI values crash the SDA. Progress can be turned off if it annoys you. +# data = foreach(i=1:length(site_info$site_id), .combine = rbind) %dopar% PEcAn.data.remote::call_MODIS(start_date = "2000/01/01", end_date = "2017/12/31", band = "Lai_500m", product = "MOD15A2H", lat = site_info$lat[i], lon = site_info$lon[i], size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools", QC_filter = T, progress = T) +# end = Sys.time() +# difference = end-start +# stopCluster(cl) +# +# # already in long format style for dataframe +# output = as.data.frame(data) +# save(output, file = '/data/bmorrison/sda/lai/modis_lai_data/modis_lai_output_update_sites.Rdata') +# +# # change tile names to the site name +# for (i in 1:length(site_info$site_name)) +# { +# name = as.character(site_info$site_id[i], stringsAsFactor = F) +# g = which(round(output$lat, digits = 3) == round(site_info$lat[i], digits = 3)) +# output$tile[g] = name +# } +# # remove extra data +# output = output[,c(4,2,8,10)] +# colnames(output) = names(agb_data) +# +# # compute peak lai per year +# data = output +# peak_lai = data.frame() +# years = unique(year(as.Date(data$Date, "%Y-%m-%d"))) +# for (i in seq_along(years)) +# { +# d = data[grep(data$Date, pattern = years[i]),] +# sites = unique(d$Site_ID) +# for (j in seq_along(sites)) +# { +# index = which(d$Site_ID == site_info$site_id[j]) #which(round(d$lat, digits = 3) == round(site_info$lat[j], digits = 3) & round(d$lon, digits = 3) == round(site_info$lon[j], digits = 3)) +# site = d[index,] +# if (length(index) > 0) +# { +# # peak lai is the max value that is the value <95th quantile to remove potential outlier values +# max = site[which(site$Median == max(site$Median[which(site$Median <= quantile(site$Median, probs = 0.95))], na.rm = T))[1],] #which(d$Median == max(d$Median[index], na.rm = T))[1] +# peak = data.frame(max$Site_ID, Date = paste("Year", years[i], sep = "_"), Median = max$Median, SD = max$SD) +# peak_lai = rbind(peak_lai, peak) +# +# } +# } +# } +# +# # a fix for low SD values because of an issue with MODIS LAI error calculations. Reference: VISKARI et al 2014. +# peak_lai$SD[peak_lai$SD < 0.66] = 0.66 +# +# #output data +# names(peak_lai) = c("Site_ID", "Date", "Median", "SD") +# save(peak_lai, file = '/data/bmorrison/sda/lai/modis_lai_data/peak_lai_output_update_sites.Rdata') +# +# +# ######################### TIME TO FIX UP THE OBSERVED DATASETS INTO A FORMAT THAT WORKS TO MAKE OBS.MEAN and OBS.COV FOR SDA ######################## +# ################# +# load('/data/bmorrison/sda/lai/modis_lai_data/agb_data_update_sites.Rdata') +# load( '/data/bmorrison/sda/lai/modis_lai_data/peak_lai_output_update_sites.Rdata') +# # output likes to make factors ..... :/... so this unfactors them +# peak_lai$Site_ID = as.numeric(as.character(peak_lai$Site_ID, stringsAsFactors = F)) +# peak_lai$Date = as.character(peak_lai$Date, stringsAsFactors = F) +# +# observed_vars = c("AbvGrndWood", "LAI") +# +# +# # merge agb and lai dataframes and places NA values where data is missing between the 2 datasets +# observed_data = merge(agb_data, peak_lai, by = c("Site_ID", "Date"), all = T) +# names(observed_data) = c("Site_ID", "Date", "med_agb", "sdev_agb", "med_lai", "sdev_lai") +# +# # order by year +# observed_data = observed_data[order(observed_data$Date),] +# +# #sort by date +# dates = sort(unique(observed_data$Date)) +# +# # create the obs.mean list --> this needs to be adjusted to work with load.data in the future (via hackathon) +# obs.mean = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, med_agb = observed_data$med_agb, med_lai = observed_data$med_lai) +# obs.mean$date = as.character(obs.mean$date, stringsAsFactors = FALSE) +# +# obs.mean = obs.mean %>% +# split(.$date) +# +# # change the dates to be middle of the year +# date.obs <- strsplit(names(obs.mean), "_") %>% +# map_chr(~.x[2]) %>% paste0(.,"/07/15") +# +# obs.mean = names(obs.mean) %>% +# map(function(namesl){ +# obs.mean[[namesl]] %>% +# split(.$site_id) %>% +# map(~.x[3:4] %>% setNames(c("AbvGrndWood", "LAI"))) %>% +# setNames(site.ids) +# }) %>% setNames(date.obs) +# +# # remove NA data as this will crash the SDA. Removes rown numbers (may not be nessesary) +# names = date.obs +# for (name in names) +# { +# for (site in names(obs.mean[[name]])) +# { +# na_index = which(!(is.na(obs.mean[[ name]][[site]]))) +# colnames = names(obs.mean[[name]][[site]]) +# if (length(na_index) > 0) +# { +# obs.mean[[name]][[site]] = obs.mean[[name]][[site]][na_index] +# row.names(obs.mean[[name]][[site]]) = NULL +# } +# } +# } +# +# # fillers are 0's for the covariance matrix. This will need to change for differing size matrixes when more variables are added in. +# filler_0 = as.data.frame(matrix(0, ncol = length(observed_vars), nrow = nrow(observed_data))) +# names(filler_0) = paste0("h", seq_len(length(observed_vars))) +# +# # create obs.cov dataframe -->list by date +# obs.cov = data.frame(date = observed_data$Date, site_id = observed_data$Site_ID, sdev_agb = observed_data$sdev_agb, sdev_lai = observed_data$sdev_lai, filler_0) +# obs.cov$date = as.character(obs.cov$date, stringsAsFactors = F) +# +# obs.cov = obs.cov %>% +# split(.$date) +# +# #sublist by date --> site +# obs.cov = names(obs.cov) %>% +# map(function(namesl){ +# obs.cov[[namesl]] %>% +# split(.$site_id) %>% +# map(~diag(.x[3:4]^2, nrow = 2, ncol = 2)) %>% +# setNames(site.ids)}) %>% +# setNames(date.obs) +# +# # remove NA/missing observations from covariance matrix and removes NA values to restructure size of covar matrix +# names = names(obs.cov) +# for (name in names) +# { +# for (site in names(obs.cov[[name]])) +# { +# na_index = which(is.na(obs.cov[[ name]][[site]])) +# if (length(na_index) > 0) +# { +# n_good_vars = length(observed_vars)-length(na_index) +# obs.cov[[name]][[site]] = matrix(obs.cov[[name]][[site]][-na_index], nrow = n_good_vars, ncol = n_good_vars) +# } +# } +# } +# +# # save these lists for future use. +# save(obs.mean, file = '/data/bmorrison/sda/lai/obs_mean_update_sites.Rdata') +# save(obs.cov, file = '/data/bmorrison/sda/lai/obs_cov_update_sites.Rdata') +# save(date.obs, file = '/data/bmorrison/sda/lai/date_obs_update_sites.Rdata') + + + +################################ START THE SDA ######################################## +load('/data/bmorrison/sda/lai/obs_mean_update_sites.Rdata') +load('/data/bmorrison/sda/lai/obs_cov_update_sites.Rdata') +date.obs = names(obs.mean) + +new.settings <- PEcAn.settings::prepare.settings(settings) + +#unlink(c('run','out','SDA'),recursive = T) + +sda.enkf.multisite(new.settings, + obs.mean =obs.mean, + obs.cov = obs.cov, + keepNC = TRUE, + forceRun = TRUE, + control=list(trace=TRUE, + FF=FALSE, + interactivePlot=FALSE, + TimeseriesPlot=TRUE, + BiasPlot=FALSE, + plot.title=NULL, + facet.plots=4, + debug=FALSE, + pause=FALSE, + Profiling = FALSE, + OutlierDetection=FALSE)) + + + + +### FOR PLOTTING after analysis if TimeseriesPlot == FALSE) +load('/data/bmorrison/sda/lai/SDA/sda.output.Rdata') +facetg=4 +readsFF=NULL + +obs.mean = Viz.output[[2]] +obs.cov = Viz.output[[3]] +obs.times = names(obs.mean) +PEcAn.assim.sequential::post.analysis.multisite.ggplot(settings = new.settings, t, obs.times, obs.mean, obs.cov, FORECAST, ANALYSIS, plot.title=NULL, facetg=facetg, readsFF=NULL) + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/nohuprun.txt b/modules/assim.sequential/inst/sda_backup/bmorrison/nohuprun.txt new file mode 100755 index 00000000000..d3d35a295f0 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/nohuprun.txt @@ -0,0 +1,19 @@ +# model run +nohup Rscript workflow.R > workflow.log 2>&1 & +nohup Rscript workflow.R --settings pecan_US-CZ3_CRUNCEP.xml > workflow.log 2>&1 & + + +# SDA +# interactive qsub, keep enviroment, 3 hours, 1 node 15 CPUs +##qsub -IV -l walltime=03:00:00,nodes=1:ppn=15 +cd /data/bmorrison/sda/ +nohup Rscript Multisite-3sites.R > SDA_workflow.log 2>&1 & + +nohup Rscript Multisite-4sites.R > SDA_workflow.log 2>&1 & + +nohup Rscript Multisite_SDA_BNL.R > SDA_workflow.log 2>&1 & + + +qstat -f + +qstat -ext diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/pft_selection.R b/modules/assim.sequential/inst/sda_backup/bmorrison/pft_selection.R new file mode 100755 index 00000000000..baf648cdf71 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/pft_selection.R @@ -0,0 +1,190 @@ +library(raster) +library(shapefiles) +library(PEcAn.DB) + +analysis = readRDS("/Volumes/data2/bmorrison/sda/500_site_run/output_folder/ANALYSIS.RDS") + +dates = names(analysis) +sites = unique(attributes(analysis[[names(analysis)[1]]])$Site) +observations = sites + + +#working = print(paste("working on: ", i)) +sites = observations +bety <- list(user='bety', password='bety', host='modex.bnl.gov', + dbname='betydb', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- sites +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +# load('/Volumes/data/bmorrison/sda/500_site_run/all_lai_data_500.Rdata') +# site_ids = unique(lai_data$site_id) +# sites = data.frame() +# for (i in 1:length(site_ids)) +# { +# index = which(lai_data$site_id == site_ids[i]) +# sites = rbind(sites, lai_data[index[1],]) +# } +# sites = sites[,c(5,6,7)] +sites = as.data.frame(cbind(site_info$site_id,site_info$lon, site_info$lat)) +names(sites) = c("id", "lon", "lat") +coordinates(sites) = ~lon+lat +projection(sites) = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs " +cover = raster('/Volumes/data/bmorrison/sda/500_site_run/NLCD_2001_Land_Cover_L48_20190424.img') + +# sites = shapefile('/data/bmorrison/sda/500_site_run/shapefiles/500_site_selection.shp') +# s = shapefile('/data/bmorrison/sda/500_site_run/shapefiles/500_site_selection.shp') + +#sites = as.data.frame(sites) +# sites = sites[, 11:12] +# names(sites) = c("x", "y") +# coordinates(sites) = ~x+y +# projection(sites) = crs(s) + +sites = spTransform(sites, CRS = crs(cover)) + +# make sure projections match +data = extract(cover, sites) +sites$cover = data + +# bad = which(data == 11 | data == 12 | data == 31) +# site_data = sites[-bad,] +site_data = sites + +ecoregion = shapefile('/Volumes/data2/bmorrison/sda/bailey_paper/data/ecoregions_shapefile/eco_aea_l1.shp') +ecoregion = spTransform(ecoregion, CRS = crs(cover)) +eco_data = extract(ecoregion, site_data) +site_data$region = eco_data$NA_L1CODE +site_data$name = eco_data$NA_L1NAME + +site_data = as.data.frame(site_data) +names(site_data) = c("ID", "cover", "ecoregion", "name", "lon", "lat") +site_data$pft = NA +site_data$cover = as.numeric(site_data$cover) +site_data$ecoregion = as.numeric(site_data$ecoregion) +# remove sites that are categorized as unclassified, water, ice/snow, barren +index = which(site_data$cover == 0 | site_data$cover == 11 | site_data$cover == 12 | site_data$cover == 31) +site_data$pft[index] = NA + +# classify deciduous +index = which(site_data$cover == 41) +site_data$pft[index] = "deciduous" + + +# classify evergreen/conifer +index = which(site_data$cover == 42) +site_data$pft[index] = "conifer" + + +# classify mixed forest +index = which(site_data$cover == 43) +site_data$pft[index] = "mixed forest" + +# classify developed +index = which(site_data$cover == 21 | site_data$cover == 22 | site_data$cover == 23 | site_data$cover == 24) +site_data$pft[index] = "developed" + +# classify shrub/scrub +index = which(site_data$cover == 52 & (site_data$ecoregion == 10 | site_data$ecoregion == 11 | site_data$ecoregion == 12 | site_data$ecoregion == 13 | site_data$ecoregion == 14)) +site_data$pft[index] = "arid grassland" + +index = which(site_data$cover == 52 & (site_data$ecoregion == 9 | site_data$ecoregion == 8 | site_data$ecoregion == 6 | site_data$ecoregion == 7)) +site_data$pft[index] = "mesic grassland" + + +# classify herbaceous +index = which(site_data$cover == 71 & (site_data$ecoregion == 10 | site_data$ecoregion == 11 | site_data$ecoregion == 12 | site_data$ecoregion == 13 | site_data$ecoregion == 14)) +site_data$pft[index] = "arid grassland" + +index = which(site_data$cover == 71 & (site_data$ecoregion == 9 | site_data$ecoregion == 15 | site_data$ecoregion == 7 | site_data$ecoregion == 8 | site_data$ecoregion == 5 | site_data$ecoregion == 6)) +site_data$pft[index] = "mesic grassland" + + +# classify hay/pasture crops +index = which((site_data$cover == 81 | site_data$cover == 82) & (site_data$ecoregion == 10 | site_data$ecoregion == 11 | site_data$ecoregion == 12 | site_data$ecoregion == 13 | site_data$ecoregion == 14)) +site_data$pft[index] = "arid grassland" + +index = which((site_data$cover == 81 | site_data$cover == 82) & (site_data$ecoregion == 9 | site_data$ecoregion == 8 | site_data$ecoregion == 7)) +site_data$pft[index] = "mesic grassland" + + +# classify wetlands +index = which(site_data$cover == 95) +site_data$pft[index] = "mesic grassland" + +index = which(site_data$cover == 90) +site_data$pft[index] = "woody wetland" + + +# LAI analysis for forests (mixed + woody wetland) +index = which(site_data$cover == 43 | site_data$cover == 90) +data = site_data[index,] +coordinates(data) = ~lon+lat +projection(data) = crs(sites) +data = spTransform(data, CRS = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs ") +data = as.data.frame(data, stringsAsFactors = F) + + +library(PEcAn.data.remote) +site_id = data$ID +site_name = rep(NA, nrow(data)) +lat = data$lat +lon = data$lon +time_zone = rep("time", nrow(data)) +site_info = list(site_id, site_name, lat, lon, time_zone) +names(site_info) = c("site_id", "site_name", "lat", "lon", "time_zone") + +lai = call_MODIS(outdir = NULL, var = "lai", site_info = site_info, product_dates = c("2001001", "2001365"), run_parallel = T, ncores = 10, product ="MOD15A2H", band = "Lai_500m", package_method = "MODISTools", QC_filter = T, progress = F) +ndvi = call_MODIS(outdir = NULL, var = "NDVI", site_info = site_info, product_dates = c("2001001", "2001365"), run_parallel = T, ncores = 10, product ="MOD13Q1", band = "250m_16_days_NDVI", package_method = "MODISTools", QC_filter = F, progress = F) + +library(lubridate) + +par(mfrow = c(4,5)) +info = data.frame() +data = lai +sites = sort(unique(lai$site_id)) +# xy = data.frame() +# for (i in 1:length(sites)) +# { +# d = data[which(data$site_id == sites[i]),] +# xy = rbind(xy, d[1,c(5,7,6)]) +# } +#data$calendar_date = as.Date(data$calendar_date) + +for (i in 21:40) +{ + site = sites[i] + d = data[which(data$site_id == site),] + d = d[,c(2,5,6,7,9)] + d = d[order(d$calendar_date),] + d$calendar_date = as.Date(d$calendar_date) + min = min(d$data, na.rm = T) + max = max(d$data, na.rm = T) + difference = max-min + # winter = d %>% + # select(calendar_date, site_id, lat, lon, data) %>% + # filter((calendar_date >= month(ymd("2001-01-01")) & calendar_date <= month(ymd("2001-02-28"))) | (calendar_date >= month(ymd("2001-12-01")) & calendar_date <= month(ymd("2001-12-31")))) + # min = mean(winter$data, na.rm = T) + + # summer = d %>% + # select(calendar_date, site_id, lat, lon, data) %>% + # filter(calendar_date >= month(ymd("2001-06-01")) & calendar_date <= month(ymd("2001-08-30"))) + # max = mean(summer$data, na.rm = T) + # difference = max - min + + info = rbind(info, as.data.frame(cbind(site, d$lon[1], d$lat[1], min, max, difference))) + plot(d$calendar_date, d$data, ylim = c(0, max(data$data)+2), main = site) +} + + + + + + diff --git a/modules/assim.sequential/inst/sda_backup/bmorrison/register_site_group.R b/modules/assim.sequential/inst/sda_backup/bmorrison/register_site_group.R new file mode 100755 index 00000000000..3ad6e3dc4a3 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/bmorrison/register_site_group.R @@ -0,0 +1,44 @@ +library(raster) +library(shapefiles) +------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(furrr) +library(tictoc) + +data = shapefile('/data/bmorrison/sda/500_site_run/shapefiles/500_site_selection_final.shp') +data = as.data.frame(data) +names(data) = c("type", "lon", "lat") + + +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +#site_ID <- observation + +#-- register sites +site_id <-map2(data$lon, data$lat, function(lon, lat){ + pr<-paste0(round(lon,0), round(lat,0)) + out <-db.query(paste0("INSERT INTO sites (sitename, geometry) VALUES ('CMS_500_SDA_",pr,"', ", + "ST_SetSRID(ST_MakePoint(",lon,",", lat,", 1000), 4326) ) RETURNING id, sitename"), + con + ) + out +}) +#link to site group +site_id %>% + map(~ db.query(paste0("INSERT INTO sitegroups_sites (sitegroup_id , site_id ) VALUES (2000000009, ", + .x[[1]],")"),con)) \ No newline at end of file diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite-3sites.R b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite-3sites.R new file mode 100755 index 00000000000..6d956113e4e --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite-3sites.R @@ -0,0 +1,102 @@ +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +#------------------------------------------ Setup ------------------------------------- +setwd("/data/sserbin/Modeling/sipnet/NASA_CMS") +unlink(c('run','out','SDA'),recursive = T) +rm(list=ls()) +settings <- read.settings("pecan.SDA.3sites.xml") +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() +#sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, ens.sample.method = settings$ensemble$samplingspace$parameters$method) ## Aside: if method were set to unscented, would take minimal changes to do UnKF +#---------------------------------------------------------------- +# OBS data preparation +#--------------------------------------------------------------- +load("Obs/LandTrendr_AGB_output-4sites.RData") +site1 <- point_list +site1$median_AGB[[1]] %>% + filter(Site_ID!='772') -> site1$median_AGB[[1]] + + +site1$stdv_AGB[[1]] %>% + filter(Site_ID!='772') -> site1$stdv_AGB[[1]] + +load("Obs/LandTrendr_AGB_output_796-769.RData") +site2 <- point_list +site2$median_AGB[[1]] %>% + filter(Site_ID!='1000000074') ->site2$median_AGB[[1]] + + +site2$stdv_AGB[[1]] %>% + filter(Site_ID!='1000000074') ->site2$stdv_AGB[[1]] +#listviewer::jsonedit(point_list) +#-------------------------------------------------------------------------------- +#for multi site both mean and cov needs to be a list like this +# +date +# +siteid +# c(state variables)/matrix(cov state variables) +# +#reorder sites in obs +point_list$median_AGB <-rbind(site1$median_AGB[[1]], + site2$median_AGB[[1]]) %>% filter(Site_ID %in% site.ids) +point_list$stdv_AGB <-rbind(site1$stdv_AGB[[1]], + site2$stdv_AGB[[1]])%>% filter(Site_ID %in% site.ids) + +site.order <- sapply(site.ids,function(x) which(point_list$median_AGB$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() + +point_list$median_AGB <- point_list$median_AGB[site.order,] +point_list$stdv_AGB <- point_list$stdv_AGB[site.order,] + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(site1$median_AGB[[1]]),"_")[3:length(site1$median_AGB[[1]])] %>% + map_chr(~.x[2]) %>% paste0(.,"/12/31") + +obs.mean <-names(point_list$median_AGB)[3:length(point_list$median_AGB)] %>% + map(function(namesl){ + ((point_list$median_AGB)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('AbvGrndWood'))) %>% + setNames(site.ids[1:length(.)]) + ) + }) %>% setNames(date.obs) + + + +obs.cov <-names(point_list$stdv_AGB)[3:length(point_list$median_AGB)] %>% + map(function(namesl) { + ((point_list$stdv_AGB)[[namesl]] %>% + map( ~ (.x) ^ 2%>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + + }) %>% setNames(date.obs) + +#---------------------------------------------------------------- +# end OBS data preparation +#--------------------------------------------------------------- +new.settings <- PEcAn.settings::prepare.settings(settings) +#jsonedit(new.settings) +#------------------------------------------ SDA ------------------------------------- +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + interactivePlot=F, + TimeseriesPlot=T, + BiasPlot=F, + plot.title="lhc sampling - 4sites - SF50 - ALL PFTs - small sample size", + facet.plots=T, + debug=F, + pause=F) + ) + + diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite-4sites.R b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite-4sites.R new file mode 100755 index 00000000000..eb1a12e931e --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite-4sites.R @@ -0,0 +1,102 @@ +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +#------------------------------------------ Setup ------------------------------------- +setwd("/data/sserbin/Modeling/sipnet/NASA_CMS") +unlink(c('run','out','SDA'),recursive = T) +rm(list=ls()) +settings <- read.settings("pecan.SDA.4sites.xml") +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() +#sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, ens.sample.method = settings$ensemble$samplingspace$parameters$method) ## Aside: if method were set to unscented, would take minimal changes to do UnKF +#---------------------------------------------------------------- +# OBS data preparation +#--------------------------------------------------------------- +load("Obs/LandTrendr_AGB_output-4sites.RData") +site1 <- point_list +site1$median_AGB[[1]] %>% + filter(Site_ID!='772') -> site1$median_AGB[[1]] + + +site1$stdv_AGB[[1]] %>% + filter(Site_ID!='772') -> site1$stdv_AGB[[1]] + +load("Obs/LandTrendr_AGB_output_796-769.RData") +site2 <- point_list +site2$median_AGB[[1]] %>% + filter(Site_ID=='796') -> site2$median_AGB[[1]] + + +site2$stdv_AGB[[1]] %>% + filter(Site_ID=='796') -> site2$stdv_AGB[[1]] +#listviewer::jsonedit(point_list) +#-------------------------------------------------------------------------------- +#for multi site both mean and cov needs to be a list like this +# +date +# +siteid +# c(state variables)/matrix(cov state variables) +# +#reorder sites in obs +point_list$median_AGB <-rbind(site1$median_AGB[[1]], + site2$median_AGB[[1]]) %>% filter(Site_ID %in% site.ids) +point_list$stdv_AGB <-rbind(site1$stdv_AGB[[1]], + site2$stdv_AGB[[1]])%>% filter(Site_ID %in% site.ids) + +site.order <- sapply(site.ids,function(x) which(point_list$median_AGB$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() + +point_list$median_AGB <- point_list$median_AGB[site.order,] +point_list$stdv_AGB <- point_list$stdv_AGB[site.order,] + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(site1$median_AGB[[1]]),"_")[3:length(site1$median_AGB[[1]])] %>% + map_chr(~.x[2]) %>% paste0(.,"/12/31") + +obs.mean <-names(point_list$median_AGB)[3:length(point_list$median_AGB)] %>% + map(function(namesl){ + ((point_list$median_AGB)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('AbvGrndWood'))) %>% + setNames(site.ids[1:length(.)]) + ) + }) %>% setNames(date.obs) + + + +obs.cov <-names(point_list$stdv_AGB)[3:length(point_list$median_AGB)] %>% + map(function(namesl) { + ((point_list$stdv_AGB)[[namesl]] %>% + map( ~ (.x) ^ 2%>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + + }) %>% setNames(date.obs) + +#---------------------------------------------------------------- +# end OBS data preparation +#--------------------------------------------------------------- +new.settings <- PEcAn.settings::prepare.settings(settings) +#jsonedit(new.settings) +#------------------------------------------ SDA ------------------------------------- +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + interactivePlot=F, + TimeseriesPlot=T, + BiasPlot=F, + plot.title="lhc sampling - 4sites - SF50 - ALL PFTs - small sample size", + facet.plots=T, + debug=F, + pause=F) + ) + + diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite_SDA_BNL.R b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite_SDA_BNL.R new file mode 100755 index 00000000000..2a599eb0f53 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite_SDA_BNL.R @@ -0,0 +1,171 @@ +#################################################################################################### +# +# +# +# +# --- Last updated: 03.26.2019 By Shawn P. Serbin +#################################################################################################### + + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + + +# temporary step until we get this code integrated into pecan +library(RCurl) +script <- getURL("https://raw.githubusercontent.com/serbinsh/pecan/download_osu_agb/modules/data.remote/R/LandTrendr.AGB.R", + ssl.verifypeer = FALSE) +eval(parse(text = script)) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## set run options, some of these should be tweaked or removed as requirements +work_dir <- "/data/sserbin/Modeling/sipnet/NASA_CMS" +setwd(work_dir) # best not to require setting wd and instead just providing full paths in functions + +# Deifine observation - use existing or generate new? +# set to a specific file, use that. +#observation <- "" +observation <- c("1000025731","1000000048","763","796","772","764","765","1000000024","678", + "1000000146") + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("XMLs/pecan_MultiSite_SDA.xml") + + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Prepare observational data - still very hacky here + +# option 1: use existing observation file +# if (observation!="new") { +# load(observation) +# site1 <- point_list +# site1$median_AGB[[1]] %>% +# filter(Site_ID!='772') -> site1$median_AGB[[1]] +# site1$stdv_AGB[[1]] %>% +# filter(Site_ID!='772') -> site1$stdv_AGB[[1]] +# } + +# option 2: run extraction code to generate observation files +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation # BETYdb site IDs +data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +#results <- PEcAn.data.remote::extract.LandTrendr.AGB(coords=site_ID, +results <- extract.LandTrendr.AGB(coords=site_ID, + data_dir = data_dir, con = con, + output_file = file.path(work_dir,"Obs"), + plot_results = FALSE) +load("Obs/LandTrendr_AGB_output.RData") + + +#for multi site both mean and cov needs to be a list like this +# +date +# +siteid +# c(state variables)/matrix(cov state variables) +# +#reorder sites in obs +point_list$median_AGB <- point_list$median_AGB[[1]] %>% filter(Site_ID %in% site.ids) +point_list$stdv_AGB <- point_list$stdv_AGB[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(point_list$median_AGB$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +point_list$median_AGB <- point_list$median_AGB[site.order,] +point_list$stdv_AGB <- point_list$stdv_AGB[site.order,] + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(point_list$median_AGB),"_")[3:length(point_list$median_AGB)] %>% + map_chr(~.x[2]) %>% paste0(.,"/12/31") + +obs.mean <- names(point_list$median_AGB)[3:length(point_list$median_AGB)] %>% + map(function(namesl){ + ((point_list$median_AGB)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('AbvGrndWood'))) %>% + setNames(site.ids[1:length(.)]) + ) + }) %>% setNames(date.obs) + +obs.cov <-names(point_list$stdv_AGB)[3:length(point_list$median_AGB)] %>% + map(function(namesl) { + ((point_list$stdv_AGB)[[namesl]] %>% + map( ~ (.x) ^ 2%>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + + }) %>% setNames(date.obs) + +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## generate new settings object +new.settings <- PEcAn.settings::prepare.settings(settings, force = FALSE) +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(new.settings, outputfile = "pecan.CHECKED.xml") +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Run SDA +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + interactivePlot=F, + TimeseriesPlot=T, + BiasPlot=F, + plot.title="Uniform sampling - 10 sites", + facet.plots=T, + debug=F, + pause=F) +) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Wrap up +# Send email if configured +#if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { +# sendmail(settings$email$from, settings$email$to, +# paste0("SDA workflow has finished executing at ", base::date())) +#} +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +### EOF diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite_SDA_BNL_updated.R b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite_SDA_BNL_updated.R new file mode 100755 index 00000000000..097c6ee4f9e --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/Multisite_SDA_BNL_updated.R @@ -0,0 +1,165 @@ +#################################################################################################### +# +# +# +# +# --- Last updated: 03.29.2019 By Shawn P. Serbin +#################################################################################################### + + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + + +# temporary step until we get this code integrated into pecan +library(RCurl) +script <- getURL("https://raw.githubusercontent.com/serbinsh/pecan/download_osu_agb/modules/data.remote/R/LandTrendr.AGB.R", + ssl.verifypeer = FALSE) +eval(parse(text = script)) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## set run options, some of these should be tweaked or removed as requirements +work_dir <- "/data/sserbin/Modeling/sipnet/NASA_CMS" +setwd(work_dir) # best not to require setting wd and instead just providing full paths in functions + +# grab multi-site XML file +settings <- read.settings("XMLs/pecan_MultiSite_SDA.xml") + +# grab observation IDs from settings file +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Prepare observational data - still very hacky here +PEcAn.logger::logger.info("**** Extracting LandTrendr AGB data for model sites ****") +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con +site_ID <- observation +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, +ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + +data_dir <- "/data2/RS_GIS_Data/LandTrendr/LandTrendr_AGB_data" +med_agb_data <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs")) +sdev_agb_data <- extract.LandTrendr.AGB(site_info, "stdv", buffer = NULL, fun = "mean", + data_dir, product_dates=NULL, file.path(work_dir,"Obs")) + +PEcAn.logger::logger.info("**** Preparing data for SDA ****") +#for multi site both mean and cov needs to be a list like this +# +date +# +siteid +# c(state variables)/matrix(cov state variables) +# +#reorder sites in obs +med_agb_data_sda <- med_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +sdev_agb_data_sda <- sdev_agb_data[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(med_agb_data_sda$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +med_agb_data_sda <- med_agb_data_sda[site.order,] +sdev_agb_data_sda <- sdev_agb_data_sda[site.order,] + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(med_agb_data_sda),"_")[3:length(med_agb_data_sda)] %>% + map_chr(~.x[2]) %>% paste0(.,"/12/31") + +obs.mean <- names(med_agb_data_sda)[3:length(med_agb_data_sda)] %>% + map(function(namesl){ + ((med_agb_data_sda)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('AbvGrndWood'))) %>% + setNames(site.ids[1:length(.)])) + }) %>% setNames(date.obs) + +obs.cov <-names(sdev_agb_data_sda)[3:length(sdev_agb_data_sda)] %>% + map(function(namesl) { + ((sdev_agb_data_sda)[[namesl]] %>% + map( ~ (.x) ^ 2%>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + }) %>% setNames(date.obs) + +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## generate new settings object +new.settings <- PEcAn.settings::prepare.settings(settings, force = FALSE) +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(new.settings, outputfile = "pecan.CHECKED.xml") +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +PEcAn.logger::logger.info("**** Run SDA ****") +## Run SDA +sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + interactivePlot=F, + TimeseriesPlot=T, + BiasPlot=F, + plot.title="Uniform sampling - 10 sites", + facet.plots=T, + debug=F, + pause=F) +) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Wrap up +# Send email if configured +#if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { +# sendmail(settings$email$from, settings$email$to, +# paste0("SDA workflow has finished executing at ", base::date())) +#} +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +### EOF diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/nohuprun.txt b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/nohuprun.txt new file mode 100755 index 00000000000..54c805c9203 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/nohuprun.txt @@ -0,0 +1,23 @@ +# model run +nohup Rscript workflow.R > workflow.log 2>&1 & +nohup Rscript workflow.R --settings pecan_US-CZ3_CRUNCEP.xml > workflow.log 2>&1 & +nohup Rscript workflow.R --settings XMLs/pecan_US-CZ3_CRUNCEP.xml > workflow.log 2>&1 & + + +# SDA +# interactive qsub, keep enviroment, 3 hours, 1 node 15 CPUs +qsub -IV -l walltime=03:00:00,nodes=1:ppn=15 +cd /data/sserbin/Modeling/sipnet/NASA_CMS +nohup Rscript Multisite-3sites.R > SDA_workflow.log 2>&1 & + +nohup Rscript Multisite-4sites.R > SDA_workflow.log 2>&1 & + +nohup Rscript Multisite_SDA_BNL.R > SDA_workflow.log 2>&1 & + +# latest +nohup Rscript R_scripts/Multisite_SDA_BNL_updated.R > SDA_workflow.log 2>&1 & + + +qstat -f + +qstat -ext diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/workflow_doconversions.R b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/workflow_doconversions.R new file mode 100755 index 00000000000..b97c5f22e84 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/workflow_doconversions.R @@ -0,0 +1,68 @@ +#!/usr/bin/env Rscript +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +# ---------------------------------------------------------------------- +# Load required libraries +# ---------------------------------------------------------------------- +library(PEcAn.all) +library(PEcAn.utils) +library(RCurl) + +# make sure always to call status.end +options(warn=1) +options(error=quote({ + PEcAn.utils::status.end("ERROR") + PEcAn.remote::kill.tunnel(settings) + if (!interactive()) { + q(status = 1) + } +})) + +#options(warning.expression=status.end("ERROR")) + + +# ---------------------------------------------------------------------- +# PEcAn Workflow +# ---------------------------------------------------------------------- +# Open and read in settings file for PEcAn run. +settings <- PEcAn.settings::read.settings("pecan_US-CZ3_CRUNCEP.xml") + +# Check for additional modules that will require adding settings +if("benchmarking" %in% names(settings)){ + library(PEcAn.benchmark) + settings <- papply(settings, read_settings_BRR) +} + +if("sitegroup" %in% names(settings)){ + if(is.null(settings$sitegroup$nSite)){ + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, sitegroupId = settings$sitegroup$id) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, sitegroupId = settings$sitegroup$id,nSite = settings$sitegroup$nSite) + } + settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading +} + +# Update/fix/check settings. Will only run the first time it's called, unless force=TRUE +settings <- PEcAn.settings::prepare.settings(settings, force=FALSE) + +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") + +# start from scratch if no continue is passed in +statusFile <- file.path(settings$outdir, "STATUS") +if (length(which(commandArgs() == "--continue")) == 0 && file.exists(statusFile)) { + file.remove(statusFile) +} + +# Do conversions +settings <- PEcAn.workflow::do_conversions(settings, overwrite.met = list(download = TRUE, met2cf = TRUE, standardize = TRUE, met2model = TRUE)) + +db.print.connections() +print("---------- PEcAn Workflow Complete ----------") diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/workflow_metprocess.R b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/workflow_metprocess.R new file mode 100755 index 00000000000..98d772912b8 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/R_scripts_2/workflow_metprocess.R @@ -0,0 +1,76 @@ +#!/usr/bin/env Rscript +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +# ---------------------------------------------------------------------- +# Load required libraries +# ---------------------------------------------------------------------- +library(PEcAn.all) +library(PEcAn.utils) +library(RCurl) + +# make sure always to call status.end +options(warn=1) +options(error=quote({ + PEcAn.utils::status.end("ERROR") + PEcAn.remote::kill.tunnel(settings) + if (!interactive()) { + q(status = 1) + } +})) + +#options(warning.expression=status.end("ERROR")) + + +# ---------------------------------------------------------------------- +# PEcAn Workflow +# ---------------------------------------------------------------------- +settings <- PEcAn.settings::read.settings("pecan_US-CZ3_CRUNCEP.xml") + +# Check for additional modules that will require adding settings +if("benchmarking" %in% names(settings)){ + library(PEcAn.benchmark) + settings <- papply(settings, read_settings_BRR) +} + +if("sitegroup" %in% names(settings)){ + if(is.null(settings$sitegroup$nSite)){ + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, sitegroupId = settings$sitegroup$id) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, sitegroupId = settings$sitegroup$id,nSite = settings$sitegroup$nSite) + } + settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading +} + +# Update/fix/check settings. Will only run the first time it's called, unless force=TRUE +settings <- PEcAn.settings::prepare.settings(settings, force=FALSE) + +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") + +# start from scratch if no continue is passed in +statusFile <- file.path(settings$outdir, "STATUS") +if (length(which(commandArgs() == "--continue")) == 0 && file.exists(statusFile)) { + file.remove(statusFile) +} + +# met process +PEcAn.data.atmosphere::met.process( + site = settings$run$site, + input_met = settings$run$inputs$met, + start_date = settings$run$start.date, + end_date = settings$run$end.date, + model = settings$model$type, + host = settings$host, + dbparms = settings$database$bety, + dir = settings$database$dbfiles, + browndog = settings$browndog, + spin = settings$spin, + overwrite = list(download = TRUE, met2cf = TRUE, standardize = TRUE, met2model = TRUE)) + diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/Rscripts/multi_site_LAI_SDA_BNL.R b/modules/assim.sequential/inst/sda_backup/sserbin/Rscripts/multi_site_LAI_SDA_BNL.R new file mode 100755 index 00000000000..4d18e5e3760 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/Rscripts/multi_site_LAI_SDA_BNL.R @@ -0,0 +1,252 @@ +#################################################################################################### +# +# Single site LAI SDA +# +# +# --- Last updated: 03.27.2019 By Shawn P. Serbin +#################################################################################################### + + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) +library(doParallel) + +extract_LAI <- TRUE #TRUE/FALSE +run_SDA <- TRUE #TRUE/FALSE + +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## set run options, some of these should be tweaked or removed as requirements +work_dir <- "/data/sserbin/Modeling/sipnet/NASA_CMS_AGB_LAI" +setwd(work_dir) # best not to require setting wd and instead just providing full paths in functions + +# grab multi-site XML file +settings <- read.settings("XMLs/pecan_MultiSite_LAI_SDA.xml") + +# grab observation IDs from settings file +observation <- c() +for (i in seq_along(1:length(settings$run))) { + command <- paste0("settings$run$settings.",i,"$site$id") + obs <- eval(parse(text=command)) + observation <- c(observation,obs) +} + + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Prepare observational data - still very hacky here + +# where to put MODIS LAI data? +data_dir <- "/data/sserbin/Modeling/sipnet/NASA_CMS_AGB_LAI/modis_lai_data" +parameters <- settings$run + +# get MODIS data +bety <- list(user=settings$database$bety$user, password=settings$database$bety$password, + host=settings$database$bety$host, + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con + +suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = observation, .con = con)) +suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) +suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) +site_IDs <- qry_results$id +site_names <- qry_results$sitename +site_coords <- data.frame(cbind(qry_results$lon, qry_results$lat)) +names(site_coords) <- c("Longitude","Latitude") + +#extract lai using call_MODIS for the lat/lon per site and dates +if (extract_LAI) { + modis_data <- data.frame() + cl <- parallel::makeCluster(5, outfile="") + registerDoParallel(cl) + modis_data <- foreach(i=1:nrow(site_coords)) %dopar% PEcAn.data.remote::call_MODIS(product = "MOD15A2H", + band = "Lai_500m", start_date = "2001001", + end_date = "2010365", lat = site_coords$Latitude[i], + lon = site_coords$Longitude[i], + size = 0, band_qc = "FparLai_QC", + band_sd = "LaiStdDev_500m", + package_method = "MODISTools") + + stopCluster(cl) + modis_data <- do.call(rbind.data.frame, modis_data) + + # modis_data <- data.frame() + # for (i in 1:length(observation)) { + # print(paste("extracting site: ", observation[i], sep = "")) + # data <- PEcAn.data.remote::call_MODIS(lat = site_coords[i,2], lon = site_coords[i,1], + # start_date = "2001001", end_date = "2010365", + # size = 0, product = "MOD15A2H", band = "Lai_500m", + # band_qc = "", band_sd = "LaiStdDev_500m", package_method = "MODISTools") + # modis_data <- rbind(modis_data, data) + # } + # output resuls of call_MODIS + save(modis_data, file = file.path(data_dir,'modis_lai_output.RData')) +} else { + load(file = file.path(data_dir,'modis_lai_output.RData')) +} + +# find peaks +peak_lai <- data.frame() +years <- unique(year(as.Date(modis_data$calendar_date, "%Y-%m-%d"))) +#site_ll <- data.frame(cbind(lon=unique(modis_data$lon),lat=unique(modis_data$lat))) +site_ll <- data.frame(cbind(lat=unique(modis_data$lat),lon=unique(modis_data$lon))) +for (i in 1:length(years)) { + year <- years[i] + g <- grep(modis_data$calendar_date, pattern = year) + d <- modis_data[g,] + for (j in 1:length(site_IDs)) { + pixel <- filter(d, lat == site_ll[j,1] & lon == site_ll[j,2]) + + # using peak + peak <- pixel[which(pixel$data == max(pixel$data, na.rm = T)),][1,] + + # using mean + #mn_data <- mean(pixel$data, na.rm = T) + #mn_sd <- mean(pixel$sd, na.rm = T) + #peak <- pixel[1,] + #peak$data <- mn_data + #peak$sd <- mn_sd + + + peak$calendar_date = paste("Year", year, sep = "_") + peak$tile <- site_names[j] + #peak$tile <- site_IDs[j] + peak_lai <- rbind(peak_lai, peak) + } +} + +# sort the data by site so the correct values are placed into the resized data frames below. +peak_lai <- peak_lai[order(peak_lai$tile), ] + +# separate data into hotdog style dataframes with row == site and columns = info/data for each site +median_lai <- cbind(site_IDs, site_names, as.data.frame(matrix(unlist(t(peak_lai$data)), byrow = T, length(site_IDs), length(years)))) +colnames(median_lai) <- c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) + +stdv_lai <- cbind(site_IDs, site_names, as.data.frame(matrix(unlist(t(peak_lai$sd)), byrow = T, length(site_IDs), length(years)))) +colnames(stdv_lai) <- c("Site_ID", "Site_Name", unique(peak_lai$calendar_date)) + +# convert to list +point_list <- list() +point_list$median_lai <- list(median_lai) +point_list$stdv_lai <- list(stdv_lai) +point_list + +point_list$median_lai <- point_list$median_lai[[1]] +point_list$stdv_lai <- point_list$stdv_lai[[1]] + +#point_list$median_lai <- point_list$median_lai[[1]] %>% filter(Site_ID %in% site.ids) +#point_list$stdv_lai <- point_list$stdv_lai[[1]] %>% filter(Site_ID %in% site.ids) +#site.order <- sapply(site.ids,function(x) which(point_list$median_lai$Site_ID %in% x)) %>% +# as.numeric() %>% na.omit() +#point_list$median_lai <- point_list$median_lai[site.order,] +#point_list$stdv_lai <- point_list$stdv_lai[site.order,] +#point_list + +site.order <- sapply(site.ids,function(x) which(point_list$median_lai$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +point_list$median_lai <- point_list$median_lai[site.order,] +point_list$stdv_lai <- point_list$stdv_lai[site.order,] + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(point_list$median_lai),"_")[3:length(point_list$median_lai)] %>% map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean <- names(point_list$median_lai)[3:length(point_list$median_lai)] %>% + map(function(namesl){ + ((point_list$median_lai)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('LAI'))) %>% + setNames(site.ids[1:length(.)]) + ) + }) %>% setNames(date.obs) + +obs.cov <-names(point_list$stdv_lai)[3:length(point_list$median_lai)] %>% + map(function(namesl) { + ((point_list$stdv_lai)[[namesl]] %>% + map( ~ (.x) ^ 2 %>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + + }) %>% setNames(date.obs) + +# check input data - after creating list of lists +PEcAn.assim.sequential::Construct.R(site.ids, "LAI", obs.mean[[1]], obs.cov[[1]]) +PEcAn.assim.sequential::Construct.R(site.ids, "LAI", obs.mean[[10]], obs.cov[[10]]) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## generate new settings object +new.settings <- PEcAn.settings::prepare.settings(settings) +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(new.settings, outputfile = "pecan.CHECKED.xml") +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Run SDA +if (run_SDA) { + sda.enkf.multisite(new.settings, obs.mean = obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + interactivePlot=T, + TimeseriesPlot=T, + BiasPlot=T, + plot.title="LAI SDA, uniform sampling", + facet.plots=T, + debug=T, + pause=F)) +} else { + print("*** Not running SDA ***") +} + +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Wrap up +# Send email if configured +#if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { +# sendmail(settings$email$from, settings$email$to, +# paste0("SDA workflow has finished executing at ", base::date())) +#} +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +### EOF diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/Rscripts/single_site_SDA_BNL.R b/modules/assim.sequential/inst/sda_backup/sserbin/Rscripts/single_site_SDA_BNL.R new file mode 100755 index 00000000000..1195e2b4ec4 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/Rscripts/single_site_SDA_BNL.R @@ -0,0 +1,224 @@ +#################################################################################################### +# +# Single site LAI SDA +# +# +# --- Last updated: 03.22.2019 By Shawn P. Serbin +#################################################################################################### + + +#---------------- Close all devices and delete all variables. -------------------------------------# +rm(list=ls(all=TRUE)) # clear workspace +graphics.off() # close any open graphics +closeAllConnections() # close any open connections to files +#--------------------------------------------------------------------------------------------------# + + +#---------------- Load required libraries ---------------------------------------------------------# +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential +library(purrr) +library(listviewer) +library(dplyr) + +run_SDA <- TRUE #TRUE/FALSE +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## set run options, some of these should be tweaked or removed as requirements +work_dir <- "/data/sserbin/Modeling/sipnet/NASA_CMS_AGB_LAI" +setwd(work_dir) # best not to require setting wd and instead just providing full paths in functions + +# Deifine observation - use existing or generate new? +# set to a specific file, use that. +observation <- c("1000000048") + +# delete an old run +unlink(c('run','out','SDA'),recursive = T) + +# grab multi-site XML file +settings <- read.settings("XMLs/pecan_US-CZ3_LAI_SDA.xml") + + +# what is this step for???? is this to get the site locations for the map?? +if ("MultiSettings" %in% class(settings)) site.ids <- settings %>% + map(~.x[['run']] ) %>% map('site') %>% map('id') %>% unlist() %>% as.character() + +# sample from parameters used for both sensitivity analysis and Ens +get.parameter.samples(settings, + ens.sample.method = settings$ensemble$samplingspace$parameters$method) +## Aside: if method were set to unscented, would take minimal changes to do UnKF +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Prepare observational data - still very hacky here + +# option 1: use existing observation file +# if (observation!="new") { +# load(observation) +# site1 <- point_list +# site1$median_AGB[[1]] %>% +# filter(Site_ID!='772') -> site1$median_AGB[[1]] +# site1$stdv_AGB[[1]] %>% +# filter(Site_ID!='772') -> site1$stdv_AGB[[1]] +# } + +# where to put MODIS LAI data? +data_dir <- "/data/sserbin/Modeling/sipnet/NASA_CMS_AGB_LAI/modis_lai_data" +parameters <- settings$run + +# get MODIS data +#modis <- PEcAn.data.remote::call_MODIS(lat = as.numeric(parameters$site$lat), lon = as.numeric(parameters$site$lon), +# start_date = parameters$start.date, end_date = parameters$end.date, +# siteID = parameters$site$id, size = 0, product = "MOD15A2H", band = "Lai_500m", +# band_qc = "", band_sd = "LaiStdDev_500m", package_method = "MODISTools") +#modis <- PEcAn.data.remote::call_MODIS(lat = as.numeric(parameters$site$lat), lon = as.numeric(parameters$site$lon), +# start_date = "2001/01/01", end_date = "2002/01/01", +# size = 0, product = "MOD15A2H", band = "Lai_500m", +# band_qc = "", band_sd = "LaiStdDev_500m", package_method = "MODISTools") + +if (!file.exists(file.path(data_dir,'modis_lai_output.RData'))) { + modis <- call_MODIS(product = "MOD15A2H", band = "Lai_500m", start_date = "2001001", end_date = "2010365", + lat = as.numeric(parameters$site$lat), lon = as.numeric(parameters$site$lon), size = 0, + band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", + package_method = "MODISTools") + save(modis, file = file.path(data_dir,'modis_lai_output.RData')) + +} else { + load(file = file.path(data_dir,'modis_lai_output.RData')) +} + +# +bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) +con <- PEcAn.DB::db.open(bety) +bety$con <- con + +suppressWarnings(Site_Info <- PEcAn.DB::query.site(observation, con)) +Site_Info +Site_ID <- Site_Info$id +Site_Name <- Site_Info$sitename + +#plot(lubridate::as_date(modis$calendar_date), modis$data, type="l") + +peak_lai <- vector() +years <- unique(year(as.Date(modis$calendar_date, "%Y-%m-%d"))) +for (i in seq_along(years)) { + year <- years[i] + g <- grep(modis$calendar_date, pattern = year) + d <- modis[g,] + max <- which(d$data == max(d$data, na.rm = T)) + peak <- d[max,][1,] + peak$calendar_date = paste("Year", year, sep = "_") + peak_lai <- rbind(peak_lai, peak) +} + +# transpose the data +median_lai = as.data.frame(cbind(Site_ID, Site_Name, t(cbind(peak_lai$data))), stringsAsFactors = F) +colnames(median_lai) = c("Site_ID", "Site_Name", peak_lai$calendar_date) +median_lai[3:length(median_lai)] = as.numeric(median_lai[3:length(median_lai)]) + +stdv_lai = as.data.frame(cbind(Site_ID, Site_Name, t(cbind(peak_lai$sd))), stringsAsFactors = F) +colnames(stdv_lai) = c("Site_ID", "Site_Name", peak_lai$calendar_date) +stdv_lai[3:length(stdv_lai)] = as.numeric(stdv_lai[3:length(stdv_lai)]) + +point_list = list() +point_list$median_lai = median_lai +point_list$stdv_lai = stdv_lai + +## needed for landtrendr for nested lists. Lai isn't as nested +#point_list$median_lai <- point_list$median_lai[[1]] %>% filter(Site_ID %in% site.ids) +#point_list$stdv_lai <- point_list$stdv_lai[[1]] %>% filter(Site_ID %in% site.ids) +site.order <- sapply(site.ids,function(x) which(point_list$median_lai$Site_ID %in% x)) %>% + as.numeric() %>% na.omit() +point_list$median_lai <- point_list$median_lai[site.order,] +point_list$stdv_lai <- point_list$stdv_lai[site.order,] + +# truning lists to dfs for both mean and cov +date.obs <- strsplit(names(point_list$median_lai),"_")[3:length(point_list$median_lai)] %>% map_chr(~.x[2]) %>% paste0(.,"/07/15") + +obs.mean <- names(point_list$median_lai)[3:length(point_list$median_lai)] %>% + map(function(namesl){ + ((point_list$median_lai)[[namesl]] %>% + map(~.x %>% as.data.frame %>% `colnames<-`(c('LAI'))) %>% + setNames(site.ids[1:length(.)]) + ) + }) %>% setNames(date.obs) + +obs.cov <-names(point_list$stdv_lai)[3:length(point_list$median_lai)] %>% + map(function(namesl) { + ((point_list$stdv_lai)[[namesl]] %>% + map( ~ (.x) ^ 2 %>% as.matrix()) %>% + setNames(site.ids[1:length(.)])) + + }) %>% setNames(date.obs) + +# check input data - after creating list of lists +PEcAn.assim.sequential::Construct.R(site.ids, "LAI", obs.mean[[1]], obs.cov[[1]]) +PEcAn.assim.sequential::Construct.R(site.ids, "LAI", obs.mean[[10]], obs.cov[[10]]) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## generate new settings object +new.settings <- PEcAn.settings::prepare.settings(settings) +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Run SDA +if (run_SDA) { + #sda.enkf.multisite(new.settings, obs.mean =obs.mean ,obs.cov = obs.cov, + + sda.enkf.multisite(settings, obs.mean =obs.mean ,obs.cov = obs.cov, + control=list(trace=T, + FF=F, + interactivePlot=F, + TimeseriesPlot=T, + BiasPlot=F, + plot.title="LAI SDA, 1 site", + facet.plots=T, + debug=T, + pause=F)) + + # sda.enkf(settings, obs.mean = obs.mean ,obs.cov = obs.cov, + # control=list(trace=T, + # FF=F, + # interactivePlot=F, + # TimeseriesPlot=T, + # BiasPlot=F, + # plot.title="LAI SDA, 1 site", + # facet.plots=T, + # debug=T, + # pause=F)) + +} else { + print("*** Not running SDA ***") +} + +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +## Wrap up +# Send email if configured +#if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { +# sendmail(settings$email$from, settings$email$to, +# paste0("SDA workflow has finished executing at ", base::date())) +#} +#--------------------------------------------------------------------------------------------------# + + +#--------------------------------------------------------------------------------------------------# +### EOF diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/nohuprun.txt b/modules/assim.sequential/inst/sda_backup/sserbin/nohuprun.txt new file mode 100755 index 00000000000..c759693b0b2 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/nohuprun.txt @@ -0,0 +1,25 @@ +# model run +module load netcdf/4.4.1.1-gnu540 hdf5/1.8.19-gcc540 redland/1.0.17 openmpi/2.1.1-gnu540 +nohup Rscript workflow.R > workflow.log 2>&1 & +nohup Rscript workflow.R --settings pecan_US-CZ3_CRUNCEP.xml > workflow.log 2>&1 & +nohup Rscript workflow.R --settings XMLs/pecan_US-CZ3_CRUNCEP.xml > workflow.log 2>&1 & + + +# SDA +# interactive qsub, keep enviroment, 3 hours, 1 node 15 CPUs +qsub -IV -l walltime=03:00:00,nodes=1:ppn=15 +cd /data/sserbin/Modeling/sipnet/NASA_CMS +nohup Rscript Multisite-3sites.R > SDA_workflow.log 2>&1 & + +nohup Rscript Multisite-4sites.R > SDA_workflow.log 2>&1 & + +nohup Rscript Multisite_SDA_BNL.R > SDA_workflow.log 2>&1 & + +# latest +module load netcdf/4.4.1.1-gnu540 hdf5/1.8.19-gcc540 redland/1.0.17 openmpi/2.1.1-gnu540 +nohup Rscript R_Scripts/multi_site_LAI_SDA_BNL.R > SDA_workflow.log 2>&1 & + + +qstat -f + +qstat -ext diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/workflow.R b/modules/assim.sequential/inst/sda_backup/sserbin/workflow.R new file mode 100755 index 00000000000..317aef7faa7 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/workflow.R @@ -0,0 +1,215 @@ +#!/usr/bin/env Rscript +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +# ---------------------------------------------------------------------- +# Load required libraries +# ---------------------------------------------------------------------- +library("PEcAn.all") +library("RCurl") + + +# -------------------------------------------------- +# get command-line arguments +args <- get_args() + +# make sure always to call status.end +options(warn = 1) +options(error = quote({ + try(PEcAn.utils::status.end("ERROR")) + try(PEcAn.remote::kill.tunnel(settings)) + if (!interactive()) { + q(status = 1) + } +})) + +# ---------------------------------------------------------------------- +# PEcAn Workflow +# ---------------------------------------------------------------------- +# Open and read in settings file for PEcAn run. +settings <- PEcAn.settings::read.settings(args$settings) + +# Check for additional modules that will require adding settings +if ("benchmarking" %in% names(settings)) { + library(PEcAn.benchmark) + settings <- papply(settings, read_settings_BRR) +} + +if ("sitegroup" %in% names(settings)) { + if (is.null(settings$sitegroup$nSite)) { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id + ) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings( + settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite + ) + } + # zero out so don't expand a second time if re-reading + settings$sitegroup <- NULL +} + +# Update/fix/check settings. +# Will only run the first time it's called, unless force=TRUE +settings <- + PEcAn.settings::prepare.settings(settings, force = FALSE) + +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") + +# start from scratch if no continue is passed in +status_file <- file.path(settings$outdir, "STATUS") +if (args$continue && file.exists(status_file)) { + file.remove(status_file) +} + +# Do conversions +settings <- PEcAn.workflow::do_conversions(settings) + +# Query the trait database for data and priors +if (PEcAn.utils::status.check("TRAIT") == 0) { + PEcAn.utils::status.start("TRAIT") + settings <- PEcAn.workflow::runModule.get.trait.data(settings) + PEcAn.settings::write.settings(settings, + outputfile = "pecan.TRAIT.xml" + ) + PEcAn.utils::status.end() +} else if (file.exists(file.path(settings$outdir, "pecan.TRAIT.xml"))) { + settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.TRAIT.xml")) +} + + +# Run the PEcAn meta.analysis +if (!is.null(settings$meta.analysis)) { + if (PEcAn.utils::status.check("META") == 0) { + PEcAn.utils::status.start("META") + PEcAn.MA::runModule.run.meta.analysis(settings) + PEcAn.utils::status.end() + } +} + +# Write model specific configs +if (PEcAn.utils::status.check("CONFIG") == 0) { + PEcAn.utils::status.start("CONFIG") + settings <- + PEcAn.workflow::runModule.run.write.configs(settings) + PEcAn.settings::write.settings(settings, outputfile = "pecan.CONFIGS.xml") + PEcAn.utils::status.end() +} else if (file.exists(file.path(settings$outdir, "pecan.CONFIGS.xml"))) { + settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.CONFIGS.xml")) +} + +if ((length(which(commandArgs() == "--advanced")) != 0) +&& (PEcAn.utils::status.check("ADVANCED") == 0)) { + PEcAn.utils::status.start("ADVANCED") + q() +} + +# Start ecosystem model runs +if (PEcAn.utils::status.check("MODEL") == 0) { + PEcAn.utils::status.start("MODEL") + stop_on_error <- as.logical(settings[[c("run", "stop_on_error")]]) + if (length(stop_on_error) == 0) { + # If we're doing an ensemble run, don't stop. If only a single run, we + # should be stopping. + if (is.null(settings[["ensemble"]]) || + as.numeric(settings[[c("ensemble", "size")]]) == 1) { + stop_on_error <- TRUE + } else { + stop_on_error <- FALSE + } + } + PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = stop_on_error) + PEcAn.utils::status.end() +} + +# Get results of model runs +if (PEcAn.utils::status.check("OUTPUT") == 0) { + PEcAn.utils::status.start("OUTPUT") + runModule.get.results(settings) + PEcAn.utils::status.end() +} + +# Run ensemble analysis on model output. +if ("ensemble" %in% names(settings) +&& PEcAn.utils::status.check("ENSEMBLE") == 0) { + PEcAn.utils::status.start("ENSEMBLE") + runModule.run.ensemble.analysis(settings, TRUE) + PEcAn.utils::status.end() +} + +# Run sensitivity analysis and variance decomposition on model output +if ("sensitivity.analysis" %in% names(settings) +&& PEcAn.utils::status.check("SENSITIVITY") == 0) { + PEcAn.utils::status.start("SENSITIVITY") + runModule.run.sensitivity.analysis(settings) + PEcAn.utils::status.end() +} + +# Run parameter data assimilation +if ("assim.batch" %in% names(settings)) { + if (PEcAn.utils::status.check("PDA") == 0) { + PEcAn.utils::status.start("PDA") + settings <- + PEcAn.assim.batch::runModule.assim.batch(settings) + PEcAn.utils::status.end() + } +} + +# Run state data assimilation +if ("state.data.assimilation" %in% names(settings)) { + if (PEcAn.utils::status.check("SDA") == 0) { + PEcAn.utils::status.start("SDA") + settings <- sda.enfk(settings) + PEcAn.utils::status.end() + } +} + +# Run benchmarking +if ("benchmarking" %in% names(settings) +&& "benchmark" %in% names(settings$benchmarking)) { + PEcAn.utils::status.start("BENCHMARKING") + results <- + papply(settings, function(x) { + calc_benchmark(x, bety) + }) + PEcAn.utils::status.end() +} + +# Pecan workflow complete +if (PEcAn.utils::status.check("FINISHED") == 0) { + PEcAn.utils::status.start("FINISHED") + PEcAn.remote::kill.tunnel(settings) + db.query( + paste( + "UPDATE workflows SET finished_at=NOW() WHERE id=", + settings$workflow$id, + "AND finished_at IS NULL" + ), + params = settings$database$bety + ) + + # Send email if configured + if (!is.null(settings$email) + && !is.null(settings$email$to) + && (settings$email$to != "")) { + sendmail( + settings$email$from, + settings$email$to, + paste0("Workflow has finished executing at ", base::date()), + paste0("You can find the results on ", settings$email$url) + ) + } + PEcAn.utils::status.end() +} + +db.print.connections() +print("---------- PEcAn Workflow Complete ----------") diff --git a/modules/assim.sequential/inst/sda_backup/sserbin/workflow_2.R b/modules/assim.sequential/inst/sda_backup/sserbin/workflow_2.R new file mode 100755 index 00000000000..317aef7faa7 --- /dev/null +++ b/modules/assim.sequential/inst/sda_backup/sserbin/workflow_2.R @@ -0,0 +1,215 @@ +#!/usr/bin/env Rscript +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +# ---------------------------------------------------------------------- +# Load required libraries +# ---------------------------------------------------------------------- +library("PEcAn.all") +library("RCurl") + + +# -------------------------------------------------- +# get command-line arguments +args <- get_args() + +# make sure always to call status.end +options(warn = 1) +options(error = quote({ + try(PEcAn.utils::status.end("ERROR")) + try(PEcAn.remote::kill.tunnel(settings)) + if (!interactive()) { + q(status = 1) + } +})) + +# ---------------------------------------------------------------------- +# PEcAn Workflow +# ---------------------------------------------------------------------- +# Open and read in settings file for PEcAn run. +settings <- PEcAn.settings::read.settings(args$settings) + +# Check for additional modules that will require adding settings +if ("benchmarking" %in% names(settings)) { + library(PEcAn.benchmark) + settings <- papply(settings, read_settings_BRR) +} + +if ("sitegroup" %in% names(settings)) { + if (is.null(settings$sitegroup$nSite)) { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id + ) + } else { + settings <- PEcAn.settings::createSitegroupMultiSettings( + settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite + ) + } + # zero out so don't expand a second time if re-reading + settings$sitegroup <- NULL +} + +# Update/fix/check settings. +# Will only run the first time it's called, unless force=TRUE +settings <- + PEcAn.settings::prepare.settings(settings, force = FALSE) + +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") + +# start from scratch if no continue is passed in +status_file <- file.path(settings$outdir, "STATUS") +if (args$continue && file.exists(status_file)) { + file.remove(status_file) +} + +# Do conversions +settings <- PEcAn.workflow::do_conversions(settings) + +# Query the trait database for data and priors +if (PEcAn.utils::status.check("TRAIT") == 0) { + PEcAn.utils::status.start("TRAIT") + settings <- PEcAn.workflow::runModule.get.trait.data(settings) + PEcAn.settings::write.settings(settings, + outputfile = "pecan.TRAIT.xml" + ) + PEcAn.utils::status.end() +} else if (file.exists(file.path(settings$outdir, "pecan.TRAIT.xml"))) { + settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.TRAIT.xml")) +} + + +# Run the PEcAn meta.analysis +if (!is.null(settings$meta.analysis)) { + if (PEcAn.utils::status.check("META") == 0) { + PEcAn.utils::status.start("META") + PEcAn.MA::runModule.run.meta.analysis(settings) + PEcAn.utils::status.end() + } +} + +# Write model specific configs +if (PEcAn.utils::status.check("CONFIG") == 0) { + PEcAn.utils::status.start("CONFIG") + settings <- + PEcAn.workflow::runModule.run.write.configs(settings) + PEcAn.settings::write.settings(settings, outputfile = "pecan.CONFIGS.xml") + PEcAn.utils::status.end() +} else if (file.exists(file.path(settings$outdir, "pecan.CONFIGS.xml"))) { + settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.CONFIGS.xml")) +} + +if ((length(which(commandArgs() == "--advanced")) != 0) +&& (PEcAn.utils::status.check("ADVANCED") == 0)) { + PEcAn.utils::status.start("ADVANCED") + q() +} + +# Start ecosystem model runs +if (PEcAn.utils::status.check("MODEL") == 0) { + PEcAn.utils::status.start("MODEL") + stop_on_error <- as.logical(settings[[c("run", "stop_on_error")]]) + if (length(stop_on_error) == 0) { + # If we're doing an ensemble run, don't stop. If only a single run, we + # should be stopping. + if (is.null(settings[["ensemble"]]) || + as.numeric(settings[[c("ensemble", "size")]]) == 1) { + stop_on_error <- TRUE + } else { + stop_on_error <- FALSE + } + } + PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = stop_on_error) + PEcAn.utils::status.end() +} + +# Get results of model runs +if (PEcAn.utils::status.check("OUTPUT") == 0) { + PEcAn.utils::status.start("OUTPUT") + runModule.get.results(settings) + PEcAn.utils::status.end() +} + +# Run ensemble analysis on model output. +if ("ensemble" %in% names(settings) +&& PEcAn.utils::status.check("ENSEMBLE") == 0) { + PEcAn.utils::status.start("ENSEMBLE") + runModule.run.ensemble.analysis(settings, TRUE) + PEcAn.utils::status.end() +} + +# Run sensitivity analysis and variance decomposition on model output +if ("sensitivity.analysis" %in% names(settings) +&& PEcAn.utils::status.check("SENSITIVITY") == 0) { + PEcAn.utils::status.start("SENSITIVITY") + runModule.run.sensitivity.analysis(settings) + PEcAn.utils::status.end() +} + +# Run parameter data assimilation +if ("assim.batch" %in% names(settings)) { + if (PEcAn.utils::status.check("PDA") == 0) { + PEcAn.utils::status.start("PDA") + settings <- + PEcAn.assim.batch::runModule.assim.batch(settings) + PEcAn.utils::status.end() + } +} + +# Run state data assimilation +if ("state.data.assimilation" %in% names(settings)) { + if (PEcAn.utils::status.check("SDA") == 0) { + PEcAn.utils::status.start("SDA") + settings <- sda.enfk(settings) + PEcAn.utils::status.end() + } +} + +# Run benchmarking +if ("benchmarking" %in% names(settings) +&& "benchmark" %in% names(settings$benchmarking)) { + PEcAn.utils::status.start("BENCHMARKING") + results <- + papply(settings, function(x) { + calc_benchmark(x, bety) + }) + PEcAn.utils::status.end() +} + +# Pecan workflow complete +if (PEcAn.utils::status.check("FINISHED") == 0) { + PEcAn.utils::status.start("FINISHED") + PEcAn.remote::kill.tunnel(settings) + db.query( + paste( + "UPDATE workflows SET finished_at=NOW() WHERE id=", + settings$workflow$id, + "AND finished_at IS NULL" + ), + params = settings$database$bety + ) + + # Send email if configured + if (!is.null(settings$email) + && !is.null(settings$email$to) + && (settings$email$to != "")) { + sendmail( + settings$email$from, + settings$email$to, + paste0("Workflow has finished executing at ", base::date()), + paste0("You can find the results on ", settings$email$url) + ) + } + PEcAn.utils::status.end() +} + +db.print.connections() +print("---------- PEcAn Workflow Complete ----------") diff --git a/modules/assim.sequential/inst/workflow.variance.partitioning.R b/modules/assim.sequential/inst/workflow.variance.partitioning.R new file mode 100644 index 00000000000..e88cea1cd96 --- /dev/null +++ b/modules/assim.sequential/inst/workflow.variance.partitioning.R @@ -0,0 +1,278 @@ + +##### +##### Workflow code by Ann Raiho (ann.raiho@gmail.com) +##### This is the workflow template for doing a variance partitioning run +##### It probably will take you two days to rerun. The longest runs are the full SDA and process variance runs. +##### Basically I'm altering the pecan.SDA.xml to run the runs with data constrained initial conditions +##### For the spin up runs I'm altering the pecan.CONFIGS.xml to just use start.model.runs() +##### + + +library(PEcAn.all) +library(PEcAn.SIPNET) +library(PEcAn.LINKAGES) +library(PEcAn.visualization) +library(PEcAn.ED2) +library(PEcAn.assim.sequential) +library(nimble) +library(lubridate) +library(PEcAn.visualization) +#PEcAn.assim.sequential:: +library(rgdal) # need to put in assim.sequential +library(ncdf4) # need to put in assim.sequential + + +##### +##### SDA FULL RUN +##### + +settings <- read.settings("pecan.SDA.xml") + +load('sda.obs.Rdata') + +obs.mean <- obs.list$obs.mean +obs.cov <- obs.list$obs.cov + +sda.enkf(settings, obs.mean, obs.cov, Q = NULL, restart=F, + control=list(trace=T, + interactivePlot=T, + TimeseriesPlot=T, + BiasPlot=T, + plot.title=NULL, + debug=F, + pause = F)) + +#### +#### DEFAULT +#### + +nens <- settings$ensemble + +#changed input to be only one met ensemble member +#basically the same as pecan.CONFIGS.xml +settings <- read.settings('pecan.DEFAULT.xml') +settings <- PEcAn.workflow::runModule.run.write.configs(settings) + +# Taking average of samples to have fixed params across nens +load('samples.Rdata') +ensemble.samples.means <- ensemble.samples +for(i in 1:length(ensemble.samples.means)) ensemble.samples.means[[i]] <- matrix(colMeans(ensemble.samples[[i]]),nens,ncol(ensemble.samples[[i]]),byrow = T) +ensemble.samples <- ensemble.samples.means +save(ensemble.samples,file='average_samples.Rdata') +save(ensemble.samples,file='samples.Rdata') + +outconfig <- write.ensemble.configs(defaults = settings$pfts, + ensemble.samples = ensemble.samples, + settings = settings, + model = settings$model$type, + write.to.db = settings$database$bety$write, + restart = NULL) +PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = FALSE) + +file.rename('out','out_default') +file.rename('run','run_default') + +#### +#### DEFAULT -- DATA IC #### +#### + +#similar to pecan.SDA.xml but with not sampling params or met or doing process. Using SDA to constrain time step 1. +settings <- read.settings('pecan.DEFAULT.DATAIC.xml') +load('sda.obs.Rdata') + +#Becasue we only want to inform the initial conditions for this model experiment we only use the first data point. +#The last data point is included so that the model runs until this point. +obs.cov <- obs.mean <- list() +for(i in c(1,length(obs.list$obs.mean))){ + obs.mean[[i]] <- obs.list$obs.mean[[i]] + obs.cov[[i]] <- obs.list$obs.cov[[i]] +} + +#write dates as names for data objects +names(obs.cov) <- names(obs.mean) <- names(obs.list$obs.cov) + +obs.mean[2:(length(obs.list$obs.mean)-1)] <- NULL +obs.cov[2:(length(obs.list$obs.mean)-1)] <- NULL + +obs.mean[[length(obs.mean)]] <- rep(NA,length(ensemble.samples.means)) + +sda.enkf(settings, obs.mean, obs.cov, Q = NULL, restart=F, + control=list(trace=T, + interactivePlot=T, + TimeseriesPlot=T, + BiasPlot=T, + plot.title=NULL, + debug=F, + pause = F)) + +file.rename('out','out_default_ic') +file.rename('run','run_default_ic') +file.rename('SDA','SDA_default_ic') + +#### +#### PARAM #### +#### + +#running with sampled params +settings <- read.settings('pecan.DEFAULT.xml') +settings <- PEcAn.workflow::runModule.run.write.configs(settings) +PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = FALSE) + +file.rename('out','out_param') +file.rename('run','run_param') + +#### +#### PARAM DATA IC #### +#### + +settings <- read.settings('pecan.DEFAULT.DATAIC.xml') +load('sda.obs.Rdata')#load('sda.data_AGB.Rdata') + +#Becasue we only want to inform the initial conditions for this model experiment we only use the first data point. +#The last data point is included so that the model runs until this point. +obs.cov <- obs.mean <- list() +for(i in c(1,length(obs.list$obs.mean))){ + obs.mean[[i]] <- obs.list$obs.mean[[i]] + obs.cov[[i]] <- obs.list$obs.cov[[i]] +} + +#write dates as names for data objects +names(obs.cov) <- names(obs.mean) <- names(obs.list$obs.cov) + +obs.mean[2:(length(obs.list$obs.mean)-1)] <- NULL +obs.cov[2:(length(obs.list$obs.mean)-1)] <- NULL + +obs.mean[[length(obs.mean)]] <- rep(NA,length(ensemble.samples.means)) + +sda.enkf(settings, obs.mean, obs.cov, Q = NULL, restart=F, + control=list(trace=T, + interactivePlot=T, + TimeseriesPlot=T, + BiasPlot=T, + plot.title=NULL, + debug=F, + pause = F)) + +file.rename('out','out_param_ic') +file.rename('run','run_param_ic') + +#### +#### MET #### +#### + +#running with sampled params +settings <- read.settings('pecan.SAMP.MET.xml') +settings <- PEcAn.workflow::runModule.run.write.configs(settings) +PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = FALSE) + +file.rename('out','out_met') +file.rename('run','run_met') + +#### +#### MET DATA IC #### +#### + +file.rename('ensemble_weights_SDA.Rdata','ensemble_weights.Rdata') + +settings <- read.settings('pecan.SAMP.MET.DATA.IC.xml') +load('sda.obs.Rdata')#load('sda.data_AGB.Rdata') + +#Becasue we only want to inform the initial conditions for this model experiment we only use the first data point. +#The last data point is included so that the model runs until this point. +obs.cov <- obs.mean <- list() +for(i in c(1,length(obs.list$obs.mean))){ + obs.mean[[i]] <- obs.list$obs.mean[[i]] + obs.cov[[i]] <- obs.list$obs.cov[[i]] +} + +#write dates as names for data objects +names(obs.cov) <- names(obs.mean) <- names(obs.list$obs.cov) + +obs.mean[2:(length(obs.list$obs.mean)-1)] <- NULL +obs.cov[2:(length(obs.list$obs.mean)-1)] <- NULL + +obs.mean[[length(obs.mean)]] <- rep(NA,length(ensemble.samples.means)) + +sda.enkf(settings, obs.mean, obs.cov, Q = NULL, restart=F, + control=list(trace=T, + interactivePlot=T, + TimeseriesPlot=T, + BiasPlot=T, + plot.title=NULL, + debug=F, + pause = F)) + +file.rename('out','out_met_ic') +file.rename('run','run_met_ic') + +#### +#### PROCESS #### +#### + +settings <- read.settings('pecan.PROCESS.xml') + +#running with sampled params +load('sda.obs.Rdata')#load('sda.data_AGB.Rdata') + +obs.mean <- obs.list$obs.mean +obs.cov <- obs.list$obs.cov + +#write dates as names for data objects +names(obs.cov) <- names(obs.mean) <- names(obs.list$obs.cov) + +for(i in 1:length(obs.list$obs.mean)) obs.mean[[i]] <- rep(NA,length(ensemble.samples.means)) + +load('SDA_SDA/sda.output.Rdata') + +Q <- solve(enkf.params[[t-1]]$q.bar) + +rm(new.state) + +sda.enkf(settings, obs.mean, obs.cov, Q = Q, restart=F, + control=list(trace=T, + interactivePlot=T, + TimeseriesPlot=T, + BiasPlot=T, + plot.title=NULL, + debug=F, + pause = F)) + +file.rename('out','out_process') +file.rename('run','run_process') +file.rename('SDA','SDA_process') + +#### +#### PROCESS DATA IC #### +#### + +settings <- read.settings('pecan.PROCESS.xml') + +#running with sampled params +load('sda.obs.Rdata') + +obs.mean <- obs.list$obs.mean +obs.cov <- obs.list$obs.cov + +#write dates as names for data objects +names(obs.cov) <- names(obs.mean) <- names(obs.list$obs.cov) + +for(i in 2:length(obs.list$obs.mean)) obs.mean[[i]] <- rep(NA,length(ensemble.samples.means)) + +load('SDA_SDA/sda.output.Rdata') + +Q <- solve(enkf.params[[t-1]]$q.bar) + +rm(new.state) + +sda.enkf(settings, obs.mean, obs.cov, Q = Q, restart=T, + control=list(trace=T, + interactivePlot=T, + TimeseriesPlot=T, + BiasPlot=T, + plot.title=NULL, + debug=F, + pause = F)) + +file.rename('out','out_process_ic') +file.rename('run','run_process_ic') +file.rename('SDA','SDA_process_ic') diff --git a/modules/assim.sequential/man/Analysis.sda.Rd b/modules/assim.sequential/man/Analysis.sda.Rd index 5091b2fae9e..3f52e5c9894 100644 --- a/modules/assim.sequential/man/Analysis.sda.Rd +++ b/modules/assim.sequential/man/Analysis.sda.Rd @@ -4,8 +4,15 @@ \alias{Analysis.sda} \title{Analysis.sda} \usage{ -Analysis.sda(settings, FUN, Forecast = list(Pf = NULL, mu.f = NULL, Q = - NULL, X = NULL), Observed = list(R = NULL, Y = NULL), H, extraArg, ...) +Analysis.sda( + settings, + FUN, + Forecast = list(Pf = NULL, mu.f = NULL, Q = NULL, X = NULL), + Observed = list(R = NULL, Y = NULL), + H, + extraArg, + ... +) } \arguments{ \item{settings}{pecan standard settings list.} diff --git a/modules/assim.sequential/man/Contruct.Pf.Rd b/modules/assim.sequential/man/Contruct.Pf.Rd index ac99bc0ce7e..ea6485de76a 100644 --- a/modules/assim.sequential/man/Contruct.Pf.Rd +++ b/modules/assim.sequential/man/Contruct.Pf.Rd @@ -4,8 +4,15 @@ \alias{Contruct.Pf} \title{Contruct.Pf} \usage{ -Contruct.Pf(site.ids, var.names, X, localization.FUN = NULL, t = 1, - blocked.dis = NULL, ...) +Contruct.Pf( + site.ids, + var.names, + X, + localization.FUN = NULL, + t = 1, + blocked.dis = NULL, + ... +) } \arguments{ \item{site.ids}{a vector name of site ids.} diff --git a/modules/assim.sequential/man/GEF.MultiSite.Nimble.Rd b/modules/assim.sequential/man/GEF.MultiSite.Nimble.Rd new file mode 100644 index 00000000000..bb3c667240a --- /dev/null +++ b/modules/assim.sequential/man/GEF.MultiSite.Nimble.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\docType{data} +\name{GEF.MultiSite.Nimble} +\alias{GEF.MultiSite.Nimble} +\title{multisite TWEnF} +\format{TBD} +\usage{ +GEF.MultiSite.Nimble +} +\description{ +multisite TWEnF +} +\keyword{datasets} diff --git a/modules/assim.sequential/man/GEF.Rd b/modules/assim.sequential/man/GEF.Rd index dade0b33f79..a087e163c9c 100644 --- a/modules/assim.sequential/man/GEF.Rd +++ b/modules/assim.sequential/man/GEF.Rd @@ -5,8 +5,16 @@ \alias{GEF.MultiSite} \title{GEF} \usage{ -GEF(settings, Forecast, Observed, H, extraArg, nitr = 50000, - nburnin = 10000, ...) +GEF( + settings, + Forecast, + Observed, + H, + extraArg, + nitr = 50000, + nburnin = 10000, + ... +) GEF.MultiSite(setting, Forecast, Observed, H, extraArg, ...) } diff --git a/modules/assim.sequential/man/Remote.Sync.launcher.Rd b/modules/assim.sequential/man/Remote_Sync_launcher.Rd similarity index 70% rename from modules/assim.sequential/man/Remote.Sync.launcher.Rd rename to modules/assim.sequential/man/Remote_Sync_launcher.Rd index 558fc33b92b..e7c7f0a0e2d 100644 --- a/modules/assim.sequential/man/Remote.Sync.launcher.Rd +++ b/modules/assim.sequential/man/Remote_Sync_launcher.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/Remote_helpers.R -\name{Remote.Sync.launcher} -\alias{Remote.Sync.launcher} -\title{Remote.Sync.launcher} +\name{Remote_Sync_launcher} +\alias{Remote_Sync_launcher} +\title{Remote_Sync_launcher} \usage{ -Remote.Sync.launcher(settingPath, remote.path, PID) +Remote_Sync_launcher(settingPath, remote.path, PID) } \arguments{ \item{settingPath}{Path to your local setting .} @@ -14,5 +14,5 @@ Remote.Sync.launcher(settingPath, remote.path, PID) \item{PID}{PID generated by SDA_remote_launcher which shows the active PID running your SDA job.} } \description{ -Remote.Sync.launcher +Remote_Sync_launcher } diff --git a/modules/assim.sequential/man/SDA_control.Rd b/modules/assim.sequential/man/SDA_control.Rd index cbb3f088c94..6325b1a9eb3 100644 --- a/modules/assim.sequential/man/SDA_control.Rd +++ b/modules/assim.sequential/man/SDA_control.Rd @@ -4,10 +4,19 @@ \alias{SDA_control} \title{SDA_control} \usage{ -SDA_control(trace = TRUE, ForewardForecast = FALSE, - interactivePlot = FALSE, TimeseriesPlot = FALSE, BiasPlot = FALSE, - plot.title = NULL, facet.plots = FALSE, debug = FALSE, - pause = FALSE, Profiling = FALSE, OutlierDetection = FALSE) +SDA_control( + trace = TRUE, + ForewardForecast = FALSE, + interactivePlot = FALSE, + TimeseriesPlot = FALSE, + BiasPlot = FALSE, + plot.title = NULL, + facet.plots = FALSE, + debug = FALSE, + pause = FALSE, + Profiling = FALSE, + OutlierDetection = FALSE +) } \arguments{ \item{trace}{Logical if code should print out the progress of SDA .} diff --git a/modules/assim.sequential/man/SDA_remote_launcher.Rd b/modules/assim.sequential/man/SDA_remote_launcher.Rd index 171b3f148ae..df2b5bb10fb 100644 --- a/modules/assim.sequential/man/SDA_remote_launcher.Rd +++ b/modules/assim.sequential/man/SDA_remote_launcher.Rd @@ -17,3 +17,25 @@ This function returns a list of two pieces of information. One the remote path t \description{ SDA_remote_launcher } +\examples{ +\dontrun{ + # This example can be found under inst folder in the package + library(PEcAn.all) + library(purrr) + + run.bash.args <- c( + "#$ -l h_rt=48:00:00", + "#$ -pe omp 28 # Request a parallel environment with 4 cores", + "#$ -l mem_per_core=1G # and 4G memory for each", + "#$ -l buyin", + "module load R/3.5.2", + "module load python/2.7.13" + ) + settingPath <-"pecan.SDA.4sites.xml" + + ObsPath <- "Obs/LandTrendr_AGB_output50s.RData" + + SDA_remote_launcher(settingPath, ObsPath, run.bash.args) +} + +} diff --git a/modules/assim.sequential/man/alltocs.Rd b/modules/assim.sequential/man/alltocs.Rd index f861a8f2b3e..d6c6ee51fb5 100644 --- a/modules/assim.sequential/man/alltocs.Rd +++ b/modules/assim.sequential/man/alltocs.Rd @@ -15,3 +15,15 @@ This function writes down a csv file with three columns: 1- message sepecified i \description{ This function finds all the tic functions called before and estimates the time elapsed for each one saves/appends it to a csv file. } +\examples{ + +\dontrun{ + library(tictoc) + tic("Analysis") + Sys.sleep(5) + testfunc() + tic("Adjustment") + Sys.sleep(4) + alltocs("timing.csv") +} +} diff --git a/modules/assim.sequential/man/alr.Rd b/modules/assim.sequential/man/alr.Rd new file mode 100644 index 00000000000..41f5f73ebb4 --- /dev/null +++ b/modules/assim.sequential/man/alr.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\name{alr} +\alias{alr} +\title{Additive Log Ratio transform} +\usage{ +alr(y) +} +\arguments{ +\item{y}{state var} +} +\description{ +Additive Log Ratio transform +} diff --git a/modules/assim.sequential/man/assess.params.Rd b/modules/assim.sequential/man/assess.params.Rd index d741c5d0e34..24c873b53b2 100644 --- a/modules/assim.sequential/man/assess.params.Rd +++ b/modules/assim.sequential/man/assess.params.Rd @@ -5,13 +5,15 @@ \alias{assessParams} \title{assess.params} \usage{ -assessParams(dat, Xt, mu_f_TRUE = NULL, P_f_TRUE = NULL) +assessParams(dat, Xt, wts = NULL, mu_f_TRUE = NULL, P_f_TRUE = NULL) } \arguments{ \item{dat}{MCMC output} \item{Xt}{ensemble output matrix} +\item{wts}{ensemble weights} + \item{mu_f_TRUE}{muf before tobit2space} \item{P_f_TRUE}{Pf before tobit2space} diff --git a/modules/assim.sequential/man/conj_wt_wishart_sampler.Rd b/modules/assim.sequential/man/conj_wt_wishart_sampler.Rd new file mode 100644 index 00000000000..2bbf6d0528f --- /dev/null +++ b/modules/assim.sequential/man/conj_wt_wishart_sampler.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\name{conj_wt_wishart_sampler} +\alias{conj_wt_wishart_sampler} +\title{Weighted conjugate wishart} +\usage{ +conj_wt_wishart_sampler(model, mvSaved, target, control) +} +\arguments{ +\item{model}{model} + +\item{mvSaved}{copied to} + +\item{target}{thing being targetted} + +\item{control}{unused} +} +\description{ +Weighted conjugate wishart +} diff --git a/modules/assim.sequential/man/dwtmnorm.Rd b/modules/assim.sequential/man/dwtmnorm.Rd new file mode 100644 index 00000000000..ef70f5ad689 --- /dev/null +++ b/modules/assim.sequential/man/dwtmnorm.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\name{dwtmnorm} +\alias{dwtmnorm} +\title{weighted multivariate normal density} +\usage{ +dwtmnorm(x, mean, prec, wt, log = 0) +} +\arguments{ +\item{x}{random variable} + +\item{mean}{mean} + +\item{prec}{precision} + +\item{wt}{weight} + +\item{log}{log} +} +\description{ +weighted multivariate normal density +} diff --git a/modules/assim.sequential/man/get_ensemble_weights.Rd b/modules/assim.sequential/man/get_ensemble_weights.Rd index 964546d40f4..c3eb6f9e8d5 100644 --- a/modules/assim.sequential/man/get_ensemble_weights.Rd +++ b/modules/assim.sequential/man/get_ensemble_weights.Rd @@ -4,10 +4,12 @@ \alias{get_ensemble_weights} \title{get_ensemble_weights} \usage{ -get_ensemble_weights(settings) +get_ensemble_weights(settings, time_do) } \arguments{ \item{settings}{PEcAn settings object} + +\item{time_do}{Give user specific time so you don't have to have it be annual} } \value{ NONE diff --git a/modules/assim.sequential/man/interactive.plotting.sda.Rd b/modules/assim.sequential/man/interactive.plotting.sda.Rd index a0780c797a9..010c625d629 100644 --- a/modules/assim.sequential/man/interactive.plotting.sda.Rd +++ b/modules/assim.sequential/man/interactive.plotting.sda.Rd @@ -10,25 +10,82 @@ \alias{post.analysis.multisite.ggplot} \title{Internal functions for plotting SDA outputs. Interactive, post analysis time-series and bias plots in base plotting system and ggplot} \usage{ -interactive.plotting.sda(settings, t, obs.times, obs.mean, obs.cov, obs, X, - FORECAST, ANALYSIS) +interactive.plotting.sda( + settings, + t, + obs.times, + obs.mean, + obs.cov, + obs, + X, + FORECAST, + ANALYSIS +) -postana.timeser.plotting.sda(settings, t, obs.times, obs.mean, obs.cov, - obs, X, FORECAST, ANALYSIS) +postana.timeser.plotting.sda( + settings, + t, + obs.times, + obs.mean, + obs.cov, + obs, + X, + FORECAST, + ANALYSIS +) -postana.bias.plotting.sda(settings, t, obs.times, obs.mean, obs.cov, obs, - X, FORECAST, ANALYSIS) +postana.bias.plotting.sda( + settings, + t, + obs.times, + obs.mean, + obs.cov, + obs, + X, + FORECAST, + ANALYSIS +) postana.bias.plotting.sda.corr(t, obs.times, X, aqq, bqq) -post.analysis.ggplot(settings, t, obs.times, obs.mean, obs.cov, obs, X, - FORECAST, ANALYSIS, plot.title = NULL) +post.analysis.ggplot( + settings, + t, + obs.times, + obs.mean, + obs.cov, + obs, + X, + FORECAST, + ANALYSIS, + plot.title = NULL +) -post.analysis.ggplot.violin(settings, t, obs.times, obs.mean, obs.cov, obs, - X, FORECAST, ANALYSIS, plot.title = NULL) +post.analysis.ggplot.violin( + settings, + t, + obs.times, + obs.mean, + obs.cov, + obs, + X, + FORECAST, + ANALYSIS, + plot.title = NULL +) -post.analysis.multisite.ggplot(settings, t, obs.times, obs.mean, obs.cov, - FORECAST, ANALYSIS, plot.title = NULL, facetg = F, readsFF = NULL) +post.analysis.multisite.ggplot( + settings, + t, + obs.times, + obs.mean, + obs.cov, + FORECAST, + ANALYSIS, + plot.title = NULL, + facetg = FALSE, + readsFF = NULL +) } \arguments{ \item{settings}{pecan standard settings list.} diff --git a/modules/assim.sequential/man/inv.alr.Rd b/modules/assim.sequential/man/inv.alr.Rd new file mode 100644 index 00000000000..370e956f7af --- /dev/null +++ b/modules/assim.sequential/man/inv.alr.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\name{inv.alr} +\alias{inv.alr} +\title{inverse of ALR transform} +\usage{ +inv.alr(alr) +} +\arguments{ +\item{alr}{state var} +} +\description{ +inverse of ALR transform +} diff --git a/modules/assim.sequential/man/load_nimble.Rd b/modules/assim.sequential/man/load_nimble.Rd index 703ca040d1c..cceeacc4f46 100644 --- a/modules/assim.sequential/man/load_nimble.Rd +++ b/modules/assim.sequential/man/load_nimble.Rd @@ -2,9 +2,13 @@ % Please edit documentation in R/Nimble_codes.R \name{load_nimble} \alias{load_nimble} +\alias{y_star_create} \title{load_nimble} \usage{ -load_nimble() +y_star_create(X) +} +\arguments{ +\item{X}{state var} } \description{ This functions is internally used to register a series of nimble functions inside GEF analysis function. diff --git a/modules/assim.sequential/man/outlier.detector.boxplot.Rd b/modules/assim.sequential/man/outlier.detector.boxplot.Rd index c1885e8b032..2c2b7c74030 100644 --- a/modules/assim.sequential/man/outlier.detector.boxplot.Rd +++ b/modules/assim.sequential/man/outlier.detector.boxplot.Rd @@ -9,6 +9,10 @@ outlier.detector.boxplot(X) \arguments{ \item{X}{A list of dataframes} } +\value{ +A list the same dimension as X, with each column of each dataframe + modified by replacing outlier points with the column median +} \description{ This function performs a simple outlier replacement on all the columns of dataframes inside a list } diff --git a/modules/assim.sequential/man/rescaling_stateVars.Rd b/modules/assim.sequential/man/rescaling_stateVars.Rd new file mode 100644 index 00000000000..24baf41a6af --- /dev/null +++ b/modules/assim.sequential/man/rescaling_stateVars.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Helper.functions.R +\name{rescaling_stateVars} +\alias{rescaling_stateVars} +\title{rescaling_stateVars} +\usage{ +rescaling_stateVars(settings, X, multiply = TRUE) +} +\arguments{ +\item{settings}{pecan xml settings where state variables have the scaling_factor tag} + +\item{X}{Any Matrix with column names as variable names} + +\item{multiply}{TRUE = multiplication, FALSE = division} +} +\value{ +rescaled Matrix +} +\description{ +This function uses a set of scaling factors defined in the pecan XML to scale a given matrix +} diff --git a/modules/assim.sequential/man/rwtmnorm.Rd b/modules/assim.sequential/man/rwtmnorm.Rd new file mode 100644 index 00000000000..97a9c147c73 --- /dev/null +++ b/modules/assim.sequential/man/rwtmnorm.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\name{rwtmnorm} +\alias{rwtmnorm} +\title{random weighted multivariate normal} +\usage{ +rwtmnorm(n, mean, prec, wt) +} +\arguments{ +\item{n}{sample size} + +\item{mean}{mean} + +\item{prec}{precision} + +\item{wt}{weight} +} +\description{ +random weighted multivariate normal +} diff --git a/modules/assim.sequential/man/sample_met.Rd b/modules/assim.sequential/man/sample_met.Rd new file mode 100644 index 00000000000..221637dbbd9 --- /dev/null +++ b/modules/assim.sequential/man/sample_met.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/met_filtering_helpers.R +\name{sample_met} +\alias{sample_met} +\title{Sample meteorological ensembles} +\usage{ +sample_met(settings, nens = 1) +} +\arguments{ +\item{settings}{PEcAn settings list} + +\item{nens}{number of ensemble members to be sampled} +} +\description{ +Sample meteorological ensembles +} diff --git a/modules/assim.sequential/man/sampler_toggle.Rd b/modules/assim.sequential/man/sampler_toggle.Rd new file mode 100644 index 00000000000..d887a8a705e --- /dev/null +++ b/modules/assim.sequential/man/sampler_toggle.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\name{sampler_toggle} +\alias{sampler_toggle} +\title{sampler toggling} +\usage{ +sampler_toggle(model, mvSaved, target, control) +} +\arguments{ +\item{model}{model} + +\item{mvSaved}{copied to} + +\item{target}{thing being targetted} + +\item{control}{unused} +} +\description{ +sampler toggling +} diff --git a/modules/assim.sequential/man/sda.enkf.Rd b/modules/assim.sequential/man/sda.enkf.Rd index afd5fc8ae57..31a446eb136 100644 --- a/modules/assim.sequential/man/sda.enkf.Rd +++ b/modules/assim.sequential/man/sda.enkf.Rd @@ -5,41 +5,44 @@ \alias{sda.enkf.original} \title{sda.enkf} \usage{ -sda.enkf.original(settings, obs.mean, obs.cov, IC = NULL, Q = NULL, - adjustment = TRUE, restart = NULL) - -sda.enkf(settings, obs.mean, obs.cov, Q = NULL, restart = NULL, - control = list(trace = TRUE, interactivePlot = TRUE, TimeseriesPlot = - TRUE, BiasPlot = FALSE, plot.title = NULL, debug = FALSE, pause = FALSE), - ...) +sda.enkf.original( + settings, + obs.mean, + obs.cov, + IC = NULL, + Q = NULL, + adjustment = TRUE, + restart = NULL +) + +sda.enkf( + settings, + obs.mean, + obs.cov, + Q = NULL, + restart = NULL, + control = list(trace = TRUE, interactivePlot = TRUE, TimeseriesPlot = TRUE, BiasPlot = + FALSE, plot.title = NULL, debug = FALSE, pause = FALSE), + ... +) } \arguments{ \item{settings}{PEcAn settings object} -\item{obs.mean}{list of observations of the means of state variable (time X nstate)} +\item{obs.mean}{List of dataframe of observation means, named with observation datetime.} -\item{obs.cov}{list of observations of covariance matrices of state variables (time X nstate X nstate)} +\item{obs.cov}{List of covariance matrices of state variables , named with observation datetime.} \item{IC}{initial conditions} -\item{Q}{process covariance matrix given if there is no data to estimate it} +\item{Q}{Process covariance matrix given if there is no data to estimate it.} \item{adjustment}{flag for using ensemble adjustment filter or not} -\item{restart}{Used for iterative updating previous forecasts. This is a list that includes ens.inputs, the list of inputs by ensemble member, params, the parameters, and old_outdir, the output directory from the previous workflow. These three things are needed to ensure that if a new workflow is started that ensemble members keep there run-specific met and params. See Details} +\item{restart}{Used for iterative updating previous forecasts. When the restart is TRUE it read the object in SDA folder written from previous SDA.} \item{control}{List of flags controlling the behaviour of the SDA. trace for reporting back the SDA outcomes, interactivePlot for plotting the outcomes after each step, TimeseriesPlot for post analysis examination, BiasPlot for plotting the correlation between state variables, plot.title is the title of post analysis plots and debug mode allows for pausing the code and examinign the variables inside the function.} - -\item{settings}{PEcAn settings object} - -\item{obs.mean}{List of dataframe of observation means, named with observation datetime.} - -\item{obs.cov}{List of covariance matrices of state variables , named with observation datetime.} - -\item{Q}{Process covariance matrix given if there is no data to estimate it.} - -\item{restart}{Used for iterative updating previous forecasts. When the restart is TRUE it read the object in SDA folder written from previous SDA.} } \value{ NONE diff --git a/modules/assim.sequential/man/sda.enkf.multisite.Rd b/modules/assim.sequential/man/sda.enkf.multisite.Rd index 1fd0dce92d9..b901f411281 100644 --- a/modules/assim.sequential/man/sda.enkf.multisite.Rd +++ b/modules/assim.sequential/man/sda.enkf.multisite.Rd @@ -4,11 +4,19 @@ \alias{sda.enkf.multisite} \title{sda.enkf.multisite} \usage{ -sda.enkf.multisite(settings, obs.mean, obs.cov, Q = NULL, - restart = FALSE, control = list(trace = T, FF = F, interactivePlot = - FALSE, TimeseriesPlot = FALSE, BiasPlot = FALSE, plot.title = NULL, - facet.plots = FALSE, debug = FALSE, pause = FALSE, Profiling = FALSE, - OutlierDetection = FALSE), ...) +sda.enkf.multisite( + settings, + obs.mean, + obs.cov, + Q = NULL, + restart = FALSE, + forceRun = TRUE, + keepNC = TRUE, + control = list(trace = TRUE, FF = FALSE, interactivePlot = FALSE, TimeseriesPlot = + FALSE, BiasPlot = FALSE, plot.title = NULL, facet.plots = FALSE, debug = FALSE, pause + = FALSE, Profiling = FALSE, OutlierDetection = FALSE), + ... +) } \arguments{ \item{settings}{PEcAn settings object} @@ -21,6 +29,10 @@ sda.enkf.multisite(settings, obs.mean, obs.cov, Q = NULL, \item{restart}{Used for iterative updating previous forecasts. When the restart is TRUE it read the object in SDA folder written from previous SDA.} +\item{forceRun}{Used to force job.sh files that were not run for ensembles in SDA (quick fix)} + +\item{keepNC}{Used for debugging issues. .nc files are usually removed after each year in the out folder. This flag will keep the .nc + .nc.var files for futher investigations.} + \item{control}{List of flags controlling the behaviour of the SDA. trace for reporting back the SDA outcomes, interactivePlot for plotting the outcomes after each step, TimeseriesPlot for post analysis examination, BiasPlot for plotting the correlation between state variables, plot.title is the title of post analysis plots and debug mode allows for pausing the code and examinign the variables inside the function.} } diff --git a/modules/assim.sequential/man/tobit.model.Rd b/modules/assim.sequential/man/tobit.model.Rd new file mode 100644 index 00000000000..51ccd47fb09 --- /dev/null +++ b/modules/assim.sequential/man/tobit.model.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\docType{data} +\name{tobit.model} +\alias{tobit.model} +\title{TWEnF} +\format{TBD} +\usage{ +tobit.model +} +\description{ +TWEnF +} +\keyword{datasets} diff --git a/modules/assim.sequential/man/tobit2space.model.Rd b/modules/assim.sequential/man/tobit2space.model.Rd new file mode 100644 index 00000000000..018972d0b5c --- /dev/null +++ b/modules/assim.sequential/man/tobit2space.model.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/Nimble_codes.R +\docType{data} +\name{tobit2space.model} +\alias{tobit2space.model} +\title{Fit tobit prior to ensemble members} +\format{TBD} +\usage{ +tobit2space.model +} +\description{ +Fit tobit prior to ensemble members +} +\keyword{datasets} diff --git a/modules/assim.sequential/tests/Rcheck_reference.log b/modules/assim.sequential/tests/Rcheck_reference.log new file mode 100644 index 00000000000..e664e22b985 --- /dev/null +++ b/modules/assim.sequential/tests/Rcheck_reference.log @@ -0,0 +1,933 @@ +* using log directory ‘/tmp/Rtmpz0ebwx/PEcAn.assim.sequential.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-manual --as-cran’ +* checking for file ‘PEcAn.assim.sequential/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.assim.sequential’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.assim.sequential’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... OK +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... WARNING +Found the following file with non-ASCII characters: + load_data_paleon_sda.R +Portable packages must use only ASCII characters in their R code, +except perhaps in comments. +Use \uxxxx escapes for other characters. +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... OK +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +adj.ens: no visible global function definition for ‘logger.warn’ +adj.ens: no visible global function definition for ‘cov’ +alltocs: no visible global function definition for ‘%>%’ +alltocs: no visible global function definition for ‘map_dfr’ +alltocs : : no visible global function definition for ‘%>%’ +alltocs: no visible global function definition for ‘mutate’ +alltocs: no visible binding for global variable ‘TimeElapsed’ +alltocs: no visible global function definition for ‘write.table’ +assessParams: no visible global function definition for ‘cov’ +assessParams: no visible binding for global variable ‘quantile’ +assessParams: no visible global function definition for ‘par’ +assessParams: no visible global function definition for ‘plot’ +assessParams: no visible global function definition for ‘abline’ +assessParams: no visible global function definition for ‘lines’ +assessParams: no visible global function definition for ‘points’ +assessParams: no visible global function definition for ‘plot.new’ +assessParams: no visible global function definition for ‘legend’ +assessParams: no visible global function definition for ‘boxplot’ +assessParams: no visible global function definition for ‘cov2cor’ +Construct.H.multisite: no visible global function definition for ‘%>%’ +Construct.H.multisite: no visible global function definition for + ‘map_dbl’ +Construct.R: no visible global function definition for ‘%>%’ +Contruct.Pf: no visible global function definition for ‘cov’ +Contruct.Pf: no visible global function definition for ‘%>%’ +Contruct.Pf: no visible global function definition for ‘filter’ +Contruct.Pf: no visible binding for global variable ‘Var1’ +Contruct.Pf: no visible binding for global variable ‘Var2’ +EnKF: no visible global function definition for ‘cov’ +EnKF.MultiSite: no visible binding for global variable ‘settings’ +EnKF.MultiSite: no visible global function definition for ‘%>%’ +EnKF.MultiSite: no visible binding for global variable ‘site.ids’ +EnKF.MultiSite: no visible binding for global variable ‘blocked.dis’ +GEF: no visible global function definition for ‘cov’ +GEF : wish.df: no visible global function definition for ‘var’ +GEF: no visible binding for '<<-' assignment to ‘constants.tobit2space’ +GEF: no visible binding for '<<-' assignment to ‘data.tobit2space’ +GEF: no visible binding for '<<-' assignment to ‘tobit2space_pred’ +GEF: no visible binding for global variable ‘tobit2space.model’ +GEF: no visible binding for global variable ‘data.tobit2space’ +GEF: no visible binding for global variable ‘constants.tobit2space’ +GEF: no visible binding for '<<-' assignment to ‘conf_tobit2space’ +GEF: no visible binding for global variable ‘tobit2space_pred’ +GEF: no visible binding for global variable ‘conf_tobit2space’ +GEF: no visible binding for '<<-' assignment to + ‘samplerNumberOffset_tobit2space’ +GEF: no visible binding for '<<-' assignment to ‘Rmcmc_tobit2space’ +GEF: no visible binding for '<<-' assignment to ‘Cmcmc_tobit2space’ +GEF: no visible binding for global variable ‘Rmcmc_tobit2space’ +GEF: no visible binding for global variable ‘Cmcmc_tobit2space’ +GEF: no visible binding for global variable + ‘samplerNumberOffset_tobit2space’ +GEF: no visible global function definition for ‘pdf’ +GEF: no visible global function definition for ‘dev.off’ +GEF: no visible binding for global variable ‘obs.mean’ +GEF: no visible global function definition for ‘logger.warn’ +GEF: no visible binding for global variable ‘constants.tobit’ +GEF: no visible binding for '<<-' assignment to ‘constants.tobit’ +GEF: no visible binding for '<<-' assignment to ‘dimensions.tobit’ +GEF: no visible binding for '<<-' assignment to ‘data.tobit’ +GEF: no visible global function definition for ‘rnorm’ +GEF: no visible binding for global variable ‘tobit.model’ +GEF: no visible binding for global variable ‘data.tobit’ +GEF: no visible binding for global variable ‘dimensions.tobit’ +GEF: no visible binding for '<<-' assignment to ‘samplerNumberOffset’ +GEF: no visible binding for '<<-' assignment to ‘Rmcmc’ +GEF: no visible binding for '<<-' assignment to ‘Cmcmc’ +GEF: no visible binding for global variable ‘Rmcmc’ +GEF: no visible binding for global variable ‘Cmcmc’ +GEF: no visible binding for global variable ‘samplerNumberOffset’ +GEF: no visible global function definition for ‘par’ +GEF: no visible global function definition for ‘plot’ +GEF: no visible global function definition for ‘abline’ +GEF.MultiSite: no visible binding for global variable ‘settings’ +GEF.MultiSite: no visible global function definition for ‘cov’ +GEF.MultiSite : wish.df: no visible global function definition for + ‘var’ +GEF.MultiSite: no visible binding for '<<-' assignment to + ‘tobit2space_pred’ +GEF.MultiSite: no visible binding for global variable + ‘tobit2space.model’ +GEF.MultiSite: no visible binding for '<<-' assignment to + ‘conf_tobit2space’ +GEF.MultiSite: no visible binding for global variable + ‘tobit2space_pred’ +GEF.MultiSite: no visible binding for global variable + ‘conf_tobit2space’ +GEF.MultiSite: no visible binding for '<<-' assignment to + ‘samplerNumberOffset_tobit2space’ +GEF.MultiSite: no visible binding for '<<-' assignment to + ‘Rmcmc_tobit2space’ +GEF.MultiSite: no visible binding for '<<-' assignment to + ‘Cmcmc_tobit2space’ +GEF.MultiSite: no visible binding for global variable + ‘Rmcmc_tobit2space’ +GEF.MultiSite: no visible binding for global variable + ‘Cmcmc_tobit2space’ +GEF.MultiSite: no visible binding for global variable + ‘samplerNumberOffset_tobit2space’ +GEF.MultiSite: no visible binding for global variable ‘blocked.dis’ +GEF.MultiSite: no visible global function definition for ‘%>%’ +GEF.MultiSite: no visible binding for global variable ‘nt’ +GEF.MultiSite: no visible global function definition for ‘map’ +GEF.MultiSite: no visible global function definition for ‘modify’ +GEF.MultiSite: no visible global function definition for ‘modify_if’ +GEF.MultiSite: no visible binding for global variable ‘distances’ +GEF.MultiSite: no visible binding for global variable ‘obs.mean’ +GEF.MultiSite: no visible binding for global variable + ‘GEF.MultiSite.Nimble’ +GEF.MultiSite: no visible binding for '<<-' assignment to + ‘samplerNumberOffset’ +GEF.MultiSite: no visible binding for '<<-' assignment to ‘Rmcmc’ +GEF.MultiSite: no visible binding for '<<-' assignment to ‘Cmcmc’ +GEF.MultiSite: no visible binding for global variable ‘Rmcmc’ +GEF.MultiSite: no visible binding for global variable ‘Cmcmc’ +GEF.MultiSite: no visible binding for global variable + ‘samplerNumberOffset’ +GEF.MultiSite: no visible global function definition for ‘var’ +generate_colors_sda: no visible binding for '<<-' assignment to ‘pink’ +generate_colors_sda: no visible global function definition for + ‘col2rgb’ +generate_colors_sda: no visible binding for '<<-' assignment to + ‘alphapink’ +generate_colors_sda: no visible global function definition for ‘rgb’ +generate_colors_sda: no visible binding for global variable ‘pink’ +generate_colors_sda: no visible binding for '<<-' assignment to ‘green’ +generate_colors_sda: no visible binding for '<<-' assignment to + ‘alphagreen’ +generate_colors_sda: no visible binding for global variable ‘green’ +generate_colors_sda: no visible binding for '<<-' assignment to ‘blue’ +generate_colors_sda: no visible binding for '<<-' assignment to + ‘alphablue’ +generate_colors_sda: no visible binding for global variable ‘blue’ +generate_colors_sda: no visible binding for '<<-' assignment to + ‘purple’ +generate_colors_sda: no visible binding for '<<-' assignment to + ‘alphapurple’ +generate_colors_sda: no visible binding for global variable ‘purple’ +generate_colors_sda: no visible binding for '<<-' assignment to ‘brown’ +generate_colors_sda: no visible binding for '<<-' assignment to + ‘alphabrown’ +generate_colors_sda: no visible binding for global variable ‘brown’ +get_ensemble_weights: no visible global function definition for + ‘read.csv’ +hop_test: no visible global function definition for ‘run.write.configs’ +hop_test: no visible global function definition for ‘read.table’ +hop_test: no visible global function definition for ‘read.output’ +hop_test: no visible global function definition for ‘pdf’ +hop_test: no visible global function definition for ‘par’ +hop_test: no visible global function definition for ‘plot’ +hop_test: no visible global function definition for ‘points’ +hop_test: no visible global function definition for ‘abline’ +hop_test: no visible global function definition for ‘legend’ +hop_test: no visible global function definition for ‘title’ +hop_test: no visible global function definition for ‘cor’ +hop_test: no visible global function definition for ‘dev.off’ +interactive.plotting.sda: no visible global function definition for + ‘na.omit’ +interactive.plotting.sda: no visible global function definition for + ‘par’ +interactive.plotting.sda : : no visible global function + definition for ‘quantile’ +interactive.plotting.sda: no visible global function definition for + ‘plot’ +interactive.plotting.sda: no visible global function definition for + ‘ciEnvelope’ +interactive.plotting.sda: no visible binding for global variable + ‘alphagreen’ +interactive.plotting.sda: no visible global function definition for + ‘lines’ +interactive.plotting.sda: no visible binding for global variable + ‘alphablue’ +interactive.plotting.sda: no visible binding for global variable + ‘alphapink’ +load_data_paleon_sda: no visible global function definition for + ‘src_postgres’ +load_data_paleon_sda: no visible global function definition for + ‘db.query’ +load_data_paleon_sda: no visible global function definition for ‘.’ +load_data_paleon_sda: no visible binding for global variable + ‘MCMC_iteration’ +load_data_paleon_sda: no visible binding for global variable ‘site_id’ +load_data_paleon_sda: no visible global function definition for + ‘match_species_id’ +load_data_paleon_sda: no visible global function definition for + ‘match_pft’ +load_data_paleon_sda: no visible binding for global variable ‘pft.cat’ +load_data_paleon_sda : : no visible global function + definition for ‘cov’ +load_data_paleon_sda: no visible global function definition for ‘CRS’ +load_data_paleon_sda: no visible global function definition for + ‘ncvar_get’ +load_data_paleon_sda : ESS_calc: no visible binding for global variable + ‘var’ +load_data_paleon_sda: no visible global function definition for ‘cov’ +load_data_paleon_sda: no visible global function definition for + ‘na.omit’ +load_nimble: no visible binding for '<<-' assignment to ‘y_star_create’ +load_nimble : : no visible global function definition for + ‘returnType’ +load_nimble: no visible binding for '<<-' assignment to ‘alr’ +load_nimble: no visible binding for '<<-' assignment to ‘inv.alr’ +load_nimble: no visible binding for '<<-' assignment to ‘rwtmnorm’ +load_nimble: no visible binding for '<<-' assignment to ‘dwtmnorm’ +load_nimble: no visible binding for '<<-' assignment to + ‘tobit2space.model’ +load_nimble: no visible binding for global variable ‘N’ +load_nimble: no visible binding for global variable ‘J’ +load_nimble: no visible binding for global variable ‘lambda_0’ +load_nimble: no visible binding for global variable ‘nu_0’ +load_nimble: no visible binding for '<<-' assignment to ‘tobit.model’ +load_nimble: no visible binding for global variable ‘direct_TRUE’ +load_nimble: no visible binding for global variable ‘X_direct_start’ +load_nimble: no visible binding for global variable ‘X_direct_end’ +load_nimble: no visible global function definition for ‘y_star_create’ +load_nimble: no visible binding for global variable ‘X’ +load_nimble: no visible binding for global variable ‘fcomp_TRUE’ +load_nimble: no visible binding for global variable ‘X_fcomp_start’ +load_nimble: no visible binding for global variable ‘X_fcomp_end’ +load_nimble: no visible global function definition for ‘alr’ +load_nimble: no visible binding for global variable + ‘X_fcomp_model_start’ +load_nimble: no visible binding for global variable ‘X_fcomp_model_end’ +load_nimble: no visible binding for global variable ‘pft2total_TRUE’ +load_nimble: no visible binding for global variable ‘X_pft2total_start’ +load_nimble: no visible global function definition for + ‘y_star_create_pft2total’ +load_nimble: no visible binding for global variable + ‘X_pft2total_model_start’ +load_nimble: no visible binding for global variable + ‘X_pft2total_model_end’ +load_nimble: no visible binding for global variable ‘YN’ +load_nimble: no visible binding for '<<-' assignment to + ‘GEF.MultiSite.Nimble’ +load_nimble: no visible binding for global variable ‘q.type’ +load_nimble: no visible binding for global variable ‘qq’ +load_nimble: no visible binding for global variable ‘nH’ +load_nimble: no visible binding for global variable ‘X.mod’ +load_nimble: no visible binding for global variable ‘H’ +load_nimble: no visible binding for global variable ‘nNotH’ +load_nimble: no visible binding for global variable ‘NotH’ +load_nimble: no visible binding for '<<-' assignment to + ‘sampler_toggle’ +load_nimble : : no visible global function definition for + ‘nimbleFunctionList’ +load_nimble : : no visible binding for global variable + ‘toggle’ +load_nimble : : no visible binding for global variable + ‘nested_sampler_list’ +Obs.data.prepare.MultiSite: no visible global function definition for + ‘%>%’ +Obs.data.prepare.MultiSite: no visible global function definition for + ‘filter’ +Obs.data.prepare.MultiSite: no visible binding for global variable + ‘Site_ID’ +Obs.data.prepare.MultiSite: no visible global function definition for + ‘na.omit’ +Obs.data.prepare.MultiSite: no visible global function definition for + ‘map_chr’ +Obs.data.prepare.MultiSite: no visible binding for global variable ‘.’ +Obs.data.prepare.MultiSite: no visible global function definition for + ‘map’ +Obs.data.prepare.MultiSite : : no visible global function + definition for ‘%>%’ +Obs.data.prepare.MultiSite : : no visible global function + definition for ‘map’ +Obs.data.prepare.MultiSite : : no visible global function + definition for ‘setNames’ +Obs.data.prepare.MultiSite : : no visible binding for global + variable ‘.’ +Obs.data.prepare.MultiSite: no visible global function definition for + ‘setNames’ +outlier.detector.boxplot: no visible global function definition for + ‘%>%’ +outlier.detector.boxplot: no visible global function definition for + ‘map’ +outlier.detector.boxplot : : no visible global function + definition for ‘%>%’ +outlier.detector.boxplot : : no visible global function + definition for ‘map_dfc’ +outlier.detector.boxplot : : : no visible global + function definition for ‘boxplot’ +outlier.detector.boxplot : : : no visible global + function definition for ‘median’ +piecew.poly.local: no visible binding for global variable ‘rloc’ +post.analysis.ggplot: no visible global function definition for ‘%>%’ +post.analysis.ggplot : : no visible global function + definition for ‘%>%’ +post.analysis.ggplot : : : no visible binding + for global variable ‘quantile’ +post.analysis.ggplot : : : no visible global + function definition for ‘%>%’ +post.analysis.ggplot : : : no visible global + function definition for ‘mutate’ +post.analysis.ggplot : : no visible global function + definition for ‘mutate’ +post.analysis.ggplot: no visible global function definition for + ‘setNames’ +post.analysis.ggplot: no visible global function definition for + ‘bind_rows’ +post.analysis.ggplot: no visible global function definition for ‘walk’ +post.analysis.ggplot: no visible global function definition for + ‘ggplot’ +post.analysis.ggplot: no visible global function definition for ‘aes’ +post.analysis.ggplot: no visible binding for global variable ‘Date’ +post.analysis.ggplot: no visible global function definition for + ‘geom_ribbon’ +post.analysis.ggplot: no visible binding for global variable ‘2.5%’ +post.analysis.ggplot: no visible binding for global variable ‘97.5%’ +post.analysis.ggplot: no visible binding for global variable ‘Type’ +post.analysis.ggplot: no visible global function definition for + ‘geom_line’ +post.analysis.ggplot: no visible binding for global variable ‘means’ +post.analysis.ggplot: no visible global function definition for + ‘geom_point’ +post.analysis.ggplot: no visible global function definition for + ‘scale_fill_manual’ +post.analysis.ggplot: no visible binding for global variable + ‘alphapink’ +post.analysis.ggplot: no visible binding for global variable + ‘alphagreen’ +post.analysis.ggplot: no visible binding for global variable + ‘alphablue’ +post.analysis.ggplot: no visible global function definition for + ‘scale_color_manual’ +post.analysis.ggplot: no visible global function definition for + ‘theme_bw’ +post.analysis.ggplot: no visible global function definition for + ‘facet_wrap’ +post.analysis.ggplot: no visible global function definition for ‘theme’ +post.analysis.ggplot: no visible global function definition for + ‘element_blank’ +post.analysis.ggplot: no visible global function definition for ‘labs’ +post.analysis.ggplot: no visible global function definition for ‘pdf’ +post.analysis.ggplot: no visible global function definition for + ‘dev.off’ +post.analysis.ggplot.violin: no visible global function definition for + ‘%>%’ +post.analysis.ggplot.violin : : no visible global function + definition for ‘%>%’ +post.analysis.ggplot.violin : : : no visible + global function definition for ‘%>%’ +post.analysis.ggplot.violin : : no visible global function + definition for ‘mutate’ +post.analysis.ggplot.violin : : no visible binding for + global variable ‘t1’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘Variables’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘Value’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘Type’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘Date’ +post.analysis.ggplot.violin: no visible global function definition for + ‘setNames’ +post.analysis.ggplot.violin: no visible global function definition for + ‘walk’ +post.analysis.ggplot.violin: no visible global function definition for + ‘ggplot’ +post.analysis.ggplot.violin: no visible global function definition for + ‘aes’ +post.analysis.ggplot.violin: no visible global function definition for + ‘geom_ribbon’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘means’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘2.5%’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘97.5%’ +post.analysis.ggplot.violin: no visible global function definition for + ‘geom_line’ +post.analysis.ggplot.violin: no visible global function definition for + ‘geom_violin’ +post.analysis.ggplot.violin: no visible global function definition for + ‘position_dodge’ +post.analysis.ggplot.violin: no visible global function definition for + ‘geom_jitter’ +post.analysis.ggplot.violin: no visible global function definition for + ‘position_jitterdodge’ +post.analysis.ggplot.violin: no visible global function definition for + ‘scale_fill_manual’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘alphapink’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘alphagreen’ +post.analysis.ggplot.violin: no visible binding for global variable + ‘alphablue’ +post.analysis.ggplot.violin: no visible global function definition for + ‘scale_color_manual’ +post.analysis.ggplot.violin: no visible global function definition for + ‘facet_wrap’ +post.analysis.ggplot.violin: no visible global function definition for + ‘theme_bw’ +post.analysis.ggplot.violin: no visible global function definition for + ‘theme’ +post.analysis.ggplot.violin: no visible global function definition for + ‘element_blank’ +post.analysis.ggplot.violin: no visible global function definition for + ‘labs’ +post.analysis.ggplot.violin: no visible global function definition for + ‘pdf’ +post.analysis.ggplot.violin: no visible global function definition for + ‘dev.off’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘installed.packages’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘%>%’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘map’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘%>%’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘%>%’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘map_df’ +post.analysis.multisite.ggplot : : : + : no visible global function definition for ‘%>%’ +post.analysis.multisite.ggplot : : : + : no visible global function definition for ‘mutate’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Variable’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Value’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Site’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘group_by’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘summarise’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘quantile’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘mutate’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘setNames’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘map_dfr’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Variable’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Means’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Site’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘right_join’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Sd’ +post.analysis.multisite.ggplot: no visible binding for global variable + ‘Sd’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘bind_rows’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘map_df’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘map_df’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Date’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘mutate’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘walk’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘filter’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘ggplot’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘aes’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Date’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘geom_ribbon’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Lower’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Upper’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘Type’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘geom_line’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘geom_point’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘scale_fill_manual’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘alphabrown’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘alphapink’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘alphagreen’ +post.analysis.multisite.ggplot : : no visible binding for + global variable ‘alphablue’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘scale_color_manual’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘theme_bw’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘labs’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘theme’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘element_blank’ +post.analysis.multisite.ggplot : : no visible global + function definition for ‘facet_wrap’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘filter’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘ggplot’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘aes’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘geom_ribbon’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Lower’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Upper’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Type’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘geom_line’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘Means’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘geom_point’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘scale_fill_manual’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘alphabrown’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘alphapink’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘alphagreen’ +post.analysis.multisite.ggplot : : : no visible + binding for global variable ‘alphablue’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘scale_color_manual’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘theme_bw’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘labs’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘theme’ +post.analysis.multisite.ggplot : : : no visible + global function definition for ‘element_blank’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘map_dfr’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘mutate’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘coordinates<-’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘proj4string<-’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘CRS’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘spTransform’ +post.analysis.multisite.ggplot: no visible binding for global variable + ‘Site’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘ggplot’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘geom_sf’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘aes’ +post.analysis.multisite.ggplot: no visible binding for global variable + ‘NA_L1CODE’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘geom_point’ +post.analysis.multisite.ggplot: no visible binding for global variable + ‘Lon’ +post.analysis.multisite.ggplot: no visible binding for global variable + ‘Lat’ +post.analysis.multisite.ggplot: no visible binding for global variable + ‘Name’ +post.analysis.multisite.ggplot: no visible binding for global variable + ‘Data’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘scale_fill_manual’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘scale_color_manual’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘theme_minimal’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘theme’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘element_blank’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘pdf’ +post.analysis.multisite.ggplot: no visible global function definition + for ‘dev.off’ +postana.bias.plotting.sda: no visible global function definition for + ‘pdf’ +postana.bias.plotting.sda : : no visible global function + definition for ‘quantile’ +postana.bias.plotting.sda: no visible global function definition for + ‘lm’ +postana.bias.plotting.sda: no visible global function definition for + ‘plot’ +postana.bias.plotting.sda: no visible global function definition for + ‘ciEnvelope’ +postana.bias.plotting.sda: no visible binding for global variable + ‘alphabrown’ +postana.bias.plotting.sda: no visible global function definition for + ‘abline’ +postana.bias.plotting.sda: no visible global function definition for + ‘mtext’ +postana.bias.plotting.sda: no visible binding for global variable + ‘alphapurple’ +postana.bias.plotting.sda: no visible global function definition for + ‘dev.off’ +postana.bias.plotting.sda.corr: no visible global function definition + for ‘pdf’ +postana.bias.plotting.sda.corr: no visible global function definition + for ‘cov2cor’ +postana.bias.plotting.sda.corr: no visible global function definition + for ‘par’ +postana.bias.plotting.sda.corr: no visible global function definition + for ‘corrplot’ +postana.bias.plotting.sda.corr: no visible global function definition + for ‘plot’ +postana.bias.plotting.sda.corr: no visible global function definition + for ‘dev.off’ +postana.timeser.plotting.sda: no visible global function definition for + ‘pdf’ +postana.timeser.plotting.sda: no visible global function definition for + ‘%>%’ +postana.timeser.plotting.sda : : no visible global function + definition for ‘quantile’ +postana.timeser.plotting.sda: no visible global function definition for + ‘plot’ +postana.timeser.plotting.sda: no visible global function definition for + ‘ciEnvelope’ +postana.timeser.plotting.sda: no visible binding for global variable + ‘alphagreen’ +postana.timeser.plotting.sda: no visible global function definition for + ‘lines’ +postana.timeser.plotting.sda: no visible binding for global variable + ‘alphablue’ +postana.timeser.plotting.sda: no visible binding for global variable + ‘alphapink’ +postana.timeser.plotting.sda: no visible global function definition for + ‘legend’ +postana.timeser.plotting.sda: no visible global function definition for + ‘dev.off’ +Remote.Sync.launcher: no visible global function definition for + ‘read.settings’ +sample_met: no visible binding for global variable ‘host’ +sample.parameters: no visible global function definition for ‘db.query’ +sample.parameters: no visible binding for global variable ‘post.distns’ +SDA_remote_launcher: no visible global function definition for + ‘read.settings’ +SDA_remote_launcher: no visible global function definition for + ‘test_remote’ +SDA_remote_launcher: no visible global function definition for + ‘remote.execute.R’ +SDA_remote_launcher: no visible global function definition for + ‘remote.copy.to’ +SDA_remote_launcher: no visible global function definition for + ‘is.MultiSettings’ +SDA_remote_launcher: no visible global function definition for ‘%>%’ +SDA_remote_launcher: no visible global function definition for ‘map’ +SDA_remote_launcher: no visible global function definition for + ‘map_lgl’ +SDA_remote_launcher : : no visible global function + definition for ‘remote.execute.R’ +SDA_remote_launcher: no visible global function definition for ‘walk’ +SDA_remote_launcher : : no visible global function + definition for ‘remote.copy.to’ +SDA_remote_launcher: no visible global function definition for + ‘qsub_get_jobid’ +SDA_remote_launcher: no visible binding for global variable + ‘stop.on.error’ +sda.enkf: no visible global function definition for ‘%>%’ +sda.enkf: no visible binding for global variable ‘ensemble.samples’ +sda.enkf: no visible global function definition for + ‘write.ensemble.configs’ +sda.enkf: no visible global function definition for ‘cov’ +sda.enkf: no visible global function definition for ‘logger.severe’ +sda.enkf: no visible binding for global variable ‘H’ +sda.enkf: no visible global function definition for ‘rmvnorm’ +sda.enkf.multisite: no visible binding for global variable + ‘multiprocess’ +sda.enkf.multisite: no visible global function definition for ‘%>%’ +sda.enkf.multisite: no visible global function definition for ‘map’ +sda.enkf.multisite: no visible global function definition for ‘map_dfr’ +sda.enkf.multisite: no visible global function definition for ‘tail’ +sda.enkf.multisite: no visible binding for global variable + ‘ensemble.samples’ +sda.enkf.multisite : : no visible global function definition + for ‘input.ens.gen’ +sda.enkf.multisite : : no visible global function definition + for ‘write.ensemble.configs’ +sda.enkf.multisite : : no visible binding for global + variable ‘ensemble.samples’ +sda.enkf.multisite: no visible global function definition for + ‘setNames’ +sda.enkf.multisite : : no visible global function definition + for ‘%>%’ +sda.enkf.multisite : : : no visible global + function definition for ‘%>%’ +sda.enkf.multisite : : : no visible global + function definition for ‘map_df’ +sda.enkf.multisite : : no visible global function definition + for ‘setNames’ +sda.enkf.multisite: no visible global function definition for ‘map_dfc’ +sda.enkf.multisite: no visible global function definition for ‘rmvnorm’ +sda.enkf.multisite: no visible global function definition for + ‘write.csv’ +sda.enkf.original: no visible global function definition for ‘%>%’ +sda.enkf.original : : no visible global function definition + for ‘%>%’ +sda.enkf.original : : : no visible global + function definition for ‘%>%’ +sda.enkf.original: no visible global function definition for ‘db.open’ +sda.enkf.original: no visible global function definition for ‘is’ +sda.enkf.original: no visible global function definition for ‘db.close’ +sda.enkf.original: no visible global function definition for + ‘check.workflow.settings’ +sda.enkf.original: no visible global function definition for ‘db.query’ +sda.enkf.original: no visible global function definition for + ‘get.parameter.samples’ +sda.enkf.original: no visible global function definition for ‘tail’ +sda.enkf.original : wish.df: no visible global function definition for + ‘var’ +sda.enkf.original : : no visible global function definition + for ‘nimbleFunctionList’ +sda.enkf.original : : no visible binding for global variable + ‘toggle’ +sda.enkf.original : : no visible binding for global variable + ‘nested_sampler_list’ +sda.enkf.original : : no visible global function definition + for ‘returnType’ +sda.enkf.original: no visible binding for global variable ‘N’ +sda.enkf.original: no visible binding for global variable ‘YN’ +sda.enkf.original: no visible binding for global variable ‘J’ +sda.enkf.original: no visible binding for global variable ‘lambda_0’ +sda.enkf.original: no visible binding for global variable ‘nu_0’ +sda.enkf.original: no visible global function definition for ‘col2rgb’ +sda.enkf.original: no visible global function definition for ‘rgb’ +sda.enkf.original: no visible global function definition for ‘cov’ +sda.enkf.original: no visible global function definition for ‘na.omit’ +sda.enkf.original: no visible global function definition for ‘pdf’ +sda.enkf.original: no visible global function definition for ‘dev.off’ +sda.enkf.original: no visible global function definition for + ‘logger.warn’ +sda.enkf.original: no visible global function definition for ‘rnorm’ +sda.enkf.original: no visible global function definition for ‘quantile’ +sda.enkf.original: no visible global function definition for ‘rmvnorm’ +sda.enkf.original: no visible global function definition for ‘par’ +sda.enkf.original : : no visible global function definition + for ‘quantile’ +sda.enkf.original: no visible global function definition for ‘plot’ +sda.enkf.original: no visible global function definition for + ‘ciEnvelope’ +sda.enkf.original: no visible global function definition for ‘lines’ +sda.enkf.original: no visible global function definition for ‘legend’ +sda.enkf.original: no visible global function definition for ‘lm’ +sda.enkf.original: no visible global function definition for ‘abline’ +sda.enkf.original: no visible global function definition for ‘mtext’ +sda.enkf.original: no visible global function definition for + ‘tableGrob’ +sda.enkf.original: no visible global function definition for + ‘grid.arrange’ +sda.enkf.original: no visible global function definition for ‘cov2cor’ +sda.enkf.original: no visible global function definition for ‘corrplot’ +sda.particle: no visible global function definition for ‘read.output’ +sda.particle: no visible binding for global variable ‘settings’ +sda.particle: no visible global function definition for + ‘read.ensemble.ts’ +sda.particle: no visible global function definition for ‘rnorm’ +sda.particle: no visible binding for global variable ‘yrvec’ +sda.particle: no visible binding for global variable ‘mNPP’ +sda.particle: no visible binding for global variable ‘sNPP’ +sda.particle: no visible global function definition for ‘dnorm’ +sda.particle: no visible global function definition for ‘weighted.mean’ +sda.particle: no visible binding for global variable ‘quantile’ +sda.particle: no visible global function definition for ‘pdf’ +sda.particle: no visible binding for global variable ‘outfolder’ +sda.particle: no visible global function definition for ‘par’ +sda.particle: no visible global function definition for ‘plot’ +sda.particle: no visible global function definition for ‘lines’ +sda.particle: no visible global function definition for ‘legend’ +sda.particle: no visible global function definition for ‘abline’ +sda.particle: no visible global function definition for ‘hist’ +sda.particle: no visible global function definition for ‘weighted.hist’ +sda.particle: no visible global function definition for ‘dev.off’ +simple.local: no visible binding for global variable ‘rloc’ +Undefined global functions or variables: + . %>% 2.5% 97.5% abline aes alphablue alphabrown alphagreen alphapink + alphapurple alr bind_rows blocked.dis blue boxplot brown + check.workflow.settings ciEnvelope Cmcmc Cmcmc_tobit2space col2rgb + conf_tobit2space constants.tobit constants.tobit2space coordinates<- + cor corrplot cov cov2cor CRS Data data.tobit data.tobit2space Date + db.close db.open db.query dev.off dimensions.tobit direct_TRUE + distances dnorm element_blank ensemble.samples facet_wrap fcomp_TRUE + filter GEF.MultiSite.Nimble geom_jitter geom_line geom_point + geom_ribbon geom_sf geom_violin get.parameter.samples ggplot green + grid.arrange group_by H hist host input.ens.gen installed.packages is + is.MultiSettings J labs lambda_0 Lat legend lines lm logger.severe + logger.warn Lon Lower map map_chr map_dbl map_df map_dfc map_dfr + map_lgl match_pft match_species_id MCMC_iteration means Means median + mNPP modify modify_if mtext multiprocess mutate N NA_L1CODE na.omit + Name ncvar_get nested_sampler_list nH nimbleFunctionList nNotH NotH + nt nu_0 obs.mean outfolder par pdf pft.cat pft2total_TRUE pink plot + plot.new points position_dodge position_jitterdodge post.distns + proj4string<- purple q.type qq qsub_get_jobid quantile read.csv + read.ensemble.ts read.output read.settings read.table remote.copy.to + remote.execute.R returnType rgb right_join rloc Rmcmc + Rmcmc_tobit2space rmvnorm rnorm run.write.configs samplerNumberOffset + samplerNumberOffset_tobit2space scale_color_manual scale_fill_manual + Sd setNames settings Site site_id Site_ID site.ids sNPP spTransform + src_postgres stop.on.error summarise t1 tableGrob tail test_remote + theme theme_bw theme_minimal TimeElapsed title tobit.model + tobit2space_pred tobit2space.model toggle Type Upper Value var Var1 + Var2 Variable Variables walk weighted.hist weighted.mean write.csv + write.ensemble.configs write.table X X_direct_end X_direct_start + X_fcomp_end X_fcomp_model_end X_fcomp_model_start X_fcomp_start + X_pft2total_model_end X_pft2total_model_start X_pft2total_start X.mod + y_star_create y_star_create_pft2total YN yrvec +Consider adding + importFrom("graphics", "abline", "boxplot", "hist", "legend", "lines", + "mtext", "par", "plot", "plot.new", "points", "title") + importFrom("grDevices", "col2rgb", "dev.off", "pdf", "rgb") + importFrom("methods", "is") + importFrom("stats", "cor", "cov", "cov2cor", "dnorm", "filter", "lm", + "median", "na.omit", "quantile", "rnorm", "setNames", "var", + "weighted.mean") + importFrom("utils", "installed.packages", "read.csv", "read.table", + "tail", "write.csv", "write.table") +to your NAMESPACE file (and ensure that your DESCRIPTION Imports field +contains 'methods'). + +Found the following assignments to the global environment: +File ‘PEcAn.assim.sequential/R/Analysis_sda_multiSite.R’: + assign(name, dots[[name]], pos = 1) +File ‘PEcAn.assim.sequential/R/Analysis_sda.R’: + assign(name, dots[[name]], pos = 1) +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'Contruct.Pf' + ‘t’ ‘blocked.dis’ ‘...’ + +Undocumented arguments in documentation object 'EnKF.MultiSite' + ‘setting’ +Documented arguments not in \usage in documentation object 'EnKF.MultiSite': + ‘settings’ + +Undocumented arguments in documentation object 'EnKF' + ‘setting’ +Documented arguments not in \usage in documentation object 'EnKF': + ‘settings’ + +Undocumented arguments in documentation object 'GEF' + ‘H’ ‘setting’ + +Undocumented arguments in documentation object 'SDA_remote_launcher' + ‘run.bash.args’ + +Undocumented arguments in documentation object 'hop_test' + ‘ens.runid’ + +Undocumented arguments in documentation object 'interactive.plotting.sda' + ‘obs.times’ ‘aqq’ ‘bqq’ ‘facetg’ ‘readsFF’ +Documented arguments not in \usage in documentation object 'interactive.plotting.sda': + ‘obs.time’ + +Undocumented arguments in documentation object 'sda.enkf' + ‘...’ +Duplicated \argument entries in documentation object 'sda.enkf': + ‘settings’ ‘obs.mean’ ‘obs.cov’ ‘Q’ ‘restart’ + +Undocumented arguments in documentation object 'sda.enkf.multisite' + ‘...’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking examples ... NONE +* DONE +Status: 2 WARNINGs, 1 NOTE diff --git a/modules/assim.sequential/tests/testthat/ignore b/modules/assim.sequential/tests/testthat/ignore deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/modules/assim.sequential/tests/testthat/test_rescaling.R b/modules/assim.sequential/tests/testthat/test_rescaling.R new file mode 100644 index 00000000000..8b75dda758d --- /dev/null +++ b/modules/assim.sequential/tests/testthat/test_rescaling.R @@ -0,0 +1,75 @@ + +settings <- list( + state.data.assimilation = list( + state.variables = list( + variable = list(variable.name = "a", scaling_factor = 1), + variable = list(variable.name = "b", scaling_factor = 2), + variable = list(variable.name = "c", scaling_factor = 3), + variable = list(variable.name = "z", scaling_factor = 0)))) + +mkdata <- function(...) { + as.matrix(data.frame(...)) +} + +test_that("returns input where no scaling specified", { + expect_identical( + rescaling_stateVars(list(), 1L), + 1L) + + unscalable <- mkdata(d = 1, e = 1) + expect_identical( + rescaling_stateVars(settings, unscalable), + unscalable) + + partly_scaleable <- mkdata(c = 10, d = 10) + expect_equal( + rescaling_stateVars(settings, partly_scaleable), + partly_scaleable * c(3, 1)) +}) + +test_that("multiplies or divides as requested", { + expect_equal( + rescaling_stateVars( + settings, + mkdata(a = 1:3, b = 1:3, c = 1:3)), + mkdata(a = (1:3) * 1, b = (1:3) * 2, c = (1:3) * 3)) + expect_equal( + rescaling_stateVars( + settings, + mkdata(a = 1:3, b = 1:3, c = 1:3), + multiply = FALSE), + mkdata(a = (1:3) / 1, b = (1:3) / 2, c = (1:3) / 3)) +}) + +test_that("handles zeroes in data", { + expect_equal( + rescaling_stateVars(settings, mkdata(c = 0)), + mkdata(c = 0)) + expect_equal( + rescaling_stateVars(settings, mkdata(c = 0), multiply = FALSE), + mkdata(c = 0)) +}) + +test_that("handles zeroes in scalars", { + expect_equal( + rescaling_stateVars(settings, mkdata(z = 10)), + mkdata(z = 0)) + expect_equal( + rescaling_stateVars(settings, mkdata(z = 10), multiply = FALSE), + mkdata(z = Inf)) +}) + +test_that("retains attributes", { + x_attrs <- mkdata(b = 1:3) + attr(x_attrs, "site") <- "foo" + + expect_identical( + attr(rescaling_stateVars(settings, x_attrs), "site"), + "foo") +}) + +test_that("accepts data frames", { + expect_equal( + rescaling_stateVars(settings, data.frame(b = 2:4)), + data.frame(b = (2:4) * 2)) +}) diff --git a/modules/benchmark/DESCRIPTION b/modules/benchmark/DESCRIPTION index 1d74411002c..28b2b776549 100644 --- a/modules/benchmark/DESCRIPTION +++ b/modules/benchmark/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAn.benchmark Type: Package Title: PEcAn functions used for benchmarking -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("David","LeBauer"), person("Rob","Kooper"), @@ -15,28 +15,32 @@ Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific streamline the interaction between data and models, and to improve the efficacy of scientific investigation. Imports: - PEcAn.data.land, + dbplyr, + dplyr, + ggplot2, + gridExtra, + lubridate (>= 1.6.0), + magrittr, + ncdf4 (>= 1.15), PEcAn.DB, PEcAn.logger, PEcAn.remote, PEcAn.settings, PEcAn.utils, - lubridate (>= 1.6.0), - ncdf4 (>= 1.15), - udunits2 (>= 0.11), - XML (>= 3.98-1.4), - dplyr, - ggplot2, - gridExtra, reshape2, - dbplyr, SimilarityMeasures, - zoo + stringr, + tidyselect, + udunits2 (>= 0.11), + XML (>= 3.98-1.4), + zoo Suggests: - testthat (>= 2.0.0) -License: FreeBSD + file LICENSE + PEcAn.data.land, + testthat (>= 2.0.0), + BrownDog +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/benchmark/NAMESPACE b/modules/benchmark/NAMESPACE index cc43c3d919b..b36226c444d 100644 --- a/modules/benchmark/NAMESPACE +++ b/modules/benchmark/NAMESPACE @@ -44,3 +44,4 @@ importFrom(ggplot2,geom_path) importFrom(ggplot2,geom_point) importFrom(ggplot2,ggplot) importFrom(ggplot2,labs) +importFrom(magrittr,"%>%") diff --git a/modules/benchmark/R/calc_benchmark.R b/modules/benchmark/R/calc_benchmark.R index 7e29eba2051..dce38763776 100644 --- a/modules/benchmark/R/calc_benchmark.R +++ b/modules/benchmark/R/calc_benchmark.R @@ -28,7 +28,7 @@ calc_benchmark <- function(settings, bety, start_year = NA, end_year = NA) { # Retrieve/create benchmark ensemble database record bm.ensemble <- tbl(bety,'benchmarks_ensembles') %>% filter(reference_run_id == settings$benchmarking$reference_run_id, - ensemble_id == ensemble$id, + ensemble_id %in% ensemble$id, # ensemble$id has more than one element model_id == settings$model$id) %>% collect() @@ -98,10 +98,11 @@ calc_benchmark <- function(settings, bety, start_year = NA, end_year = NA) { obvs <- load_data(data.path, format, start_year = start_year, end_year = end_year, site, vars.used.index, time.row) dat_vars <- format$vars$pecan_name # IF : is this line redundant? obvs_full <- obvs - + # ---- LOAD MODEL DATA ---- # - model_vars <- format$vars$pecan_name[-time.row] # IF : what will happen when time.row is NULL? + #model_vars <- format$vars$pecan_name[-time.row] # IF : what will happen when time.row is NULL? + model_vars <- format$vars$pecan_name # time.row is NULL # For example 'AmeriFlux.level2.h.nc' format (38) has time vars year-day-hour listed, # but storage type column is empty and it should be because in load_netcdf we extract # the time from netcdf files using the time dimension we can remove time variables from diff --git a/modules/benchmark/R/load_data.R b/modules/benchmark/R/load_data.R index b3c882e41b4..a534cd74950 100644 --- a/modules/benchmark/R/load_data.R +++ b/modules/benchmark/R/load_data.R @@ -9,6 +9,7 @@ ##' @author Betsy Cowdery, Istem Fer, Joshua Mantooth ##' Generic function to convert input files containing observational data to ##' a common PEcAn format. +#' @importFrom magrittr %>% load_data <- function(data.path, format, start_year = NA, end_year = NA, site = NA, vars.used.index=NULL, ...) { @@ -30,12 +31,6 @@ load_data <- function(data.path, format, start_year = NA, end_year = NA, site = vars.used.index <- setdiff(seq_along(format$vars$variable_id), format$time.row) } - library(PEcAn.utils) - library(PEcAn.benchmark) - library(lubridate) - library(udunits2) - library(dplyr) - # Determine the function that should be used to load the data mimetype <- gsub("-", "_", format$mimetype) fcn1 <- paste0("load_", format$file_name) @@ -44,13 +39,13 @@ load_data <- function(data.path, format, start_year = NA, end_year = NA, site = fcn <- match.fun(fcn1) } else if (exists(fcn2)) { fcn <- match.fun(fcn2) - } else if (!exists(fcn1) & !exists(fcn2) & require(bd)) { + } else if (!exists(fcn1) & !exists(fcn2) & requireNamespace("BrownDog", quietly = TRUE)) { #To Do: call to DAP to see if conversion to csv is possible #Brown Dog API call through BDFiddle, requires username and password - key <- get_key("https://bd-api.ncsa.illinois.edu",username,password) - token <- get_token("https://bd-api.ncsa.illinois.edu",key) + key <- BrownDog::get_key("https://bd-api.ncsa.illinois.edu",username,password) + token <- BrownDog::get_token("https://bd-api.ncsa.illinois.edu",key) #output_path = where are we putting converted file? - converted.data.path <- convert_file(url = "https://bd-api.ncsa.illinois.edu", input_filename = data.path, + converted.data.path <- BrownDog::convert_file(url = "https://bd-api.ncsa.illinois.edu", input_filename = data.path, output = "csv", output_path = output_path, token = token) if (is.na(converted.data.path)){ PEcAn.logger::logger.error("Converted file was not returned from Brown Dog") @@ -94,11 +89,11 @@ load_data <- function(data.path, format, start_year = NA, end_year = NA, site = vars_used$pecan_name[i], vars_used$pecan_units[i])) out[col] <- udunits2::ud.convert(as.numeric(x), u1, u2) colnames(out)[col] <- vars_used$pecan_name[i] - } else if (misc.are.convertible(u1, u2)) { + } else if (PEcAn.utils::misc.are.convertible(u1, u2)) { print(sprintf("convert %s %s to %s %s", vars_used$input_name[i], u1, vars_used$pecan_name[i], u2)) - out[col] <- as.vector(misc.convert(x, u1, u2)) # Betsy: Adding this because misc.convert returns vector with attributes original agrument x, which causes problems later + out[col] <- as.vector(PEcAn.utils::misc.convert(x, u1, u2)) # Betsy: Adding this because misc.convert returns vector with attributes original agrument x, which causes problems later colnames(out)[col] <- vars_used$pecan_name[i] } else { PEcAn.logger::logger.warn(paste("Units cannot be converted. Removing variable. please check the units of",vars_used$input_name[i])) @@ -115,7 +110,7 @@ load_data <- function(data.path, format, start_year = NA, end_year = NA, site = names(out)[col] <- format$vars$pecan_name[time.row] # Need a much more spohisticated approach to converting into time format. - y <- dplyr::select(out, one_of(format$vars$pecan_name[time.row])) + y <- dplyr::select(out, tidyselect::one_of(format$vars$pecan_name[time.row])) if(!is.null(site$time_zone)){ tz = site$time_zone @@ -145,4 +140,3 @@ load_data <- function(data.path, format, start_year = NA, end_year = NA, site = return(out) } # load_data - diff --git a/modules/benchmark/R/load_netcdf.R b/modules/benchmark/R/load_netcdf.R index 9ffbbe01197..6b77b5df077 100644 --- a/modules/benchmark/R/load_netcdf.R +++ b/modules/benchmark/R/load_netcdf.R @@ -9,40 +9,31 @@ ##' @param vars character ##' @author Istem Fer load_x_netcdf <- function(data.path, format, site, vars = NULL) { - data.path <- sapply(data.path, function(x) dir(dirname(x), basename(x), full.names = TRUE)) - nc <- lapply(data.path, ncdf4::nc_open) - dat <- list() for (ind in seq_along(vars)) { nc.dat <- lapply(nc, ncdf4::ncvar_get, vars[ind]) dat[vars[ind]] <- as.data.frame(unlist(nc.dat)) } - dat <- as.matrix(as.data.frame(dat)) - # we need to replace filling/missing values with NA now we don't want these values to go into unit # conversion dat[dat %in% as.numeric(format$na.strings)] <- NA dat <- as.data.frame(dat) colnames(dat) <- vars - # deal with time time.col <- list() for (i in seq_along(nc)) { dims <- names(nc[[i]]$dim) time.var <- grep(pattern = "time", dims, ignore.case = TRUE) time.col[[i]] <- ncdf4::ncvar_get(nc[[i]], dims[time.var]) - t.units <- ncdf4::ncatt_get(nc[[i]], dims[time.var])$units - # If the unit has if of the form * since YYYY-MM-DD * with "-hour" timezone offset # This is a feature of the met produced by met2CF - if(str_detect(t.units, "ince\\s[0-9]{4}[.-][0-9]{2}[.-][0-9]{2}.*\\s-\\d+")){ - unit2 <- str_split_fixed(t.units,"\\s-",2)[1] - offset <- str_split_fixed(t.units,"\\s-",2)[2] %>% as.numeric() - + if(stringr::str_detect(t.units, "ince\\s[0-9]{4}[.-][0-9]{2}[.-][0-9]{2}.*\\s-\\d+")){ + unit2 <- stringr::str_split_fixed(t.units,"\\s-",2)[1] + offset <- stringr::str_split_fixed(t.units,"\\s-",2)[2] %>% as.numeric() date_time <- suppressWarnings(try(lubridate::ymd((unit2)))) if(is.na(date_time)){ date_time <- suppressWarnings(try(lubridate::ymd_hms(unit2))) @@ -50,14 +41,22 @@ load_x_netcdf <- function(data.path, format, site, vars = NULL) { if(is.na(date_time)){ PEcAn.logger::logger.error("All time formats failed to parse. No formats found.") } - - t.units <- paste(str_split_fixed(t.units," since",2)[1], "since", + t.units <- paste(stringr::str_split_fixed(t.units," since",2)[1], "since", date_time - lubridate::hms(paste(offset,":00:00"))) + }else if(stringr::str_detect(t.units, "ince\\s[0-9]{4}[.-][0-9]{2}[.-][0-9]{2}.*")){ + unit2 <- stringr::str_split_fixed(t.units,"\\s-",2)[1] + date_time <- suppressWarnings(try(lubridate::ymd((unit2)))) + if(is.na(date_time)){ + date_time <- suppressWarnings(try(lubridate::ymd_hms(unit2))) + } + if(is.na(date_time)){ + PEcAn.logger::logger.error("All time formats failed to parse. No formats found.") + } + t.units <- paste(stringr::str_split_fixed(t.units," since",2)[1], "since", + date_time) } - # for heterogenous formats try parsing ymd_hms date.origin <- suppressWarnings(try(lubridate::ymd_hms(t.units))) - # parsing ymd if (is.na(date.origin)) { date.origin <- lubridate::ymd(t.units) @@ -66,26 +65,20 @@ load_x_netcdf <- function(data.path, format, site, vars = NULL) { if (is.na(date.origin)) { PEcAn.logger::logger.error("All time formats failed to parse. No formats found.") } - - time.stamp.match <- gsub("UTC", "", date.origin) t.units <- gsub(paste0(" since ", time.stamp.match, ".*"), "", t.units) - # need to change system TZ otherwise, lines below keeps writing in the current time zone Sys.setenv(TZ = 'UTC') foo <- as.POSIXct(date.origin, tz = "UTC") + udunits2::ud.convert(time.col[[i]], t.units, "seconds") time.col[[i]] <- foo } - # needed to use 'round' to 'mins' here, otherwise I end up with values like '2006-12-31 23:29:59' # while reading Ameriflux for example however the model timesteps are more regular and the last # value can be '2006-12-31 23:30:00'.. this will result in cutting the last value in the # align_data step dat$posix <- round(as.POSIXct(do.call("c", time.col), tz = "UTC"), "mins") dat$posix <- as.POSIXct(dat$posix) - lapply(nc, ncdf4::nc_close) - return(dat) } # load_x_netcdf diff --git a/modules/benchmark/R/metric_timeseries_plot.R b/modules/benchmark/R/metric_timeseries_plot.R index f32d08b6898..a35dc007c3f 100644 --- a/modules/benchmark/R/metric_timeseries_plot.R +++ b/modules/benchmark/R/metric_timeseries_plot.R @@ -13,7 +13,7 @@ metric_timeseries_plot <- function(metric_dat, var, filename = NA, draw.plot = i # Attempt at getting around the fact that time can be annual and thus as.Date won't work date.time <- try(as.Date(metric_dat$time), silent = TRUE) - if (class(date.time) == "try-error"){ + if (inherits(date.time, "try-error")) { PEcAn.logger::logger.warn("Can't coerce time column to Date format, attempting plot anyway") }else{ metric_dat$time <- date.time diff --git a/modules/benchmark/inst/scripts/benchmark.workflow.FATES_BCI.R b/modules/benchmark/inst/scripts/benchmark.workflow.FATES_BCI.R index 2c2d47e08dc..7697cd65205 100644 --- a/modules/benchmark/inst/scripts/benchmark.workflow.FATES_BCI.R +++ b/modules/benchmark/inst/scripts/benchmark.workflow.FATES_BCI.R @@ -28,7 +28,7 @@ settings <- PEcAn.settings::read.settings(settings.file) input_id <- 1000011171 ## 4) Edit Input to associate File ## 5) Verify that PEcAn is able to find and load file -input <- PEcAn.DB::query.file.path(input_id,host_name = "localhost",con = bety$con) +input <- PEcAn.DB::query.file.path(input_id,host_name = "localhost",con = bety) format <- PEcAn.DB::query.format.vars(bety,input_id) field <- PEcAn.benchmark::load_data(input,format) ## 6) Look up variable_id in database diff --git a/modules/benchmark/man/align_data_to_data_pft.Rd b/modules/benchmark/man/align_data_to_data_pft.Rd index 1c7ce89363f..68961121c3b 100644 --- a/modules/benchmark/man/align_data_to_data_pft.Rd +++ b/modules/benchmark/man/align_data_to_data_pft.Rd @@ -4,8 +4,15 @@ \alias{align_data_to_data_pft} \title{align_data_to_data_pft} \usage{ -align_data_to_data_pft(con, observation_one, observation_two, - custom_table = NULL, format_one, format_two, subset_is_ok = FALSE) +align_data_to_data_pft( + con, + observation_one, + observation_two, + custom_table = NULL, + format_one, + format_two, + subset_is_ok = FALSE +) } \arguments{ \item{con}{database connection} diff --git a/modules/benchmark/man/align_pft.Rd b/modules/benchmark/man/align_pft.Rd index 97bc0cd474c..407af6a61bd 100644 --- a/modules/benchmark/man/align_pft.Rd +++ b/modules/benchmark/man/align_pft.Rd @@ -4,9 +4,17 @@ \alias{align_pft} \title{align_pft} \usage{ -align_pft(con, observation_one, observation_two, custom_table = NULL, - format_one, format_two, subset_is_ok = FALSE, - comparison_type = "data_to_data", ...) +align_pft( + con, + observation_one, + observation_two, + custom_table = NULL, + format_one, + format_two, + subset_is_ok = FALSE, + comparison_type = "data_to_data", + ... +) } \arguments{ \item{con}{database connection} diff --git a/modules/benchmark/man/load_data.Rd b/modules/benchmark/man/load_data.Rd index a3d17267db6..70bfbd5993e 100644 --- a/modules/benchmark/man/load_data.Rd +++ b/modules/benchmark/man/load_data.Rd @@ -4,8 +4,15 @@ \alias{load_data} \title{load_data} \usage{ -load_data(data.path, format, start_year = NA, end_year = NA, - site = NA, vars.used.index = NULL, ...) +load_data( + data.path, + format, + start_year = NA, + end_year = NA, + site = NA, + vars.used.index = NULL, + ... +) } \arguments{ \item{data.path}{character} diff --git a/modules/benchmark/man/metric_residual_plot.Rd b/modules/benchmark/man/metric_residual_plot.Rd index 8ab1404c172..9583f352ab7 100644 --- a/modules/benchmark/man/metric_residual_plot.Rd +++ b/modules/benchmark/man/metric_residual_plot.Rd @@ -4,8 +4,12 @@ \alias{metric_residual_plot} \title{Residual Plot} \usage{ -metric_residual_plot(metric_dat, var, filename = NA, - draw.plot = is.na(filename)) +metric_residual_plot( + metric_dat, + var, + filename = NA, + draw.plot = is.na(filename) +) } \arguments{ \item{draw.plot}{} diff --git a/modules/benchmark/man/metric_scatter_plot.Rd b/modules/benchmark/man/metric_scatter_plot.Rd index ea0d94046f1..46f8a6d22f0 100644 --- a/modules/benchmark/man/metric_scatter_plot.Rd +++ b/modules/benchmark/man/metric_scatter_plot.Rd @@ -4,8 +4,12 @@ \alias{metric_scatter_plot} \title{Scatter Plot} \usage{ -metric_scatter_plot(metric_dat, var, filename = NA, - draw.plot = is.na(filename)) +metric_scatter_plot( + metric_dat, + var, + filename = NA, + draw.plot = is.na(filename) +) } \arguments{ \item{draw.plot}{} diff --git a/modules/benchmark/man/metric_timeseries_plot.Rd b/modules/benchmark/man/metric_timeseries_plot.Rd index 3159de25b6d..89b647ff561 100644 --- a/modules/benchmark/man/metric_timeseries_plot.Rd +++ b/modules/benchmark/man/metric_timeseries_plot.Rd @@ -4,8 +4,12 @@ \alias{metric_timeseries_plot} \title{Timeseries Plot} \usage{ -metric_timeseries_plot(metric_dat, var, filename = NA, - draw.plot = is.na(filename)) +metric_timeseries_plot( + metric_dat, + var, + filename = NA, + draw.plot = is.na(filename) +) } \description{ Timeseries Plot diff --git a/modules/benchmark/tests/Rcheck_reference.log b/modules/benchmark/tests/Rcheck_reference.log new file mode 100644 index 00000000000..85302e96c4c --- /dev/null +++ b/modules/benchmark/tests/Rcheck_reference.log @@ -0,0 +1,371 @@ +* using log directory ‘/tmp/RtmppGOd8Z/PEcAn.benchmark.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-manual --as-cran’ +* checking for file ‘PEcAn.benchmark/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.benchmark’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.benchmark’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'library' or 'require' calls not declared from: + ‘bd’ ‘dplyr’ ‘lubridate’ ‘PEcAn.utils’ ‘udunits2’ +'library' or 'require' calls in package code: + ‘bd’ ‘dplyr’ ‘lubridate’ ‘PEcAn.utils’ ‘udunits2’ + Please use :: or requireNamespace() instead. + See section 'Suggested packages' in the 'Writing R Extensions' manual. +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +Warning: : ... may be used in an incorrect context: ‘Set_Bench(...)’ + +Warning: : ... may be used in an incorrect context: ‘Compare_Bench(...)’ + +add_workflow_info: no visible global function definition for + ‘is.MultiSettings’ +add_workflow_info: no visible global function definition for ‘papply’ +add_workflow_info: no visible binding for global variable + ‘add_workflow_id’ +add_workflow_info: no visible global function definition for ‘%>%’ +add_workflow_info: no visible binding for global variable ‘id’ +add_workflow_info: no visible binding for global variable ‘workflow_id’ +add_workflow_info: no visible binding for global variable ‘.’ +align_data: possible error in round(obvs.calc$posix, units = + coarse.unit): unused argument (units = coarse.unit) +align_data: possible error in round(model.calc$posix, units = + coarse.unit): unused argument (units = coarse.unit) +align_data: no visible global function definition for ‘%>%’ +align_data: no visible binding for global variable ‘.’ +align_data: no visible binding for global variable ‘round.posix’ +align_data: no visible global function definition for ‘one_of’ +align_data_to_data_pft: no visible global function definition for + ‘logger.severe’ +bm_settings2pecan_settings: no visible global function definition for + ‘is.MultiSettings’ +bm_settings2pecan_settings: no visible global function definition for + ‘papply’ +calc_benchmark: no visible global function definition for ‘%>%’ +calc_benchmark: no visible binding for global variable ‘workflow_id’ +calc_benchmark: no visible binding for global variable + ‘reference_run_id’ +calc_benchmark: no visible binding for global variable ‘ensemble_id’ +calc_benchmark: no visible binding for global variable ‘model_id’ +calc_benchmark: no visible global function definition for ‘db.query’ +calc_benchmark: no visible binding for global variable ‘id’ +calc_benchmark: no visible global function definition for ‘left_join’ +calc_benchmark: no visible global function definition for ‘one_of’ +calc_benchmark: no visible binding for global variable ‘benchmark_id’ +calc_benchmark: no visible global function definition for ‘read.output’ +calc_benchmark: no visible binding for global variable ‘variable_id’ +calc_benchmark: no visible binding for global variable ‘.’ +calc_benchmark: no visible binding for global variable ‘metric’ +calc_benchmark: no visible binding for global variable + ‘benchmarks_ensemble_id’ +calc_benchmark: no visible binding for global variable ‘metric_id’ +calc_benchmark: no visible global function definition for ‘pdf’ +calc_benchmark: no visible global function definition for ‘dev.off’ +calc_metrics: no visible global function definition for ‘tail’ +check_BRR: no visible global function definition for ‘%>%’ +check_BRR: no visible binding for global variable ‘settings’ +clean_settings_BRR: no visible global function definition for + ‘is.MultiSettings’ +clean_settings_BRR: no visible global function definition for + ‘logger.error’ +create_BRR: no visible global function definition for ‘%>%’ +create_BRR: no visible binding for global variable ‘.’ +create_BRR: no visible binding for global variable ‘id’ +define_benchmark: no visible global function definition for + ‘is.MultiSettings’ +define_benchmark: no visible global function definition for ‘papply’ +define_benchmark: no visible global function definition for ‘%>%’ +define_benchmark: no visible binding for global variable ‘id’ +define_benchmark: no visible binding for global variable ‘ensemble_id’ +define_benchmark: no visible global function definition for ‘left_join’ +define_benchmark: no visible binding for global variable ‘.’ +define_benchmark: no visible global function definition for + ‘logger.error’ +define_benchmark: no visible global function definition for + ‘logger.debug’ +define_benchmark: no visible global function definition for ‘pull’ +define_benchmark: no visible binding for global variable ‘input_id’ +define_benchmark: no visible binding for global variable ‘variable_id’ +define_benchmark: no visible global function definition for ‘db.query’ +define_benchmark: no visible binding for global variable ‘benchmark_id’ +define_benchmark: no visible binding for global variable + ‘reference_run_id’ +define_benchmark: no visible binding for global variable ‘metric_id’ +get_species_list_standard: no visible binding for global variable + ‘custom_table’ +get_species_list_standard: no visible global function definition for + ‘logger.warn’ +load_csv: no visible global function definition for ‘read.csv’ +load_csv: no visible binding for global variable ‘header’ +load_csv: no visible global function definition for ‘one_of’ +load_data: no visible global function definition for ‘get_key’ +load_data: no visible binding for global variable ‘username’ +load_data: no visible binding for global variable ‘password’ +load_data: no visible global function definition for ‘get_token’ +load_data: no visible global function definition for ‘convert_file’ +load_data: no visible binding for global variable ‘output_path’ +load_data: no visible global function definition for + ‘misc.are.convertible’ +load_data: no visible global function definition for ‘misc.convert’ +load_data: no visible global function definition for ‘one_of’ +load_data: no visible global function definition for ‘%>%’ +load_data: no visible binding for global variable ‘.’ +load_data: no visible binding for global variable ‘year’ +load_rds: no visible global function definition for ‘one_of’ +load_tab_separated_values: no visible global function definition for + ‘read.table’ +load_tab_separated_values: no visible binding for global variable + ‘header’ +load_tab_separated_values: no visible global function definition for + ‘one_of’ +load_x_netcdf: no visible global function definition for ‘str_detect’ +load_x_netcdf: no visible global function definition for + ‘str_split_fixed’ +load_x_netcdf: no visible global function definition for ‘%>%’ +match_timestep: no visible global function definition for ‘head’ +metric_cor: no visible global function definition for ‘cor’ +metric_Frechet: no visible global function definition for ‘logger.info’ +metric_Frechet: no visible global function definition for ‘na.omit’ +metric_lmDiag_plot: no visible global function definition for ‘lm’ +metric_lmDiag_plot: no visible global function definition for ‘aes’ +metric_lmDiag_plot: no visible binding for global variable ‘.fitted’ +metric_lmDiag_plot: no visible binding for global variable ‘.resid’ +metric_lmDiag_plot: no visible global function definition for ‘qqnorm’ +metric_lmDiag_plot: no visible binding for global variable ‘.stdresid’ +metric_lmDiag_plot: no visible global function definition for ‘qqline’ +metric_lmDiag_plot: no visible binding for global variable ‘.cooksd’ +metric_lmDiag_plot: no visible binding for global variable ‘.hat’ +metric_lmDiag_plot: no visible global function definition for ‘pdf’ +metric_lmDiag_plot: no visible global function definition for ‘plot’ +metric_lmDiag_plot: no visible global function definition for ‘dev.off’ +metric_PPMC: no visible global function definition for ‘cor’ +metric_R2: no visible global function definition for ‘lm’ +metric_RAE: no visible global function definition for ‘na.omit’ +metric_residual_plot: no visible binding for global variable ‘time’ +metric_residual_plot: no visible global function definition for ‘aes’ +metric_residual_plot: no visible binding for global variable ‘zeros’ +metric_residual_plot: no visible global function definition for ‘pdf’ +metric_residual_plot: no visible global function definition for ‘plot’ +metric_residual_plot: no visible global function definition for + ‘dev.off’ +metric_scatter_plot: no visible global function definition for ‘aes’ +metric_scatter_plot: no visible binding for global variable ‘model’ +metric_scatter_plot: no visible binding for global variable ‘obvs’ +metric_scatter_plot: no visible global function definition for ‘pdf’ +metric_scatter_plot: no visible global function definition for ‘plot’ +metric_scatter_plot: no visible global function definition for + ‘dev.off’ +metric_timeseries_plot: no visible global function definition for ‘aes’ +metric_timeseries_plot: no visible binding for global variable ‘time’ +metric_timeseries_plot: no visible binding for global variable ‘model’ +metric_timeseries_plot: no visible binding for global variable ‘obvs’ +metric_timeseries_plot: no visible global function definition for ‘pdf’ +metric_timeseries_plot: no visible global function definition for + ‘plot’ +metric_timeseries_plot: no visible global function definition for + ‘dev.off’ +pecan_bench: no visible global function definition for + ‘validation_check’ +pecan_bench: no visible global function definition for ‘read.table’ +pecan_bench: no visible global function definition for ‘size’ +pecan_bench: no visible binding for global variable ‘comp_value’ +pecan_bench: no visible binding for global variable + ‘comp_dif_uncertainty’ +pecan_bench: no visible binding for global variable + ‘ratio_dif_uncertainty’ +pecan_bench: no visible binding for global variable ‘ratio_dif’ +pecan_bench: no visible global function definition for ‘Set_Bench’ +pecan_bench: ... may be used in an incorrect context: ‘Set_Bench(...)’ +pecan_bench: no visible global function definition for ‘Compare_Bench’ +pecan_bench: ... may be used in an incorrect context: + ‘Compare_Bench(...)’ +read_settings_BRR: no visible global function definition for ‘%>%’ +read_settings_BRR: no visible binding for global variable ‘id’ +read_settings_BRR: no visible global function definition for ‘pull’ +read_settings_BRR: no visible global function definition for + ‘xmlToList’ +read_settings_BRR: no visible binding for global variable ‘.’ +Undefined global functions or variables: + . .cooksd .fitted .hat .resid .stdresid %>% add_workflow_id aes + benchmark_id benchmarks_ensemble_id comp_dif_uncertainty comp_value + Compare_Bench convert_file cor custom_table db.query dev.off + ensemble_id get_key get_token head header id input_id + is.MultiSettings left_join lm logger.debug logger.error logger.info + logger.severe logger.warn metric metric_id misc.are.convertible + misc.convert model model_id na.omit obvs one_of output_path papply + password pdf plot pull qqline qqnorm ratio_dif ratio_dif_uncertainty + read.csv read.output read.table reference_run_id round.posix + Set_Bench settings size str_detect str_split_fixed tail time username + validation_check variable_id workflow_id xmlToList year zeros +Consider adding + importFrom("graphics", "plot") + importFrom("grDevices", "dev.off", "pdf") + importFrom("stats", "cor", "lm", "na.omit", "qqline", "qqnorm", "time") + importFrom("utils", "head", "read.csv", "read.table", "tail") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... NOTE +Rd file 'align_by_first_observation.Rd': + \examples lines wider than 100 characters: + aligned<-align_by_first_observation(observation_one = observation_one, observation_two = observation_two, + +These lines will be truncated in the PDF manual. +* checking Rd cross-references ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'align_data' + ‘align_method’ + +Undocumented arguments in documentation object 'align_pft' + ‘comparison_type’ ‘...’ + +Undocumented arguments in documentation object 'calc_benchmark' + ‘settings’ ‘start_year’ ‘end_year’ +Documented arguments not in \usage in documentation object 'calc_benchmark': + ‘bm.ensemble’ + +Undocumented arguments in documentation object 'check_if_legal_table' + ‘table’ +Documented arguments not in \usage in documentation object 'check_if_legal_table': + ‘custom_table’ + +Undocumented arguments in documentation object 'check_if_list_of_pfts' + ‘vars’ +Documented arguments not in \usage in documentation object 'check_if_list_of_pfts': + ‘observation_one’ ‘observation_two’ ‘custom_table’ + +Undocumented arguments in documentation object 'check_if_species_list' + ‘vars’ +Documented arguments not in \usage in documentation object 'check_if_species_list': + ‘observation_one’ ‘observation_two’ + +Undocumented arguments in documentation object 'create_BRR' + ‘user_id’ + +Undocumented arguments in documentation object 'define_benchmark' + ‘settings’ ‘bety’ +Documented arguments not in \usage in documentation object 'define_benchmark': + ‘bm.settings’ + +Undocumented arguments in documentation object 'format_wide2long' + ‘time.row’ + +Undocumented arguments in documentation object 'get_species_list_standard' + ‘vars’ +Documented arguments not in \usage in documentation object 'get_species_list_standard': + ‘observation_one’ ‘observation_two’ ‘custom_table’ + +Undocumented arguments in documentation object 'load_csv' + ‘vars’ +Documented arguments not in \usage in documentation object 'load_csv': + ‘start_year’ ‘end_year’ + +Undocumented arguments in documentation object 'load_data' + ‘vars.used.index’ ‘...’ + +Undocumented arguments in documentation object 'load_tab_separated_values' + ‘vars’ +Documented arguments not in \usage in documentation object 'load_tab_separated_values': + ‘start_year’ ‘end_year’ + +Documented arguments not in \usage in documentation object 'load_x_netcdf': + ‘start_year’ ‘end_year’ + +Undocumented arguments in documentation object 'metric_AME' + ‘...’ + +Undocumented arguments in documentation object 'metric_Frechet' + ‘...’ + +Undocumented arguments in documentation object 'metric_MAE' + ‘...’ + +Undocumented arguments in documentation object 'metric_MSE' + ‘...’ + +Undocumented arguments in documentation object 'metric_PPMC' + ‘...’ + +Undocumented arguments in documentation object 'metric_R2' + ‘...’ + +Undocumented arguments in documentation object 'metric_RAE' + ‘...’ + +Undocumented arguments in documentation object 'metric_RMSE' + ‘...’ + +Undocumented arguments in documentation object 'metric_cor' + ‘...’ + +Undocumented arguments in documentation object 'metric_lmDiag_plot' + ‘var’ ‘filename’ ‘draw.plot’ + +Undocumented arguments in documentation object 'metric_residual_plot' + ‘metric_dat’ ‘var’ ‘filename’ + +Undocumented arguments in documentation object 'metric_scatter_plot' + ‘metric_dat’ ‘var’ ‘filename’ + +Undocumented arguments in documentation object 'metric_timeseries_plot' + ‘metric_dat’ ‘var’ ‘filename’ ‘draw.plot’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'format_wide2long': + ‘vars_used’ + +Argument items with no description in Rd object 'load_rds': + ‘vars’ + +Argument items with no description in Rd object 'metric_residual_plot': + ‘draw.plot’ + +Argument items with no description in Rd object 'metric_scatter_plot': + ‘draw.plot’ + +* checking for unstated dependencies in examples ... OK +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... + OK +* DONE +Status: 3 WARNINGs, 3 NOTEs diff --git a/modules/benchmark/tests/testthat/test-align_pft.R b/modules/benchmark/tests/testthat/test-align_pft.R index 1b97352438a..5e0bdcfe5a8 100644 --- a/modules/benchmark/tests/testthat/test-align_pft.R +++ b/modules/benchmark/tests/testthat/test-align_pft.R @@ -1,8 +1,10 @@ context("align_pft") -con <- PEcAn.DB::db.open( - list(host = "localhost", user = "bety", password = "bety")) +con <- PEcAn.DB::db.open(PEcAn.DB::get_postgres_envvars( + host = "localhost", + user = "bety", + password = "bety")) teardown(PEcAn.DB::db.close(con)) observation_one <- c("AMCA3", "AMCA3", "AMCA3", "AMCA3") diff --git a/modules/data.atmosphere/DESCRIPTION b/modules/data.atmosphere/DESCRIPTION index 62d067713cf..86cce921e2e 100644 --- a/modules/data.atmosphere/DESCRIPTION +++ b/modules/data.atmosphere/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAn.data.atmosphere Type: Package Title: PEcAn functions used for managing climate driver data -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze", role = "aut"), person("David","LeBauer", role = c("aut", "cre"), email = "dlebauer@illinois.edu"), @@ -16,11 +16,9 @@ Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific integrated into PEcAn. As a standalone package, it provides an interface to access diverse climate data sets. Depends: - methods, - xts + methods Imports: abind (>= 1.4.5), - car, data.table, dplyr, geonames (> 0.998), @@ -40,16 +38,18 @@ Imports: PEcAn.remote, PEcAn.utils, purrr (>= 0.2.3), + raster, RCurl, REddyProc, reshape2, rgdal, - rnoaa, + rlang (>= 0.2.0), sp, stringr (>= 1.1.0), testthat (>= 2.0.0), tibble, tidyr, + tidyselect, truncnorm, udunits2 (>= 0.11), XML (>= 3.98-1.4), @@ -60,14 +60,13 @@ Suggests: foreach, parallel, progress, - reticulate, - rlang (>= 0.2.0) + reticulate Remotes: github::ropensci/geonames, github::ropensci/nneo -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/data.atmosphere/NAMESPACE b/modules/data.atmosphere/NAMESPACE index 92d94cd86ea..30f83256bf0 100644 --- a/modules/data.atmosphere/NAMESPACE +++ b/modules/data.atmosphere/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(.download.raw.met.module) export(.extract.nc.module) export(.met2model.module) export(AirDens) @@ -25,22 +26,27 @@ export(download.FluxnetLaThuile) export(download.GFDL) export(download.GLDAS) export(download.Geostreams) +export(download.ICOS) export(download.MACA) +export(download.MERRA) export(download.MsTMIP_NARR) export(download.NARR) export(download.NARR_site) export(download.NEONmet) export(download.NLDAS) export(download.NOAA_GEFS) -export(download.NOAA_GEFS_downscale) export(download.PalEON) export(download.PalEON_ENS) -export(download.US_Syv) export(download.US_WCr) export(download.US_Wlef) +export(downscale_ShortWave_to_half_hrly) export(downscale_ShortWave_to_hrly) +export(downscale_repeat_6hr_to_half_hrly) export(downscale_repeat_6hr_to_hrly) -export(downscale_spline_to_hourly) +export(downscale_solar_geom) +export(downscale_solar_geom_halfhour) +export(downscale_spline_to_half_hrly) +export(downscale_spline_to_hrly) export(equation_of_time) export(exner) export(extract.local.CMIP5) @@ -68,6 +74,7 @@ export(met2CF.AmerifluxLBL) export(met2CF.ERA5) export(met2CF.FACE) export(met2CF.Geostreams) +export(met2CF.ICOS) export(met2CF.NARR) export(met2CF.PalEON) export(met2CF.PalEONregional) @@ -77,10 +84,12 @@ export(metgapfill) export(metgapfill.NOAA_GEFS) export(model.train) export(nc.merge) +export(noaa_grid_download) export(par2ppfd) export(pecan_standard_met_table) export(permute.nc) export(predict_subdaily_met) +export(process_gridded_noaa_download) export(qair2rh) export(read.register) export(rh2qair) @@ -96,9 +105,13 @@ export(subdaily_pred) export(sw2par) export(sw2ppfd) export(temporal.downscale.functions) +export(temporal_downscale) +export(temporal_downscale_half_hour) export(upscale_met) export(wide2long) +export(write_noaa_gefs_netcdf) import(dplyr) -import(xts) +import(tidyselect) importFrom(magrittr,"%>%") importFrom(rgdal,checkCRSArgs) +importFrom(rlang,.data) diff --git a/modules/data.atmosphere/R/GEFS_helper_functions.R b/modules/data.atmosphere/R/GEFS_helper_functions.R new file mode 100644 index 00000000000..7cfc4441f77 --- /dev/null +++ b/modules/data.atmosphere/R/GEFS_helper_functions.R @@ -0,0 +1,707 @@ +#' Download gridded forecast in the box bounded by the latitude and longitude list +#' +#' @param lat_list lat for site +#' @param lon_list long for site +#' @param forecast_time start hour of forecast +#' @param forecast_date date for forecast +#' @param model_name_raw model name for directory creation +#' @param end_hr end hr to determine how many hours to download +#' @param output_directory output directory +#' @export +#' +#' @return NA +#' + +noaa_grid_download <- function(lat_list, lon_list, forecast_time, forecast_date, model_name_raw, output_directory, end_hr) { + + + download_grid <- function(ens_index, location, directory, hours_char, cycle, base_filename1, vars,working_directory){ + #for(j in 1:31){ + if(ens_index == 1){ + base_filename2 <- paste0("gec00",".t",cycle,"z.pgrb2a.0p50.f") + curr_hours <- hours_char[hours <= 384] + }else{ + if((ens_index-1) < 10){ + ens_name <- paste0("0",ens_index - 1) + }else{ + ens_name <- as.character(ens_index -1) + } + base_filename2 <- paste0("gep",ens_name,".t",cycle,"z.pgrb2a.0p50.f") + curr_hours <- hours_char + } + + + for(i in 1:length(curr_hours)){ + file_name <- paste0(base_filename2, curr_hours[i]) + + destfile <- paste0(working_directory,"/", file_name,".grib") + + if(file.exists(destfile)){ + + fsz <- file.info(destfile)$size + gribf <- file(destfile, "rb") + fsz4 <- fsz-4 + seek(gribf,where = fsz4,origin = "start") + last4 <- readBin(gribf,"raw",4) + if(as.integer(last4[1])==55 & as.integer(last4[2])==55 & as.integer(last4[3])==55 & as.integer(last4[4])==55) { + download_file <- FALSE + } else { + download_file <- TRUE + } + close(gribf) + + }else{ + download_file <- TRUE + } + + if(download_file){ + + out <- tryCatch(utils::download.file(paste0(base_filename1, file_name, vars, location, directory), + destfile = destfile, quiet = TRUE), + error = function(e){ + warning(paste(e$message, "skipping", file_name), + call. = FALSE) + return(NA) + }, + finally = NULL) + + if(is.na(out)) next + } + } + } + + model_dir <- file.path(output_directory, model_name_raw) + + curr_time <- lubridate::with_tz(Sys.time(), tzone = "UTC") + curr_date <- lubridate::as_date(curr_time) + + noaa_page <- readLines('https://nomads.ncep.noaa.gov/pub/data/nccf/com/gens/prod/') + + potential_dates <- NULL + for(i in 1:length(noaa_page)){ + if(stringr::str_detect(noaa_page[i], ">gefs.")){ + end <- stringr::str_locate(noaa_page[i], ">gefs.")[2] + dates <- stringr::str_sub(noaa_page[i], start = end+1, end = end+8) + potential_dates <- c(potential_dates, dates) + } + } + + + last_cycle_page <- readLines(paste0('https://nomads.ncep.noaa.gov/pub/data/nccf/com/gens/prod/gefs.', dplyr::last(potential_dates))) + + potential_cycle <- NULL + for(i in 1:length(last_cycle_page)){ + if(stringr::str_detect(last_cycle_page[i], 'href=\"')){ + end <- stringr::str_locate(last_cycle_page[i], 'href=\"')[2] + cycles <- stringr::str_sub(last_cycle_page[i], start = end+1, end = end+2) + if(cycles %in% c("00","06", "12", "18")){ + potential_cycle <- c(potential_cycle, cycles) + } + } + } + + potential_dates <- lubridate::as_date(potential_dates) + + potential_dates = potential_dates[which(potential_dates == forecast_date)] + + if(length(potential_dates) == 0){PEcAn.logger::logger.error("Forecast Date not available")} + + + location <- paste0("&subregion=&leftlon=", + floor(min(lon_list)), + "&rightlon=", + ceiling(max(lon_list)), + "&toplat=", + ceiling(max(lat_list)), + "&bottomlat=", + floor(min(lat_list))) + + base_filename1 <- "https://nomads.ncep.noaa.gov/cgi-bin/filter_gefs_atmos_0p50a.pl?file=" + vars <- "&lev_10_m_above_ground=on&lev_2_m_above_ground=on&lev_surface=on&lev_entire_atmosphere=on&var_APCP=on&var_DLWRF=on&var_DSWRF=on&var_PRES=on&var_RH=on&var_TMP=on&var_UGRD=on&var_VGRD=on&var_TCDC=on" + + for(i in 1:length(potential_dates)){ + + forecast_date <- lubridate::as_date(potential_dates[i]) + forecast_hours = as.numeric(forecast_time) + + + for(j in 1:length(forecast_hours)){ + cycle <- forecast_hours[j] + + if(cycle < 10) cycle <- paste0("0",cycle) + + model_date_hour_dir <- file.path(model_dir,forecast_date,cycle) + if(!dir.exists(model_date_hour_dir)){ + dir.create(model_date_hour_dir, recursive=TRUE, showWarnings = FALSE) + } + + new_download <- TRUE + + if(new_download){ + + print(paste("Downloading", forecast_date, cycle)) + + if(cycle == "00"){ + hours <- c(seq(0, 240, 3),seq(246, 384, 6)) + hours <- hours[hours<=end_hr] + }else{ + hours <- c(seq(0, 240, 3),seq(246, min(end_hr, 840) , 6)) + } + hours_char <- hours + hours_char[which(hours < 100)] <- paste0("0",hours[which(hours < 100)]) + hours_char[which(hours < 10)] <- paste0("0",hours_char[which(hours < 10)]) + curr_year <- lubridate::year(forecast_date) + curr_month <- lubridate::month(forecast_date) + if(curr_month < 10) curr_month <- paste0("0",curr_month) + curr_day <- lubridate::day(forecast_date) + if(curr_day < 10) curr_day <- paste0("0",curr_day) + curr_date <- paste0(curr_year,curr_month,curr_day) + directory <- paste0("&dir=%2Fgefs.",curr_date,"%2F",cycle,"%2Fatmos%2Fpgrb2ap5") + + ens_index <- 1:31 + + parallel::mclapply(X = ens_index, + FUN = download_grid, + location, + directory, + hours_char, + cycle, + base_filename1, + vars, + working_directory = model_date_hour_dir, + mc.cores = 1) + }else{ + print(paste("Existing", forecast_date, cycle)) + } + } + } +} +#' Extract and temporally downscale points from downloaded grid files +#' +#' @param lat_list lat for site +#' @param lon_list lon for site +#' @param site_id Unique site_id for file creation +#' @param downscale Logical. Default is TRUE. Downscales from 6hr to hourly +#' @param overwrite Logical. Default is FALSE. Should exisiting files be overwritten +#' @param forecast_date Date for download +#' @param forecast_time Time (0,6,12,18) for start of download +#' @param model_name Name of model for file name +#' @param model_name_ds Name of downscale file name +#' @param model_name_raw Name of raw file name +#' @param output_directory Output directory +#' @importFrom rlang .data +#' @export +#' @return List +#' +#' +process_gridded_noaa_download <- function(lat_list, + lon_list, + site_id, + downscale, + overwrite, + forecast_date, + forecast_time, + model_name, + model_name_ds, + model_name_raw, + output_directory){ + #binding variables + NOAA.member <- NULL + extract_sites <- function(ens_index, hours_char, hours, cycle, site_id, lat_list, lon_list, working_directory){ + + site_length <- length(site_id) + tmp2m <- array(NA, dim = c(site_length, length(hours_char))) + rh2m <- array(NA, dim = c(site_length, length(hours_char))) + ugrd10m <- array(NA, dim = c(site_length,length(hours_char))) + vgrd10m <- array(NA, dim = c(site_length, length(hours_char))) + pressfc <- array(NA, dim = c(site_length, length(hours_char))) + apcpsfc <- array(NA, dim = c(site_length, length(hours_char))) + tcdcclm <- array(NA, dim = c(site_length, length(hours_char))) + dlwrfsfc <- array(NA, dim = c(site_length, length(hours_char))) + dswrfsfc <- array(NA, dim = c(site_length, length(hours_char))) + + if(ens_index == 1){ + base_filename2 <- paste0("gec00",".t",cycle,"z.pgrb2a.0p50.f") + }else{ + if(ens_index-1 < 10){ + ens_name <- paste0("0",ens_index-1) + }else{ + ens_name <- as.character(ens_index-1) + } + base_filename2 <- paste0("gep",ens_name,".t",cycle,"z.pgrb2a.0p50.f") + } + + lats <- round(lat_list/.5)*.5 + lons <- round(lon_list/.5)*.5 + + if(lons < 0){ + lons <- 360 + lons + } + curr_hours <- hours_char + + for(hr in 1:length(curr_hours)){ + file_name <- paste0(base_filename2, curr_hours[hr]) + + if(file.exists(paste0(working_directory,"/", file_name,".grib"))){ + grib <- rgdal::readGDAL(paste0(working_directory,"/", file_name,".grib"), silent = TRUE) + lat_lon <- sp::coordinates(grib) + for(s in 1:length(site_id)){ + + index <- which(lat_lon[,2] == lats[s] & lat_lon[,1] == lons[s]) + + pressfc[s, hr] <- grib$band1[index] + tmp2m[s, hr] <- grib$band2[index] + rh2m[s, hr] <- grib$band3[index] + ugrd10m[s, hr] <- grib$band4[index] + vgrd10m[s, hr] <- grib$band5[index] + + if(curr_hours[hr] != "000"){ + apcpsfc[s, hr] <- grib$band6[index] + tcdcclm[s, hr] <- grib$band7[index] + dswrfsfc[s, hr] <- grib$band8[index] + dlwrfsfc[s, hr] <- grib$band9[index] + } + } + } + } + + return(list(tmp2m = tmp2m, + pressfc = pressfc, + rh2m = rh2m, + dlwrfsfc = dlwrfsfc, + dswrfsfc = dswrfsfc, + ugrd10m = ugrd10m, + vgrd10m = vgrd10m, + apcpsfc = apcpsfc, + tcdcclm = tcdcclm)) + } + + noaa_var_names <- c("tmp2m", "pressfc", "rh2m", "dlwrfsfc", + "dswrfsfc", "apcpsfc", + "ugrd10m", "vgrd10m", "tcdcclm") + + + model_dir <- file.path(output_directory) + model_name_raw_dir <- file.path(output_directory, model_name_raw) + + curr_time <- lubridate::with_tz(Sys.time(), tzone = "UTC") + curr_date <- lubridate::as_date(curr_time) + potential_dates <- seq(curr_date - lubridate::days(6), curr_date, by = "1 day") + + #Remove dates before the new GEFS system + potential_dates <- potential_dates[which(potential_dates > lubridate::as_date("2020-09-23"))] + + + + + cycle <-forecast_time + curr_forecast_time <- forecast_date + lubridate::hours(cycle) + if(cycle < 10) cycle <- paste0("0",cycle) + if(cycle == "00"){ + hours <- c(seq(0, 240, 3),seq(246, 840 , 6)) + }else{ + hours <- c(seq(0, 240, 3),seq(246, 384 , 6)) + } + hours_char <- hours + hours_char[which(hours < 100)] <- paste0("0",hours[which(hours < 100)]) + hours_char[which(hours < 10)] <- paste0("0",hours_char[which(hours < 10)]) + + raw_files <- list.files(file.path(model_name_raw_dir,forecast_date,cycle)) + hours_present <- as.numeric(stringr::str_sub(raw_files, start = 25, end = 27)) + + all_downloaded <- TRUE + # if(cycle == "00"){ + # #Sometime the 16-35 day forecast is not competed for some of the forecasts. If over 24 hrs has passed then they won't show up. + # #Go ahead and create the netcdf files + # if(length(which(hours_present == 840)) == 30 | (length(which(hours_present == 384)) == 30 & curr_forecast_time + lubridate::hours(24) < curr_time)){ + # all_downloaded <- TRUE + # } + # }else{ + # if(length(which(hours_present == 384)) == 31 | (length(which(hours_present == 384)) == 31 & curr_forecast_time + lubridate::hours(24) < curr_time)){ + # all_downloaded <- TRUE + # } + # } + + + + + + if(all_downloaded){ + + ens_index <- 1:31 + #Run download_downscale_site() over the site_index + output <- parallel::mclapply(X = ens_index, + FUN = extract_sites, + hours_char = hours_char, + hours = hours, + cycle, + site_id, + lat_list, + lon_list, + working_directory = file.path(model_name_raw_dir,forecast_date,cycle), + mc.cores = 1) + + + forecast_times <- lubridate::as_datetime(forecast_date) + lubridate::hours(as.numeric(cycle)) + lubridate::hours(as.numeric(hours_char)) + + + + #Convert negetive longitudes to degrees east + if(lon_list < 0){ + lon_east <- 360 + lon_list + }else{ + lon_east <- lon_list + } + + model_site_date_hour_dir <- file.path(model_dir, site_id, forecast_date,cycle) + + if(!dir.exists(model_site_date_hour_dir)){ + dir.create(model_site_date_hour_dir, recursive=TRUE, showWarnings = FALSE) + }else{ + unlink(list.files(model_site_date_hour_dir, full.names = TRUE)) + } + + if(downscale){ + modelds_site_date_hour_dir <- file.path(output_directory,model_name_ds,site_id, forecast_date,cycle) + if(!dir.exists(modelds_site_date_hour_dir)){ + dir.create(modelds_site_date_hour_dir, recursive=TRUE, showWarnings = FALSE) + }else{ + unlink(list.files(modelds_site_date_hour_dir, full.names = TRUE)) + } + } + + noaa_data <- list() + + for(v in 1:length(noaa_var_names)){ + + value <- NULL + ensembles <- NULL + forecast.date <- NULL + + noaa_data[v] <- NULL + + for(ens in 1:31){ + curr_ens <- output[[ens]] + value <- c(value, curr_ens[[noaa_var_names[v]]][1, ]) + ensembles <- c(ensembles, rep(ens, length(curr_ens[[noaa_var_names[v]]][1, ]))) + forecast.date <- c(forecast.date, forecast_times) + } + noaa_data[[v]] <- list(value = value, + ensembles = ensembles, + forecast.date = lubridate::as_datetime(forecast.date)) + + } + + #These are the cf standard names + cf_var_names <- c("air_temperature", "air_pressure", "relative_humidity", "surface_downwelling_longwave_flux_in_air", + "surface_downwelling_shortwave_flux_in_air", "precipitation_flux", "eastward_wind", "northward_wind","cloud_area_fraction") + + #Replace "eastward_wind" and "northward_wind" with "wind_speed" + cf_var_names1 <- c("air_temperature", "air_pressure", "relative_humidity", "surface_downwelling_longwave_flux_in_air", + "surface_downwelling_shortwave_flux_in_air", "precipitation_flux","specific_humidity", "cloud_area_fraction","wind_speed") + + cf_var_units1 <- c("K", "Pa", "1", "Wm-2", "Wm-2", "kgm-2s-1", "1", "1", "ms-1") #Negative numbers indicate negative exponents + + names(noaa_data) <- cf_var_names + + specific_humidity <- rep(NA, length(noaa_data$relative_humidity$value)) + + noaa_data$relative_humidity$value <- noaa_data$relative_humidity$value / 100 + + noaa_data$air_temperature$value <- noaa_data$air_temperature$value + 273.15 + + specific_humidity[which(!is.na(noaa_data$relative_humidity$value))] <- PEcAn.data.atmosphere::rh2qair(rh = noaa_data$relative_humidity$value[which(!is.na(noaa_data$relative_humidity$value))], + T = noaa_data$air_temperature$value[which(!is.na(noaa_data$relative_humidity$value))], + press = noaa_data$air_pressure$value[which(!is.na(noaa_data$relative_humidity$value))]) + + + #Calculate wind speed from east and north components + wind_speed <- sqrt(noaa_data$eastward_wind$value^2 + noaa_data$northward_wind$value^2) + + forecast_noaa <- tibble::tibble(time = noaa_data$air_temperature$forecast.date, + NOAA.member = noaa_data$air_temperature$ensembles, + air_temperature = noaa_data$air_temperature$value, + air_pressure= noaa_data$air_pressure$value, + relative_humidity = noaa_data$relative_humidity$value, + surface_downwelling_longwave_flux_in_air = noaa_data$surface_downwelling_longwave_flux_in_air$value, + surface_downwelling_shortwave_flux_in_air = noaa_data$surface_downwelling_shortwave_flux_in_air$value, + precipitation_flux = noaa_data$precipitation_flux$value, + specific_humidity = specific_humidity, + cloud_area_fraction = noaa_data$cloud_area_fraction$value, + wind_speed = wind_speed) + + forecast_noaa$cloud_area_fraction <- forecast_noaa$cloud_area_fraction / 100 #Convert from % to proportion + + # Convert the 3 hr precip rate to per second. + forecast_noaa$precipitation_flux <- forecast_noaa$precipitation_flux / (60 * 60 * 3) + + + + # Create a data frame with information about the file. This data frame's format is an internal PEcAn standard, and is stored in the BETY database to + # locate the data file. The data file is stored on the local machine where the download occured. Because NOAA GEFS is an + # ensemble of 21 different forecast models, each model gets its own data frame. All of the information is the same for + # each file except for the file name. + + results_list = list() + + + for (ens in 1:31) { # i is the ensemble number + + #Turn the ensemble number into a string + if(ens-1< 10){ + ens_name <- paste0("0",ens-1) + }else{ + ens_name <- ens - 1 + } + + forecast_noaa_ens <- forecast_noaa %>% + dplyr::filter(NOAA.member == ens) %>% + dplyr::filter(!is.na(.data$air_temperature)) + + end_date <- forecast_noaa_ens %>% + dplyr::summarise(max_time = max(.data$time)) + + results = data.frame( + file = "", #Path to the file (added in loop below). + host = PEcAn.remote::fqdn(), #Name of the server where the file is stored + mimetype = "application/x-netcdf", #Format the data is saved in + formatname = "CF Meteorology", #Type of data + startdate = paste0(format(forecast_date, "%Y-%m-%dT%H:%M:00")), #starting date and time, down to the second + enddate = paste0(format(end_date$max_time, "%Y-%m-%dT%H:%M:00")), #ending date and time, down to the second + dbfile.name = "NOAA_GEFS_downscale", #Source of data (ensemble number will be added later) + stringsAsFactors = FALSE + ) + + identifier = paste("NOAA_GEFS", site_id, ens_name, format(forecast_date, "%Y-%m-%dT%H:%M"), + format(end_date$max_time, "%Y-%m-%dT%H:%M"), sep="_") + + fname <- paste0(identifier, ".nc") + ensemble_folder = file.path(output_directory, identifier) + output_file <- file.path(ensemble_folder,fname) + + if (!dir.exists(ensemble_folder)) { + dir.create(ensemble_folder, recursive=TRUE, showWarnings = FALSE)} + + + #Write netCDF + if(!nrow(forecast_noaa_ens) == 0){ + write_noaa_gefs_netcdf(df = forecast_noaa_ens,ens, lat = lat_list[1], lon = lon_east, cf_units = cf_var_units1, output_file = output_file, overwrite = TRUE) + }else {results_list[[ens]] <- NULL + next} + + if(downscale){ + #Downscale the forecast from 6hr to 1hr + + + identifier_ds = paste("NOAA_GEFS_downscale", site_id, ens_name, format(forecast_date, "%Y-%m-%dT%H:%M"), + format(end_date$max_time, "%Y-%m-%dT%H:%M"), sep="_") + + fname_ds <- paste0(identifier_ds, ".nc") + ensemble_folder_ds = file.path(output_directory, identifier_ds) + output_file_ds <- file.path(ensemble_folder_ds,fname_ds) + + if (!dir.exists(ensemble_folder_ds)) { + dir.create(ensemble_folder_ds, recursive=TRUE, showWarnings = FALSE)} + + results$file = output_file_ds + results$dbfile.name = fname_ds + results_list[[ens]] <- results + + #Run downscaling + temporal_downscale_half_hour(input_file = output_file, output_file = output_file_ds, overwrite = TRUE, hr = 1) + } + + + } + } + results_list <- results_list[!sapply(results_list, is.null)] + return(results_list) +} #process_gridded_noaa_download + +#' @title Downscale NOAA GEFS from 6hr to 1hr +#' @return None +#' +#' @param input_file, full path to 6hr file +#' @param output_file, full path to 1hr file that will be generated +#' @param overwrite, logical stating to overwrite any existing output_file +#' @param hr time step in hours of temporal downscaling (default = 1) +#' @importFrom rlang .data +#' @import tidyselect +#' @export +#' @author Quinn Thomas +#' +#' + +temporal_downscale <- function(input_file, output_file, overwrite = TRUE, hr = 1){ + + # open netcdf + nc <- ncdf4::nc_open(input_file) + + if(stringr::str_detect(input_file, "ens")){ + ens_postion <- stringr::str_locate(input_file, "ens") + ens_name <- stringr::str_sub(input_file, start = ens_postion[1], end = ens_postion[2] + 2) + ens <- as.numeric(stringr::str_sub(input_file, start = ens_postion[2] + 1, end = ens_postion[2] + 2)) + }else{ + ens <- 0 + ens_name <- "ens00" + } + + # retrive variable names + cf_var_names <- names(nc$var) + + # generate time vector + time <- ncdf4::ncvar_get(nc, "time") + begining_time <- lubridate::ymd_hm(ncdf4::ncatt_get(nc, "time", + attname = "units")$value) + time <- begining_time + lubridate::hours(time) + + # retrive lat and lon + lat.in <- ncdf4::ncvar_get(nc, "latitude") + lon.in <- ncdf4::ncvar_get(nc, "longitude") + + # generate data frame from netcdf variables and retrive units + noaa_data <- tibble::tibble(time = time) + var_units <- rep(NA, length(cf_var_names)) + for(i in 1:length(cf_var_names)){ + curr_data <- ncdf4::ncvar_get(nc, cf_var_names[i]) + noaa_data <- cbind(noaa_data, curr_data) + var_units[i] <- ncdf4::ncatt_get(nc, cf_var_names[i], attname = "units")$value + } + + ncdf4::nc_close(nc) + + names(noaa_data) <- c("time",cf_var_names) + + # spline-based downscaling + if(length(which(c("air_temperature", "wind_speed","specific_humidity", "air_pressure") %in% cf_var_names) == 4)){ + forecast_noaa_ds <- downscale_spline_to_hrly(df = noaa_data, VarNames = c("air_temperature", "wind_speed","specific_humidity", "air_pressure")) + }else{ + #Add error message + } + + # Convert splined SH, temperature, and presssure to RH + forecast_noaa_ds <- forecast_noaa_ds %>% + dplyr::mutate(relative_humidity = qair2rh(qair = forecast_noaa_ds$specific_humidity, + temp = forecast_noaa_ds$air_temperature, + press = forecast_noaa_ds$air_pressure)) %>% + dplyr::mutate(relative_humidity = .data$relative_humidity, + relative_humidity = ifelse(.data$relative_humidity > 1, 0, .data$relative_humidity)) + + # convert longwave to hourly (just copy 6 hourly values over past 6-hour time period) + if("surface_downwelling_longwave_flux_in_air" %in% cf_var_names){ + LW.flux.hrly <- downscale_repeat_6hr_to_hrly(df = noaa_data, varName = "surface_downwelling_longwave_flux_in_air") + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, LW.flux.hrly, by = "time") + }else{ + #Add error message + } + + # convert precipitation to hourly (just copy 6 hourly values over past 6-hour time period) + if("surface_downwelling_longwave_flux_in_air" %in% cf_var_names){ + Precip.flux.hrly <- downscale_repeat_6hr_to_hrly(df = noaa_data, varName = "precipitation_flux") + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, Precip.flux.hrly, by = "time") + }else{ + #Add error message + } + + # convert cloud_area_fraction to hourly (just copy 6 hourly values over past 6-hour time period) + if("cloud_area_fraction" %in% cf_var_names){ + cloud_area_fraction.flux.hrly <- downscale_repeat_6hr_to_hrly(df = noaa_data, varName = "cloud_area_fraction") + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, cloud_area_fraction.flux.hrly, by = "time") + }else{ + #Add error message + } + + # use solar geometry to convert shortwave from 6 hr to 1 hr + if("surface_downwelling_shortwave_flux_in_air" %in% cf_var_names){ + ShortWave.hrly <- downscale_ShortWave_to_hrly(df = noaa_data, lat = lat.in, lon = lon.in) + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, ShortWave.hrly, by = "time") + }else{ + #Add error message + } + + #Add dummy ensemble number to work with write_noaa_gefs_netcdf() + forecast_noaa_ds$NOAA.member <- ens + + #Make sure var names are in correct order + forecast_noaa_ds <- forecast_noaa_ds %>% + dplyr::select(.data$time, tidyselect::all_of(cf_var_names), .data$NOAA.member) + + #Write netCDF + write_noaa_gefs_netcdf(df = forecast_noaa_ds, + ens = ens, + lat = lat.in, + lon = lon.in, + cf_units = var_units, + output_file = output_file, + overwrite = overwrite) + +} #temporal_downscale + + + +##' @title Write NOAA GEFS netCDF +##' @param df data frame of meterological variables to be written to netcdf. Columns +##' must start with time with the following columns in the order of `cf_units` +##' @param ens ensemble index used for subsetting df +##' @param lat latitude in degree north +##' @param lon longitude in degree east +##' @param cf_units vector of variable names in order they appear in df +##' @param output_file name, with full path, of the netcdf file that is generated +##' @param overwrite logical to overwrite existing netcdf file +##' +##' @return NA +##' +##' @export +##' @author Quinn Thomas +##' +##' + +write_noaa_gefs_netcdf <- function(df, ens = NA, lat, lon, cf_units, output_file, overwrite){ + + if(!is.na(ens)){ + data <- df + max_index <- max(which(!is.na(data$air_temperature))) + start_time <- min(data$time) + end_time <- data$time[max_index] + + data <- data %>% dplyr::select(-c("time", "NOAA.member")) + }else{ + data <- df + max_index <- max(which(!is.na(data$air_temperature))) + start_time <- min(data$time) + end_time <- data$time[max_index] + + data <- df %>% + dplyr::select(-c("time")) + } + + diff_time <- as.numeric(difftime(df$time, df$time[1])) / (60 * 60) + + cf_var_names <- names(data) + + time_dim <- ncdf4::ncdim_def(name="time", + units = paste("hours since", format(start_time, "%Y-%m-%d %H:%M")), + diff_time, #GEFS forecast starts 6 hours from start time + create_dimvar = TRUE) + lat_dim <- ncdf4::ncdim_def("latitude", "degree_north", lat, create_dimvar = TRUE) + lon_dim <- ncdf4::ncdim_def("longitude", "degree_east", lon, create_dimvar = TRUE) + + dimensions_list <- list(time_dim, lat_dim, lon_dim) + + nc_var_list <- list() + for (i in 1:length(cf_var_names)) { #Each ensemble member will have data on each variable stored in their respective file. + nc_var_list[[i]] <- ncdf4::ncvar_def(cf_var_names[i], cf_units[i], dimensions_list, missval=NaN) + } + + if (!file.exists(output_file) | overwrite) { + nc_flptr <- ncdf4::nc_create(output_file, nc_var_list, verbose = FALSE) + + #For each variable associated with that ensemble + for (j in 1:ncol(data)) { + # "j" is the variable number. "i" is the ensemble number. Remember that each row represents an ensemble + ncdf4::ncvar_put(nc_flptr, nc_var_list[[j]], unlist(data[,j])) + } + + ncdf4::nc_close(nc_flptr) #Write to the disk/storage + } +} \ No newline at end of file diff --git a/modules/data.atmosphere/R/check_met_input.R b/modules/data.atmosphere/R/check_met_input.R index fde275f760b..16b939c797f 100644 --- a/modules/data.atmosphere/R/check_met_input.R +++ b/modules/data.atmosphere/R/check_met_input.R @@ -15,8 +15,8 @@ check_met_input_file <- function(metfile, variable_table = pecan_standard_met_table, required_vars = variable_table %>% - dplyr::filter(is_required) %>% - dplyr::pull(cf_standard_name), + dplyr::filter(.data$is_required) %>% + dplyr::pull(.data$cf_standard_name), warn_unknown = TRUE ) { @@ -82,7 +82,7 @@ check_met_input_file <- function(metfile, target_variable = required_vars, test_passed = required_vars %in% nc_vars, test_error_message = dplyr::if_else( - test_passed, + .data$test_passed, NA_character_, as.character(glue::glue("Missing variable '{target_variable}'.")) ) @@ -92,9 +92,9 @@ check_met_input_file <- function(metfile, test_type = "variable has correct units", target_variable = nc_vars, test_raw = purrr::map(nc_vars, check_unit, nc = nc, variable_table = variable_table), - test_passed = !purrr::map_lgl(test_raw, inherits, "try-error"), - test_error_message = purrr::map_chr(test_raw, purrr::possibly(as.character, NA_character_)) - ) %>% dplyr::select(-test_raw) + test_passed = !purrr::map_lgl(.data$test_raw, inherits, "try-error"), + test_error_message = purrr::map_chr(.data$test_raw, purrr::possibly(as.character, NA_character_)) + ) %>% dplyr::select(-.data$test_raw) results_df <- dplyr::bind_rows(test_dims_summary, test_required_vars, test_var_units) @@ -115,7 +115,7 @@ check_unit <- function(variable, nc, variable_table, warn_unknown = TRUE) { return(TRUE) } var_correct_unit <- variable_table %>% - dplyr::filter(cf_standard_name == variable) %>% + dplyr::filter(.data$cf_standard_name == variable) %>% dplyr::pull(units) ncvar_unit <- ncdf4::ncatt_get(nc, variable, "units")[["value"]] try(testthat::expect_true( diff --git a/modules/data.atmosphere/R/data.R b/modules/data.atmosphere/R/data.R new file mode 100644 index 00000000000..256b8573748 --- /dev/null +++ b/modules/data.atmosphere/R/data.R @@ -0,0 +1,150 @@ + +## Drafts of documentation for package datasets +## +## Written by CKB 2020-05-03, then commented out when I realized that as +## written we need to enable lazy-loading of package data to use these. +## TODO in this order: +## * Inspect all datasets, determine whether lazy-loading them into package +## namespace will cause any issues +## * make any changes needed to resolve issues identified above +## * Change DESCRIPTION line to read `LazyData: true` +## * Uncomment this file, delete this header block +## * run Roxygen, commit resulting Rd files + +# #' 2010 CRUNCEP weather data for Urbana, IL +# #' +# #' Hourly 2010 meteorology for the 0.5-degree grid cell containing the +# #' EBI Energy Farm (Urbana, IL), as obtained from the CRUNCEP +# #' 6-hourly product. +# #' Please see the `compare_narr_cruncep_met` vignette for details of a +# #' comparison between this and the `narr`, `narr3h`, and `ebifarm` datasets. +# #' +# #' @format A data frame with 8736 rows and 10 columns: +# #' \describe{ +# #' \item{date}{POSIXct timestamp} +# #' \item{year, doy, hour}{integer, extracted from `date`} +# #' \item{solarR}{solar radiation, in umol/h/m2} +# #' \item{DailyTemp.C}{air temperature, in degrees C} +# #' \item{RH}{relative humidity, in percent} +# #' \item{WindSpeed}{wind speed, in m/s} +# #' \item{precip}{precipitation rate, in mm/h} +# #' \item{source}{dataset identifier, in this case always "cruncep"}} +# #' @seealso \code{\link{narr}} \code{\link{narr3h}} \code{\link{ebifarm}} +# "cruncep" +# +# +# #' Global 0.5 degree land/water mask for the CRUNCEP dataset +# #' +# #' For details, please see the CRUNCEP scripts included with this package: +# #' `system.file("scripts/cruncep", package = "PEcAn.data.atmosphere")` +# #' +# #' @format a data frame with 259200 rows and 3 columns: +# #' \describe{ +# #' \item{lat}{latitude, in decimal degrees} +# #' \item{lon}{longitude, in decimal degrees} +# #' \item{land}{logical. TRUE = land, FALSE = water}} +# "cruncep_landmask" +# +# +# #' 2010 weather station data from near Urbana, IL +# #' +# #' Hourly 2010 weather data collected at the EBI Energy Farm (Urbana, IL). +# #' Please see the `compare_narr_cruncep_met` vignette for details of a +# #' comparison between this and the `narr`, `narr3h`, and `cruncep` datasets. +# #' +# #' @format A data frame with 8390 rows and 10 columns: +# #' \describe{ +# #' \item{date}{POSIXct timestamp} +# #' \item{year, doy, hour}{integer, extracted from `date`} +# #' \item{Temp}{air temperature, in degrees C} +# #' \item{RH}{relative humidity, in percent} +# #' \item{precip}{precipitation rate, in mm/h} +# #' \item{wind}{wind speed, in m/s} +# #' \item{solar}{solar radiation, in umol/h/m2} +# #' \item{source}{dataset identifier, in this case always "ebifarm"}} +# #' @seealso \code{\link{cruncep}} \code{\link{narr}} \code{\link{narr3h}} +# "ebifarm" +# +# +# #' Codes and BeTY IDs for sites in the FLUXNET network +# #' +# #' @format a data frame with 698 rows and 2 columns: +# #' \describe{ +# #' \item{FLUX.id}{character identifier used by FLUXNET, +# #' e.g. Niwot Ridge USA is `US-NR1`} +# #' \item{site.id}{identifier used in the `sites` table of the PEcAn +# #' database. Integer, but stored as character}} +# "FLUXNET.sitemap" +# +# +# #' Global land/water mask for the NCEP dataset +# #' +# #' For details, please see the NCEP scripts included with this package: +# #' `system.file("scripts/ncep", package = "PEcAn.data.atmosphere")` +# #' +# #' @format a data frame with 18048 rows and 3 columns: +# #' \describe{ +# #' \item{lat}{latitude, in decimal degrees} +# #' \item{lon}{longitude, in decimal degrees} +# #' \item{land}{logical. TRUE = land, FALSE = water}} +# "landmask" +# +# +# #' Latitudes of 94 sites from the NCEP dataset +# #' +# #' For details, please see the NCEP scripts included with this package: +# #' `system.file("scripts/ncep", package = "PEcAn.data.atmosphere")` +# #' +# #' @format a vector of 94 decimal values +# "Lat" +# +# +# #' Longitudes of 192 sites from the NCEP dataset +# #' +# #' For details, please see the NCEP scripts included with this package: +# #' `system.file("scripts/ncep", package = "PEcAn.data.atmosphere")` +# #' +# #' @format a vector of 192 decimal values +# "Lon" +# +# +# #' 2010 NARR weather data for Urbana, IL +# #' +# #' Hourly 2010 meteorology for the 0.3-degree grid cell containing the +# #' EBI Energy Farm (Urbana, IL), as obtained from the NARR daily product. +# #' Please see the `compare_narr_cruncep_met` vignette for details of a +# #' comparison between this and the `cruncep`, `narr3h`, and `ebifarm` datasets. +# #' +# #' @format A data frame with 8760 rows and 10 columns: +# #' \describe{ +# #' \item{date}{POSIXct timestamp} +# #' \item{year, doy, hour}{integer, extracted from `date`} +# #' \item{SolarR}{solar radiation, in umol/h/m2} +# #' \item{Temp}{air temperature, in degrees C} +# #' \item{RH}{relative humidity, in percent} +# #' \item{WS}{wind speed, in m/s} +# #' \item{precip}{precipitation rate, in mm/h} +# #' \item{source}{dataset identifier, in this case always "narr"}} +# #' @seealso \code{\link{cruncep}} \code{\link{ebifarm}} \code{\link{narr3h}} +# "narr" +# +# +# #' 2010 NARR 3-hourly weather data for Urbana, IL +# #' +# #' Hourly 2010 meteorology for the 0.25-degree grid cell containing the +# #' EBI Energy Farm (Urbana, IL), as obtained from the NARR 3-hourly product. +# #' Please see the `compare_narr_cruncep_met` vignette for details of a +# #' comparison between this and the `cruncep`, `narr`, and `ebifarm` datasets. +# #' +# #' @format A data frame with 8736 rows and 10 columns: +# #' \describe{ +# #' \item{date}{POSIXct timestamp} +# #' \item{year, doy, hour}{integer, extracted from `date`} +# #' \item{solarR}{solar radiation, in umol/h/m2} +# #' \item{DailyTemp.C}{air temperature, in degrees C} +# #' \item{RH}{relative humidity, in percent} +# #' \item{WindSpeed}{wind speed, in m/s} +# #' \item{precip}{precipitation rate, in mm/h} +# #' \item{source}{dataset identifier, in this case always "narr3h"}} +# #' @seealso \code{\link{cruncep}} \code{\link{ebifarm}} \code{\link{narr}} +# "narr3h" diff --git a/modules/data.atmosphere/R/debias.met.R b/modules/data.atmosphere/R/debias.met.R index ea05ad0609f..52265855bca 100644 --- a/modules/data.atmosphere/R/debias.met.R +++ b/modules/data.atmosphere/R/debias.met.R @@ -6,13 +6,15 @@ substrRight <- function(x, n) { ##' @name debias_met ##' @title debias_met ##' @export -##' @param outfolder +##' +##' @param outfolder location where output is stored ##' @param input_met - the source_met dataset that will be altered by the training dataset in NC format. ##' @param train_met - the observed dataset that will be used to train the modeled dataset in NC format ##' @param de_method - select which debias method you would like to use, options are 'normal', 'linear regression' -##' @param site.id ##' @param overwrite logical: replace output file if it already exists? Currently ignored. ##' @param verbose logical: should \code{\link[ncdf4:ncdf4-package]{ncdf4}} +##' @param site_id BETY site id +##' @param ... other inputs ##' functions print debugging information as they run? ##' @author James Simkins debias.met <- function(outfolder, input_met, train_met, site_id, de_method = "linear", diff --git a/modules/data.atmosphere/R/debias_met_regression.R b/modules/data.atmosphere/R/debias_met_regression.R index 4c5ceead22d..9589777bf59 100644 --- a/modules/data.atmosphere/R/debias_met_regression.R +++ b/modules/data.atmosphere/R/debias_met_regression.R @@ -7,9 +7,9 @@ ##' @title debias.met.regression ##' @family debias - Debias & Align Meteorology Datasets into continuous time series ##' @author Christy Rollinson -##' @description This script debiases one dataset (e.g. GCM, re-analysis product) given another higher -##' resolution product or empirical observations. It assumes input are in annual CF standard -##' files that are generate from the pecan extract or download funcitons. +##' @description This script debiases one dataset (e.g. GCM, re-analysis product) given another higher +##' resolution product or empirical observations. It assumes input are in annual CF standard +##' files that are generate from the pecan extract or download funcitons. # ----------------------------------- # Parameters # ----------------------------------- @@ -17,21 +17,22 @@ ##' @param source.data - data to be bias-corrected aligned with training data (from align.met) ##' @param n.ens - number of ensemble members to generate and save for EACH source ensemble member ##' @param vars.debias - which met variables should be debiased? if NULL, all variables in train.data -##' @param CRUNCEP - flag for if the dataset being downscaled is CRUNCEP; if TRUE, special cases triggered for +##' @param CRUNCEP - flag for if the dataset being downscaled is CRUNCEP; if TRUE, special cases triggered for ##' met variables that have been naively gapfilled for certain time periods ##' @param pair.anoms - logical stating whether anomalies from the same year should be matched or not -##' @param pair.ens - logical stating whether ensembles from train and source data need to be paired together +##' @param pair.ens - logical stating whether ensembles from train and source data need to be paired together ##' (for uncertainty propogation) -##' @param uncert.prop - method for error propogation if only 1 ensemble member; options=c(random, mean); *Not Implemented yet +##' @param uncert.prop - method for error propogation for child ensemble members 1 ensemble member; options=c(random, mean); randomly strongly encouraged if n.ens>1 ##' @param resids - logical stating whether to pass on residual data or not *Not implemented yet ##' @param seed - specify seed so that random draws can be reproduced ##' @param outfolder - directory where the data should go ##' @param yrs.save - what years from the source data should be saved; if NULL all years of the source data will be saved ##' @param ens.name - what is the name that should be attached to the debiased ensemble -##' @param ens.mems - what labels/numbers to attach to the ensemble members so we can gradually build bigger ensembles +##' @param ens.mems - what labels/numbers to attach to the ensemble members so we can gradually build bigger ensembles ##' without having to do do giant runs at once; if NULL will be numbered 1:n.ens -##' @param force.sanity - (logical) do we force the data to meet sanity checks? +##' @param force.sanity - (logical) do we force the data to meet sanity checks? ##' @param sanity.tries - how many time should we try to predict a reasonable value before giving up? We don't want to end up in an infinite loop +##' @param sanity.sd - how many standard deviations from the mean should be used to determine sane outliers (default 8) ##' @param lat.in - latitude of site ##' @param lon.in - longitude of site ##' @param save.diagnostics - logical; save diagnostic plots of output? @@ -45,7 +46,7 @@ # ----------------------------------- # Workflow # ----------------------------------- -# The general workflow is as follows: +# The general workflow is as follows: # 1. read in & format data (coerce to daily format) # 2. set up the file structures for the output # 3. define the training window @@ -62,21 +63,26 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NULL, CRUNCEP=FALSE, pair.anoms = TRUE, pair.ens = FALSE, uncert.prop="mean", resids = FALSE, seed=Sys.Date(), - outfolder, yrs.save=NULL, ens.name, ens.mems=NULL, force.sanity=TRUE, sanity.tries=25, lat.in, lon.in, + outfolder, yrs.save=NULL, ens.name, ens.mems=NULL, force.sanity=TRUE, sanity.tries=25, sanity.sd=8, lat.in, lon.in, save.diagnostics=TRUE, path.diagnostics=NULL, parallel = FALSE, n.cores = NULL, overwrite = TRUE, verbose = FALSE) { library(MASS) library(mgcv) - + set.seed(seed) - + if(parallel==TRUE) warning("Warning! Parallel processing not reccomended because of memory constraints") if(ncol(source.data[[2]])>1) warning("Feeding an ensemble of source data is currently experimental! This could crash") + if(n.ens<1){ + warning("You need to generate at least one vector of outputs. Changing n.ens to 1, which will be based on the model means.") + n.ens=1 + } if(!uncert.prop %in% c("mean", "random")) stop("unspecified uncertainty propogation method. Must be 'random' or 'mean' ") - + if(uncert.prop=="mean" & n.ens>1) warning(paste0("Warning! Use of mean propagation with n.ens>1 not encouraged as all results will be the same and you will not be adding uncertainty at this stage.")) + # Variables need to be done in a specific order vars.all <- c("air_temperature", "air_temperature_maximum", "air_temperature_minimum", "specific_humidity", "surface_downwelling_shortwave_flux_in_air", "air_pressure", "surface_downwelling_longwave_flux_in_air", "wind_speed", "precipitation_flux") - + if(is.null(vars.debias)) vars.debias <- vars.all[vars.all %in% names(train.data)] # Don't try to do vars that we don't have if(is.null(yrs.save)) yrs.save <- unique(source.data$time$Year) if(is.null(ens.mems)) ens.mems <- stringr::str_pad(1:n.ens, nchar(n.ens), "left", pad="0") @@ -85,36 +91,36 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU vars.pred <- vector() dat.out <- list() dat.out[["time"]] <- source.data$time - + # Transforming zero-truncated variables where negative values are not possible (and zero is unlikely) # - Tried a couple different things, but the sqaure root transformation seems to be working best vars.transform <- c("surface_downwelling_shortwave_flux_in_air", "specific_humidity", "surface_downwelling_longwave_flux_in_air", "wind_speed") - + # --------- - # Setting up some cases about how to duplicate the training data in case we don't pass through the + # Setting up some cases about how to duplicate the training data in case we don't pass through the # same number of ensembles as we want in our output # - Referencing off of whatever the layer after "time" is # --------- # If we have fewer columns then we need, randomly duplicate some if(ncol(train.data[[2]])==n.ens) ens.train <- 1:n.ens - + if(ncol(train.data[[2]]) < n.ens){ ens.train <- c(1:ncol(train.data[[2]]), sample(1:ncol(train.data[[2]]), n.ens-ncol(train.data[[2]]),replace=T)) } - + # If we have more columns than we need, randomly subset if(ncol(train.data[[2]]) > n.ens) { ens.train <- sample(1:ncol(train.data[[2]]), ncol(train.data[[2]]),replace=T) } - + # Setting up cases for dealing with an ensemble of source data to be biased - if(pair.ens==T & ncol(train.data[[2]]!=ncol(source.data[[2]]))){ + if(pair.ens==T & ncol(train.data[[2]]!=ncol(source.data[[2]]))){ stop("Cannot pair ensembles of different size") } else if(pair.ens==T) { ens.src <- ens.train } - - if(pair.ens==F & ncol(source.data[[2]])==1 ){ + + if(pair.ens==F & ncol(source.data[[2]])==1){ ens.src=1 } else if(pair.ens==F & ncol(source.data[[2]]) > n.ens) { ens.src <- sample(1:ncol(source.data[[2]]), ncol(source.data[[2]]),replace=T) @@ -122,11 +128,11 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU ens.src <- c(1:ncol(source.data[[2]]), sample(1:ncol(source.data[[2]]), n.ens-ncol(source.data[[2]]),replace=T)) } # --------- - + # Find the period of years to use to train the model # This formulation should take yrs.overlap <- unique(train.data$time$Year)[unique(train.data$time$Year) %in% unique(source.data$time$Year)] - + # If we don't have a year of overlap, take closest 20 years from each dataset if(length(yrs.overlap)<1){ if(pair.anoms==TRUE) warning("No overlap in years, so we cannot pair the anomalies") @@ -138,9 +144,9 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU for(v in vars.debias){ train.data[[v]] <- matrix(train.data[[v]][which(train.data$time$Year %in% yrs.overlap),], ncol=ncol(train.data[[v]])) } - train.data$time <- train.data$time[which(train.data$time$Year %in% yrs.overlap),] - - + train.data$time <- train.data$time[which(train.data$time$Year %in% yrs.overlap),] + + # ------------------------------------------- # Loop through the variables # ------------------------------------------- @@ -151,7 +157,7 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU for(v in vars.debias){ # ------------- # If we're dealing with precip, lets keep the training data handy & - # calculate the number of rainless time periods (days) in each year to + # calculate the number of rainless time periods (days) in each year to # make sure we don't get a constant drizzle # Update: We also need to look at the distribution of consequtive rainless days # ------------- @@ -162,17 +168,17 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU for(y in unique(train.data$time$Year)){ for(i in 1:ncol(train.data$precipitation_flux)){ rain.now <- train.data$precipitation_flux[train.data$time$Year==y, i] - + rainless <- c(rainless, length(which(rain.now==0))) - - # calculating the mean & sd for rainless days + + # calculating the mean & sd for rainless days tally = 0 for(z in 1:length(rain.now)){ # If we don't have rain, add it to our tally if(rain.now[z]>0){ tally=tally+1 } - + # If we have rain and it resets our tally, # - store tally in our vector; then reset if(rain.now[z]==0 & tally>0){ @@ -182,21 +188,21 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU } # z End loop } # end i loop } # end y loop - + # Hard-coding in some sort of max for precipitaiton rain.max <- max(train.data$precipitation_flux) + sd(train.data$precipitation_flux) rainless.min <- ifelse(min(rainless)-sd(rainless)>=0, min(rainless)-sd(rainless), max(min(rainless)-sd(rainless)/2, 0)) rainless.max <- ifelse(max(rainless)+sd(rainless)<=365, max(rainless)+sd(rainless), min(max(rainless)+sd(rainless)/2, 365)) } # ------------- - + # ------------- # Set up the datasets for training and prediction # ------------- # ----- # 1. Grab the training data -- this will be called "Y" in our bias correction equations # -- preserving the different simulations so we can look at a distribution of potential values - # -- This will get aggregated right off the bat so we so we're looking at the climatic means + # -- This will get aggregated right off the bat so we so we're looking at the climatic means # for the first part of bias-correction # ----- met.train <- data.frame(year=train.data$time$Year, @@ -206,23 +212,23 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU ) met.train[,v] <- 0 - # For precip, we want to adjust the total annual precipitation, and then calculate day of year + # For precip, we want to adjust the total annual precipitation, and then calculate day of year # adjustment & anomaly as fraction of total annual precipitation if(v == "precipitation_flux"){ # Find total annual preciptiation precip.ann <- aggregate(met.train$Y, by=met.train[,c("year", "ind")], FUN=sum) names(precip.ann)[3] <- "Y.tot" - + met.train <- merge(met.train, precip.ann, all=T) met.train$Y <- met.train$Y/met.train$Y.tot # Y is now fraction of annual precip in each timestep } - + # Aggregate to get rid of years so that we can compare climatic means; bring in covariance among climatic predictors dat.clim <- aggregate(met.train[,"Y"], by=met.train[,c("doy", "ind")], FUN=mean) # dat.clim[,v] <- 1 names(dat.clim)[3] <- "Y" # ----- - + # ----- # 2. Pull the raw ("source") data that needs to be bias-corrected -- this will be called "X" # -- this gets aggregated to the climatological mean right off the bat @@ -232,19 +238,19 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU X=utils::stack(data.frame(source.data[[v]][,ens.src]))[,1], ind.src=rep(paste0("X", 1:length(ens.src)), each=nrow(source.data[[v]])) ) - # met.src[,v] <- - + # met.src[,v] <- + if(v=="precipitation_flux"){ src.ann <- aggregate(met.src$X, by=met.src[,c("year", "ind.src")], FUN=sum) names(src.ann)[3] <- "X.tot" - + met.src <- merge(met.src, src.ann, all.x=T) # Putting precip as fraction of the year again - met.src$X <- met.src$X/met.src$X.tot - - } - + met.src$X <- met.src$X/met.src$X.tot + + } + # Lets deal with the source data first # - Adding in the ensembles to be predicted @@ -253,27 +259,27 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU } else { met.src$ind <- met.src$ind.src } - - + + # Adding in the covariates from what's been done: for(v.pred in vars.debias[!vars.debias==v]){ met.train[,v.pred] <- utils::stack(data.frame(train.data[[v.pred]][,ens.train]))[,1] - + if(v.pred %in% names(dat.out)){ met.src[,v.pred] <- utils::stack(data.frame(dat.out[[v.pred]]))[,1] } else { met.src[,v.pred] <- utils::stack(data.frame(source.data[[v.pred]][,ens.src]))[,1] } } - - # Zero out other predictors we'd like to use, but don't actually have data for or don't + + # Zero out other predictors we'd like to use, but don't actually have data for or don't # want to rely on met.train[,vars.all[!vars.all %in% vars.debias]] <- 0 met.src [,vars.all[!vars.all %in% vars.debias]] <- 0 - + # met.src <- merge(met.src, src.cov) met.src[,v] <- 0 - + # Aggregate to get rid of years so that we can compare climatic means clim.src <- aggregate(met.src[met.src$year %in% yrs.overlap,c("X", vars.debias)], by=met.src[met.src$year %in% yrs.overlap,c("doy", "ind", "ind.src")], @@ -281,13 +287,13 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU clim.src[,vars.debias[!vars.debias %in% names(dat.out)]] <- 0 # names(clim.src)[3] <- "X" # ----- - + # ----- - # 3. Merge the training & cource climate data together the two sets of daily means + # 3. Merge the training & cource climate data together the two sets of daily means # -- this ends up pairing each daily climatological mean of the raw data with each simulation from the training data # ----- dat.clim <- merge(dat.clim[,], clim.src, all=T) - + if(v=="precipitation_flux"){ if(pair.anoms==F){ dat.ann <- precip.ann @@ -297,16 +303,16 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU } } # ----- - + # ----- # 4. Pulling the source and training data to model the anomalies # - this includes pulling the covariates from what's already been done # ----- # The training data is already formatted, we just need to copy "Y" (our variable) to "X" as well met.train$X <- met.train$Y - + # ----- - + # Transforming zero-truncated variables where negative values are not possible (and zero is unlikely) # - Tried a couple different things, but the sqaure root transformation seems to be working best if(v %in% vars.transform){ @@ -316,48 +322,48 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU met.train$Y <- sqrt(met.train$Y) } # ------------- - - + + # ------------- # 5. Doing the bias correction by looping through the ensemble members - # - This is almost certainly not the most efficient way of doing it, but should fix some + # - This is almost certainly not the most efficient way of doing it, but should fix some # issues with the prediction phase needing lots of memory for large or long ensembles # ------------- sim.final <- data.frame(array(dim=c(nrow(source.data[[v]]), n.ens))) names(sim.final) <- paste0("X", 1:n.ens) - + for(ens in 1:n.ens){ - + ind = paste0("X", ens) # --------- # Doing the climatological bias correction # In all variables except precip, this adjusts the climatological means closest to the splice point - # -- because precip is relatively stochastic without a clear seasonal pattern, a zero-inflated distribution, + # -- because precip is relatively stochastic without a clear seasonal pattern, a zero-inflated distribution, # and low correlation with other met variables, we'll instead model potential low-frequency patterns in - # the data that is to be bias-corrected. In this instance we essentially consider any daily precip to be + # the data that is to be bias-corrected. In this instance we essentially consider any daily precip to be # an anomaly # --------- # mod.bias0 <- mgcv::gam(Y ~ s(doy, k=6) + X, data=dat.clim[dat.clim$ind == ind, ]) # summary(mod.bias) mod.bias <- mgcv::gam(Y ~ s(doy, k=6), data=dat.clim[dat.clim$ind == ind, ]) # summary(mod.bias) - + # Saving the mean predicted & residuals dat.clim[dat.clim$ind == ind, "pred"] <- predict(mod.bias) dat.clim[dat.clim$ind == ind, "resid"] <- resid(mod.bias) # summary(dat.clim) - + # Storing the model residuals to add in some extra error resid.bias <- resid(mod.bias) - + # # Checking the residuals to see if we can assume normality # plot(resid ~ pred, data=dat.clim); abline(h=0, col="red") # plot(resid ~ doy, data=dat.clim); abline(h=0, col="red") # hist(dat.clim$resid) met.src [met.src $ind == ind, "pred"] <- predict(mod.bias, newdata=met.src [met.src $ind == ind, ]) met.train[met.train$ind == ind, "pred"] <- predict(mod.bias, newdata=met.train[met.train$ind == ind, ]) - + # For Precip we need to bias-correct the total annual preciptiation + seasonal distribution if(v == "precipitation_flux"){ mod.ann <- lm(Y.tot ~ X.tot , data=dat.ann[dat.ann$ind==ind,]) @@ -369,7 +375,7 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU met.src[met.src$ind==ind,"pred.ann"] <- predict(mod.ann, newdata=met.src[met.src$ind==ind,]) } # --------- - + # --------- # Modeling the anomalies # In most cases, this is the deviation of each observation from the climatic mean for that day (estimated using a smoother) @@ -381,7 +387,7 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # --------- # We want to look at anomalies relative to the raw expected seasonal pattern, so we need to fit training and data to be debiased separately - anom.train <- mgcv::gam(X ~ s(doy, k=6) , data=met.train[met.train$ind==ind,]) + anom.train <- mgcv::gam(X ~ s(doy, k=6) , data=met.train[met.train$ind==ind,]) anom.src <- mgcv::gam(X ~ s(doy, k=6) , data=met.src[met.src$ind==ind & met.src$year %in% yrs.overlap,]) if(v == "precipitation_flux"){ @@ -395,61 +401,61 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # plot(anom.train~doy, data=met.train) # plot(anom.raw~doy, data=met.src[met.src$year %in% yrs.overlap,]) # par(mfrow=c(1,1)) - - - # Modeling the anomalies of the other predictors + + + # Modeling the anomalies of the other predictors # -- note: the downscaling & bias-correction of precip should have removed the monsoonal trend if there is no empirical basis for it # so this should be pretty straight-forward now for(j in vars.all[vars.all!=v]){ met.train[met.train$ind==ind, "Q"] <- met.train[met.train$ind==ind,j] met.src[met.src$ind==ind, "Q"] <- met.src[met.src$ind==ind,j] - + # Generating the predicted seasonal cycle for each variable - anom.train2 <- mgcv::gam(Q ~ s(doy, k=6), data=met.train[met.train$ind==ind,]) - anom.src2 <- mgcv::gam(Q ~ s(doy, k=6), data=met.src[met.src$year %in% yrs.overlap & met.src$ind==ind,]) + anom.train2 <- mgcv::gam(Q ~ s(doy, k=6), data=met.train[met.train$ind==ind,]) + anom.src2 <- mgcv::gam(Q ~ s(doy, k=6), data=met.src[met.src$year %in% yrs.overlap & met.src$ind==ind,]) met.train[met.train$ind==ind, paste0(j, ".anom")] <- resid(anom.train2) met.src[met.src$ind==ind, paste0(j, ".anom")] <- met.src[met.src$ind==ind,"Q"] - predict(anom.src2, newdata=met.src[met.src$ind==ind,]) - + rm(anom.train2, anom.src2) } - - # CRUNCEP has a few variables that assume a constant pattern from 1901-1950; + + # CRUNCEP has a few variables that assume a constant pattern from 1901-1950; # so we don't want to use their anomaly as a predictor otherwise we will perpetuate that less than ideal situation if(CRUNCEP==T & v %in% c("surface_downwelling_longwave_flux_in_air", "air_pressure", "wind_speed")) met.src$anom.raw <- 0 - + # Actually Modeling the anomalies # -- If we have empirical data, we can pair the anomalies to find a way to bias-correct those # -- If one of our datasets is a GCM, the patterns observed are just what underly the climate signal and no actual # event is "real". In this case we just want to leverage use the covariance our other met drivers to try and get # the right distribution of anomalies - if(pair.anoms==TRUE){ + if(pair.anoms==TRUE){ # if it's empirical we can, pair the anomalies for best estimation # Note: Pull the covariates from the training data to get any uncertainty &/or try to correct covariances # -- this makes it mroe consistent with the GCM calculations - dat.anom <- merge(met.src [met.src$ind==ind & met.src$year %in% yrs.overlap, c("year", "doy", "ind", "X", "anom.raw")], + dat.anom <- merge(met.src [met.src$ind==ind & met.src$year %in% yrs.overlap, c("year", "doy", "ind", "X", "anom.raw")], met.train[met.train$ind==ind,c("year", "doy", "anom.train", "ind", vars.all[vars.all!=v], paste0(vars.all[vars.all!=v], ".anom"))]) - + dat.anom[,v] <- 0 k=round(length(unique(met.src$year))/50,0) k=max(k, 4) # we can't have less than 4 knots - + # plot(anom.train ~ anom.raw, data=dat.anom) # abline(a=0, b=1, col="blue") # abline(lm(anom.train ~ anom.raw, data=dat.anom), col="red", lty="dashed") - + # Modeling in the predicted value from mod.bias dat.anom$pred <- predict(mod.bias, newdata=dat.anom) - + if (v %in% c("air_temperature", "air_temperature_maximum", "air_temperature_minimum")){ # ** We want to make sure we do these first ** - # These are the variables that have quasi-observed values for their whole time period, + # These are the variables that have quasi-observed values for their whole time period, # so we can use the the seasonsal trend, and the observed anaomalies # Note: because we can directly model the anomalies, the inherent long-term trend should be preserved mod.anom <- mgcv::gam(anom.train ~ s(doy, k=6) + anom.raw, data=dat.anom) } else if(v %in% c("surface_downwelling_shortwave_flux_in_air", "specific_humidity")){ - # CRUNCEP surface_downwelling_shortwave_flux_in_air and specific_humidity have been vary hard to fit to NLDAS because it has a different variance for some reason, - # and the only way I've been able to fix it is to model the temporal pattern seen in the dataset based on + # CRUNCEP surface_downwelling_shortwave_flux_in_air and specific_humidity have been vary hard to fit to NLDAS because it has a different variance for some reason, + # and the only way I've been able to fix it is to model the temporal pattern seen in the dataset based on # its own anomalies (not ideal, but it works) mod.anom <- mgcv::gam(anom.raw ~ s(doy, k=6) + s(year, k=k) + air_temperature_maximum.anom*air_temperature_minimum.anom, data=met.src[met.src$ind==ind,]) } else if(v=="precipitation_flux"){ @@ -457,35 +463,35 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # through 0 so we can try and reduce the likelihood of evenly distributed precipitation events # k=round(length(met.src$year)/(25*366),0) # k=max(k, 4) # we can't have less than 4 knots - + # mod.anom <- mgcv::gam(anom.raw ~ s(year, k=k) + (air_temperature_maximum.anom + air_temperature_minimum.anom + surface_downwelling_shortwave_flux_in_air.anom + surface_downwelling_longwave_flux_in_air.anom + specific_humidity.anom) -1, data=met.src[met.src$ind==ind,]) mod.anom <- mgcv::gam(anom.train ~ s(doy, k=6) + anom.raw - 1, data=dat.anom) } else if(v %in% c("wind_speed", "air_pressure", "surface_downwelling_longwave_flux_in_air")) { - # These variables are constant in CRU pre-1950. - # This means that we can not use information about the long term trend OR the actual annomalies + # These variables are constant in CRU pre-1950. + # This means that we can not use information about the long term trend OR the actual annomalies # -- they must be inferred from the other met we have mod.anom <- mgcv::gam(anom.train ~ s(doy, k=6) + (air_temperature_minimum.anom*air_temperature_maximum.anom + surface_downwelling_shortwave_flux_in_air.anom + specific_humidity.anom) , data=met.train[met.train$ind==ind,]) - } - } else { - # If we're dealing with non-empirical datasets, we can't pair anomalies to come up with a direct adjustment + } + } else { + # If we're dealing with non-empirical datasets, we can't pair anomalies to come up with a direct adjustment # In this case we have 2 options: - # 1) If we've already done at least one variable, we can leverage the covariance of the met drivers we've already downscaled + # 1) If we've already done at least one variable, we can leverage the covariance of the met drivers we've already downscaled # to come up with a relationship that we an use to predict the new set of anomalies # 2) If we don't have any other variables to leverage (i.e. this is our first met variable), we incorporate both the seasonal # trend (doy spline) and potential low-frequency trends in the data (year spline) k=round(length(unique(met.src$year))/50,0) k=max(k, 4) # we can't have less than 4 knots - + # vars.debias <- c("air_temperature", "air_temperature_maximum", "air_temperature_minimum", "specific_humidity", "precipitation_flux", "surface_downwelling_shortwave_flux_in_air", "air_pressure", "surface_downwelling_longwave_flux_in_air", "wind_speed") # Vars that are at daily and we just need to adjust the variance # We have some other anomaly to use! that helps a lot. -- use that to try and get low-frequency trends in the past if(v %in% c("air_temperature_maximum", "air_temperature_minimum")){ - # If we haven't already done another met product, our best shot is to just model the existing variance + # If we haven't already done another met product, our best shot is to just model the existing variance # and preserve as much of the low-frequency cylce as possible - mod.anom <- mgcv::gam(anom.raw ~ s(year, k=k), data=met.src[met.src$ind==ind,]) - } else if(v=="precipitation_flux"){ + mod.anom <- mgcv::gam(anom.raw ~ s(year, k=k), data=met.src[met.src$ind==ind,]) + } else if(v=="precipitation_flux"){ # If we're working with precipitation_flux, need to make the intercept 0 so that we have plenty of days with little/no rain - mod.anom <- mgcv::gam(anom.raw ~ s(year, k=k) + (air_temperature_maximum.anom*air_temperature_minimum.anom + surface_downwelling_shortwave_flux_in_air.anom + surface_downwelling_longwave_flux_in_air.anom + specific_humidity.anom), data=met.src[met.src$ind==ind,]) + mod.anom <- mgcv::gam(anom.raw ~ s(year, k=k) + (air_temperature_maximum.anom*air_temperature_minimum.anom + surface_downwelling_shortwave_flux_in_air.anom + surface_downwelling_longwave_flux_in_air.anom + specific_humidity.anom), data=met.src[met.src$ind==ind,]) } else if(v %in% c("surface_downwelling_shortwave_flux_in_air", "surface_downwelling_longwave_flux_in_air")){ # See if we have some other anomaly that we can use to get the anomaly covariance & temporal trends right # This relies on the assumption that the low-frequency trends are in proportion to the other met variables @@ -499,10 +505,10 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU } # summary(mod.anom) # plot(mod.anom, pages=1) - + # pred.anom <- predict(mod.anom) resid.anom <- resid(mod.anom) # --------- - + # -------- # Predicting a bunch of potential posteriors over the full dataset # -------- @@ -510,75 +516,87 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU coef.gam <- coef(mod.bias) coef.anom <- coef(mod.anom) if(v == "precipitation_flux") coef.ann <- coef(mod.ann) - + # Setting up a case where if sanity checks fail, we pull more ensemble members - n.new <- round(n.ens/2)+1 - cols.redo <- 1:n.new + n.new <- 1 + cols.redo <- n.new sane.attempt=0 while(n.new>0 & sane.attempt <= sanity.tries){ - + # Rbeta <- matrix(nrow=0, ncol=1); Rbeta.anom <- matrix(nrow=0, ncol=1) # ntries=50 # try.now=0 # while(nrow(Rbeta)<1 & try.now<=ntries){ # Generate a random distribution of betas using the covariance matrix # I think the anomalies might be problematic, so lets get way more betas than we need and trim the distribution - # set.seed=42 - Rbeta <- matrix(MASS::mvrnorm(n=n.new, coef(mod.bias), vcov(mod.bias)), ncol=length(coef(mod.bias))) + # set.seed=42 + if(n.ens==1 | uncert.prop=="mean"){ + Rbeta <- matrix(coef(mod.bias), ncol=length(coef(mod.bias))) + } else { + Rbeta <- matrix(MASS::mvrnorm(n=n.new, coef(mod.bias), vcov(mod.bias)), ncol=length(coef(mod.bias))) + } dimnames(Rbeta)[[2]] <- names(coef(mod.bias)) # # Filter our betas to remove outliers # ci.beta <- matrix(apply(Rbeta, 2, quantile, c(0.01, 0.99)), nrow=2) - # + # # # Only worry about the non-0 betas # beta.use <- which(abs(as.vector(coef(mod.bias)))>0) - # + # # Rbeta <- matrix(Rbeta[which(apply(Rbeta[,beta.use], 1, function(x) all(x > ci.beta[1,beta.use] & x < ci.beta[2,beta.use]))),], ncol=ncol(Rbeta)) - # + # # try.now=try.now+1 # } - + # try.now=0 # while(nrow(Rbeta.anom)<1 & try.now<=ntries){ # Generate a random distribution of betas using the covariance matrix # I think the anomalies might be problematic, so lets get way more betas than we need and trim the distribution + if(n.ens==1){ + Rbeta.anom <- matrix(coef(mod.anom), ncol=length(coef(mod.anom))) + } else { Rbeta.anom <- matrix(MASS::mvrnorm(n=n.new, coef(mod.anom), vcov(mod.anom)), ncol=length(coef(mod.anom))) - dimnames(Rbeta.anom)[[2]] <- names(coef(mod.anom)) + } + dimnames(Rbeta.anom)[[2]] <- names(coef(mod.anom)) # # Filter our betas to remove outliers # ci.anom <- matrix(apply(Rbeta.anom, 2, quantile, c(0.01, 0.99)), nrow=2) - # + # # # Only worry about the non-0 betas # anom.use <- which(abs(as.vector(coef(mod.anom)))>0) - # + # # Rbeta.anom <- matrix(Rbeta.anom[which(apply(Rbeta.anom[,anom.use], 1, function(x) all(x > ci.anom[1,anom.use] & x < ci.anom[2,anom.use]))),], ncol=ncol(Rbeta.anom)) - # + # # try.now=try.now+1 # } - + # Rbeta <- matrix(Rbeta[sample(1:nrow(Rbeta), n.new, replace=T),], ncol=ncol(Rbeta)) # Rbeta.anom <- matrix(Rbeta.anom[sample(1:nrow(Rbeta.anom), n.new, replace=T),], ncol=ncol(Rbeta.anom)) - - + + if(v == "precipitation_flux"){ - Rbeta.ann <- matrix(MASS::mvrnorm(n=n.new, coef(mod.ann), vcov(mod.ann)), ncol=length(coef(mod.ann))) + if(n.ens==1){ + Rbeta.ann <- matrix(coef(mod.ann), ncol=length(coef.ann)) + } else { + Rbeta.ann <- matrix(MASS::mvrnorm(n=n.new, coef(mod.ann), vcov(mod.ann)), ncol=length(coef(mod.ann))) + } # ci.ann <- matrix(apply(Rbeta.ann, 2, quantile, c(0.01, 0.99)), nrow=2) # Rbeta.ann <- Rbeta.ann[which(apply(Rbeta.ann, 1, function(x) all(x > ci.ann[1,] & x < ci.ann[2,]))),] # Rbeta.ann <- matrix(Rbeta.ann[sample(1:nrow(Rbeta.ann), n.new, replace=T),], ncol=ncol(Rbeta.ann)) - } - + } + # Create the prediction matrix Xp <- predict(mod.bias, newdata=met.src[met.src$ind==ind,], type="lpmatrix") Xp.anom <- predict(mod.anom, newdata=met.src[met.src$ind==ind,], type="lpmatrix") if(v == "precipitation_flux"){ # Linear models have a bit of a difference in how we get the info out # Xp.ann <- predict(mod.ann, newdata=met.src, type="lpmatrix") - + met.src[met.src$ind==ind,"Y.tot"] <- met.src[met.src$ind==ind,"pred.ann"] mod.terms <- terms(mod.ann) m <- model.frame(mod.terms, met.src[met.src$ind==ind,], xlev=mod.ann$xlevels) Xp.ann <- model.matrix(mod.terms, m, constrasts.arg <- mod.ann$contrasts) - } - + } + # ----- # Simulate predicted met variables & add in some residual error # NOTE: Here we're assuming normal distribution of the errors, which looked pretty valid @@ -588,14 +606,14 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # Options for adding in residual error # # Option 1: Adding a constant error per time series # -- This is currently used for the climatological bias-correction because we're going to assume - # that we've biased the mean offset in the climatology (the seasonal bias is encorporated in the + # that we've biased the mean offset in the climatology (the seasonal bias is encorporated in the # spline estimation) # -- Note: Precipitation doesn't get residual error added here because that sort of bias is funneled into - # the anomaly model. The error in the Rbetas should adequately represent the uncertainty in the + # the anomaly model. The error in the Rbetas should adequately represent the uncertainty in the # low-frequency trends in the data # # Option 2: Adding a random error to each observation # -- This is used for the anomalies because they are by definition stochastic, highly unpredictable - # -- Note: this option currently ignores potential autocorrelation in anomalies (i.e. if 1 Jan was + # -- Note: this option currently ignores potential autocorrelation in anomalies (i.e. if 1 Jan was # unseasonably warm, odds are that the days around it weren't record-breaking cold) # -- I'm rolling with this for now and will smooth some of these over in the downscaling to # subdaily data @@ -608,50 +626,59 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU sim1a <- matrix(nrow=dim.new[1], ncol=dim.new[2]) sim1b <- matrix(nrow=dim.new[1], ncol=dim.new[2]) if(v == "precipitation_flux") sim1c <- matrix(nrow=dim.new[1], ncol=dim.new[2]) - + sim1 <- matrix(nrow=dim.new[1], ncol=dim.new[2]) } - + # Default option: no residual error; all error from the downscaling parameters sim1a[,cols.redo] <- Xp %*% t(Rbeta) # Seasonal Climate component with uncertainty sim1b[,cols.redo] <- Xp.anom %*% t(Rbeta.anom) # Weather component with uncertainty - if(v == "precipitation_flux"){ + if(v == "precipitation_flux"){ sim1a[,cols.redo] <- 0 sim1c <- Xp.ann %*% t(Rbeta.ann) # Mean annual precip uncertainty } - - # If we're dealing with the temperatures where there's basically no anomaly, + + # If we're dealing with the temperatures where there's basically no anomaly, # we'll get the uncertainty subtract the multi-decadal trend out of the anomalies; not a perfect solution, but it will increase the variability if(pair.anoms==F & (v %in% c("air_temperature_maximum", "air_temperature_minimum"))){ - # sim1b.norm <- apply(sim1b, 1, mean) - sim1b[,cols.redo] <- as.vector(met.src[met.src$ind==ind,"anom.raw"]) - sim1b[,cols.redo] # Get the range around that medium-frequency trend + # sim1b.norm <- apply(sim1b, 1, mean) + # What we need is to remove the mean-trend from the anomalies and then add the trend (with uncertinaties) back in + # Note that for a single-member ensemble, this just undoes itself + anom.detrend <- met.src[met.src$ind==ind,"anom.raw"] - predict(mod.anom) + + # NOTE: This section can probably be removed and simplified since it should always be a 1-column array now + if(length(cols.redo)>1){ + sim1b[,cols.redo] <- apply(sim1b[,cols.redo], 2, FUN=function(x){x+anom.detrend}) # Get the range around that medium-frequency trend + } else { + sim1b[,cols.redo] <- as.matrix(sim1b[,cols.redo] + anom.detrend) + } + } - - - - # Option 1: Adding a constant error per time series for the cliamte correction + + + # Option 1: Adding a constant error per time series for the cliamte correction # (otherwise we're just doubling anomalies) # sim1a <- sweep(sim1a, 2, rnorm(n, mean(resid.bias), sd(resid.bias)), FUN="+") # if(v!="precipitation_flux") sim1a <- sweep(sim1a, 2, rnorm(n, mean(resid.bias), sd(resid.bias)), FUN="+") # Only apply if not working with precipitation_flux # sim1b <- sweep(sim1b, 2, rnorm(n, mean(resid.anom), sd(resid.anom)), FUN="+") - + # # # Option 2: Adding a random error to each observation (anomaly error) # if(v!="precipitation_flux") sim1a <- sim1a + rnorm(length(sim1a), mean(resid.bias), sd(resid.bias)) # sim1b <- sim1b + rnorm(length(sim1b), mean(resid.anom), sd(resid.anom)) - + # # Option 3: explicitly modeling the errors in some way # ----- - + # Adding climate and anomaly together sim1[,cols.redo] <- sim1a[,cols.redo] + sim1b[,cols.redo] # climate + weather = met driver!! # If we're dealing with precip, transform proportions of rain back to actual precip - if(v == "precipitation_flux"){ + if(v == "precipitation_flux"){ sim1[,cols.redo] <- sim1[,cols.redo]*sim1c[,cols.redo] # met.src$X <- met.src$X*met.src$X.tot # met.src$anom.raw <- met.src$anom.raw*met.src$X.tot } - + # ----- # SANITY CHECKS!!! # ----- @@ -662,65 +689,65 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # max air temp = 70 C; hottest temperature from sattellite; very ridiculous # min air temp = -95 C; colder than coldest natural temperature recorded in Antarctica cols.redo <- which(apply(sim1, 2, function(x) min(x) < 273.15-95 | max(x) > 273.15+70 | - min(x) < mean(met.train$X) - 8*sd(met.train$X) | - max(x) > mean(met.train$X) + 8*sd(met.train$X) + min(x) < mean(met.train$X) - sanity.sd*sd(met.train$X) | + max(x) > mean(met.train$X) + sanity.sd*sd(met.train$X) )) } - #"specific_humidity", + #"specific_humidity", if(v == "specific_humidity"){ # Based on google, it looks like values of 30 g/kg can occur in the tropics, so lets go above that # Also, the minimum humidity can't be 0 so lets just make it extremely dry; lets set this for 1 g/Mg - + cols.redo <- which(apply(sim1, 2, function(x) min(x^2) < 1e-6 | max(x^2) > 40e-3 | - min(x^2) < mean(met.train$X^2) - 8*sd(met.train$X^2) | - max(x^2) > mean(met.train$X^2) + 8*sd(met.train$X^2) - )) + min(x^2) < mean(met.train$X^2) - sanity.sd*sd(met.train$X^2) | + max(x^2) > mean(met.train$X^2) + sanity.sd*sd(met.train$X^2) + )) } - #"surface_downwelling_shortwave_flux_in_air", + #"surface_downwelling_shortwave_flux_in_air", if(v == "surface_downwelling_shortwave_flux_in_air"){ # Based on something found from Columbia, average Radiative flux at ATM is 1360 W/m2, so for a daily average it should be less than this # Lets round 1360 and divide that by 2 (because it should be a daily average) and conservatively assume albedo of 20% (average value is more like 30) # Source http://eesc.columbia.edu/courses/ees/climate/lectures/radiation/ cols.redo <- which(apply(sim1, 2, function(x) max(x^2) > 1360/2*0.8 | - min(x^2) < mean(met.train$X^2) - 8*sd(met.train$X^2) | - max(x^2) > mean(met.train$X^2) + 8*sd(met.train$X^2) - )) + min(x^2) < mean(met.train$X^2) - sanity.sd*sd(met.train$X^2) | + max(x^2) > mean(met.train$X^2) + sanity.sd*sd(met.train$X^2) + )) } if(v == "air_pressure"){ # According to wikipedia the highest barometric pressure ever recorded was 1085.7 hPa = 1085.7*100 Pa; Dead sea has average pressure of 1065 hPa # - Lets round up to 1100 hPA # Also according to Wikipedia, the lowest non-tornadic pressure ever measured was 870 hPA cols.redo <- which(apply(sim1, 2, function(x) min(x) < 870*100 | max(x) > 1100*100 | - min(x) < mean(met.train$X) - 8*sd(met.train$X) | - max(x) > mean(met.train$X) + 8*sd(met.train$X) - )) + min(x) < mean(met.train$X) - sanity.sd*sd(met.train$X) | + max(x) > mean(met.train$X) + sanity.sd*sd(met.train$X) + )) } - if(v == "surface_downwelling_longwave_flux_in_air"){ + if(v == "surface_downwelling_longwave_flux_in_air"){ # A NASA presentation has values topping out ~300 and min ~0: https://ceres.larc.nasa.gov/documents/STM/2003-05/pdf/smith.pdf # A random journal article has 130 - 357.3: http://www.tandfonline.com/doi/full/10.1080/07055900.2012.760441 # ED2 sanity checks boudn longwave at 40 & 600 - + cols.redo <- which(apply(sim1, 2, function(x) min(x^2) < 40 | max(x^2) > 600 | - min(x^2) < mean(met.train$X^2) - 8*sd(met.train$X^2) | - max(x^2) > mean(met.train$X^2) + 8*sd(met.train$X^2) - )) - + min(x^2) < mean(met.train$X^2) - sanity.sd*sd(met.train$X^2) | + max(x^2) > mean(met.train$X^2) + sanity.sd*sd(met.train$X^2) + )) + } if(v == "wind_speed"){ # According to wikipedia, the hgihest wind speed ever recorded is a gust of 113 m/s; the maximum 5-mind wind speed is 49 m/s cols.redo <- which(apply(sim1, 2, function(x) max(x^2) > 50/2 | - min(x^2) < mean(met.train$X^2) - 8*sd(met.train$X^2) | - max(x^2) > mean(met.train$X^2) + 8*sd(met.train$X^2) - )) + min(x^2) < mean(met.train$X^2) - sanity.sd*sd(met.train$X^2) | + max(x^2) > mean(met.train$X^2) + sanity.sd*sd(met.train$X^2) + )) } if(v == "precipitation_flux"){ # According to wunderground, ~16" in 1 hr is the max; Lets divide that by 2 for the daily rainfall rate # https://www.wunderground.com/blog/weatherhistorian/what-is-the-most-rain-to-ever-fall-in-one-minute-or-one-hour.html # 16/2 = round number; x25.4 = inches to mm; /(60*60) = hr to sec cols.redo <- which(apply(sim1, 2, function(x) max(x) > 16/2*25.4/(60*60) | - min(x) < min(met.train$X) - 8*sd(met.train$X) | - max(x) > max(met.train$X) + 8*sd(met.train$X) - )) + min(x) < min(met.train$X) - sanity.sd*sd(met.train$X) | + max(x) > max(met.train$X) + sanity.sd*sd(met.train$X) + )) } n.new = length(cols.redo) if(force.sanity){ @@ -730,24 +757,24 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU } # ----- } # End Sanity Attempts - - + + if(force.sanity & n.new>0){ - # If we're still struggling, but we have at least some workable columns, lets just duplicate those: - if(n.new<(round(n.ens/2)+1)){ - cols.safe <- 1:ncol(sim1) - cols.safe <- cols.safe[!(cols.safe %in% cols.redo)] - sim1[,cols.redo] <- sim1[,sample(cols.safe, n.new, replace=T)] - } else { - # for known problem variables, lets force sanity as a last resort + # # If we're still struggling, but we have at least some workable columns, lets just duplicate those: + # if(n.new<(round(n.ens/2)+1)){ + # cols.safe <- 1:ncol(sim1) + # cols.safe <- cols.safe[!(cols.safe %in% cols.redo)] + # sim1[,cols.redo] <- sim1[,sample(cols.safe, n.new, replace=T)] + # } else { + # for known problem variables, lets force sanity as a last resort if(v %in% c("air_temperature", "air_temperature_maximum", "air_temperature_minimum")){ warning(paste("Forcing Sanity:", v)) - if(min(sim1) < max(273.15-95, mean(met.train$X) - 8*sd(met.train$X))) { - qtrim <- max(273.15-95, mean(met.train$X) - 8*sd(met.train$X)) + 1e-6 + if(min(sim1) < max(184, mean(met.train$X) - sanity.sd*sd(met.train$X))) { + qtrim <- max(184, mean(met.train$X) - sanity.sd*sd(met.train$X)) + 1e-6 sim1[sim1 < qtrim] <- qtrim } - if(max(sim1) > min(273.15+70, mean(met.train$X) + sd(met.train$X^2))) { - qtrim <- min(273.15+70, mean(met.train$X) + 8*sd(met.train$X)) - 1e-6 + if(max(sim1) > min(331, mean(met.train$X) + sd(met.train$X^2))) { + qtrim <- min(331, mean(met.train$X) + sanity.sd*sd(met.train$X)) - 1e-6 sim1[sim1 > qtrim] <- qtrim } } else if(v == "surface_downwelling_shortwave_flux_in_air"){ @@ -755,82 +782,82 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # # Lets round 1360 and divide that by 2 (because it should be a daily average) and conservatively assume albedo of 20% (average value is more like 30) # # Source http://eesc.columbia.edu/courses/ees/climate/lectures/radiation/ # cols.redo <- which(apply(sim1, 2, function(x) max(x^2) > 1360/2*0.8 | - # min(x) < mean(met.train$X) - 8*sd(met.train$X) | - # max(x) > mean(met.train$X) + 8*sd(met.train$X) - # )) + # min(x) < mean(met.train$X) - sanity.sd*sd(met.train$X) | + # max(x) > mean(met.train$X) + sanity.sd*sd(met.train$X) + # )) warning(paste("Forcing Sanity:", v)) - if(min(sim1^2) < max(mean(met.train$X^2) - 8*sd(met.train$X^2))) { - qtrim <- max(mean(met.train$X^2) - 8*sd(met.train$X^2)) + if(min(sim1^2) < max(mean(met.train$X^2) - sanity.sd*sd(met.train$X^2))) { + qtrim <- max(mean(met.train$X^2) - sanity.sd*sd(met.train$X^2)) sim1[sim1^2 < qtrim] <- sqrt(qtrim) } - if(max(sim1^2) > min(1360/2*0.8, mean(met.train$X^2) + 8*sd(met.train$X^2))) { - qtrim <- min(1360/2*0.8, mean(met.train$X^2) + 8*sd(met.train$X^2)) + if(max(sim1^2) > min(1500*0.8, mean(met.train$X^2) + sanity.sd*sd(met.train$X^2))) { + qtrim <- min(1500*0.8, mean(met.train$X^2) + sanity.sd*sd(met.train$X^2)) sim1[sim1^2 > qtrim] <- sqrt(qtrim) } - - } else if(v == "surface_downwelling_longwave_flux_in_air"){ + + } else if(v == "surface_downwelling_longwave_flux_in_air"){ # Having a heck of a time keeping things reasonable, so lets trim it # ED2 sanity checks boudn longwave at 40 & 600 - + warning(paste("Forcing Sanity:", v)) - if(min(sim1^2) < max(40, mean(met.train$X^2) - 8*sd(met.train$X^2))) { - qtrim <- max(40, mean(met.train$X^2) - 8*sd(met.train$X^2)) + if(min(sim1^2) < max(40, mean(met.train$X^2) - sanity.sd*sd(met.train$X^2))) { + qtrim <- max(40, mean(met.train$X^2) - sanity.sd*sd(met.train$X^2)) sim1[sim1^2 < qtrim] <- sqrt(qtrim) } - if(max(sim1^2) > min(600, mean(met.train$X^2) + 8*sd(met.train$X^2))) { - qtrim <- min(600, mean(met.train$X^2) + 8*sd(met.train$X^2)) + if(max(sim1^2) > min(600, mean(met.train$X^2) + sanity.sd*sd(met.train$X^2))) { + qtrim <- min(600, mean(met.train$X^2) + sanity.sd*sd(met.train$X^2)) sim1[sim1^2 > qtrim] <- sqrt(qtrim) } } else if(v=="specific_humidity"){ warning(paste("Forcing Sanity:", v)) # I'm having a hell of a time trying to get SH to fit sanity bounds, so lets brute-force fix outliers - if(min(sim1^2) < max(1e-6, mean(met.train$X^2) - 8*sd(met.train$X^2))) { - qtrim <- max(1e-6, mean(met.train$X^2) - 8*sd(met.train$X^2)) + if(min(sim1^2) < max(1e-6, mean(met.train$X^2) - sanity.sd*sd(met.train$X^2))) { + qtrim <- max(1e-6, mean(met.train$X^2) - sanity.sd*sd(met.train$X^2)) sim1[sim1^2 < qtrim] <- sqrt(qtrim) } - if(max(sim1^2) > min(40e-3, mean(met.train$X^2) + 8*sd(met.train$X^2))) { - qtrim <- min(40e-3, mean(met.train$X^2) + 8*sd(met.train$X^2)) + if(max(sim1^2) > min(3.2e-2, mean(met.train$X^2) + sanity.sd*sd(met.train$X^2))) { + qtrim <- min(3.2e-2, mean(met.train$X^2) + sanity.sd*sd(met.train$X^2)) sim1[sim1^2 > qtrim] <- sqrt(qtrim) } } else if(v=="air_pressure"){ warning(paste("Forcing Sanity:", v)) - if(min(sim1)< max(870*100, mean(met.train$X) - 8*sd(met.train$X))){ - qtrim <- min(870*100, mean(met.train$X) - 8*sd(met.train$X)) + if(min(sim1)< max(45000, mean(met.train$X) - sanity.sd*sd(met.train$X))){ + qtrim <- min(45000, mean(met.train$X) - sanity.sd*sd(met.train$X)) sim1[sim1 < qtrim] <- qtrim } - if(max(sim1) < min(1100*100, mean(met.train$X) + 8*sd(met.train$X))){ - qtrim <- min(1100*100, mean(met.train$X) + 8*sd(met.train$X)) + if(max(sim1) < min(11000000, mean(met.train$X) + sanity.sd*sd(met.train$X))){ + qtrim <- min(11000000, mean(met.train$X) + sanity.sd*sd(met.train$X)) sim1[sim1 > qtrim] <- qtrim } } else if(v=="wind_speed"){ warning(paste("Forcing Sanity:", v)) - if(min(sim1)< max(0, mean(met.train$X) - 8*sd(met.train$X))){ - qtrim <- min(0, mean(met.train$X) - 8*sd(met.train$X)) + if(min(sim1)< max(0, mean(met.train$X) - sanity.sd*sd(met.train$X))){ + qtrim <- min(0, mean(met.train$X) - sanity.sd*sd(met.train$X)) sim1[sim1 < qtrim] <- qtrim } - if(max(sim1) < min(sqrt(50/2), mean(met.train$X) + 8*sd(met.train$X))){ - qtrim <- min(sqrt(50/2), mean(met.train$X) + 8*sd(met.train$X)) + if(max(sim1) < min(sqrt(85), mean(met.train$X) + sanity.sd*sd(met.train$X))){ + qtrim <- min(sqrt(85), mean(met.train$X) + sanity.sd*sd(met.train$X)) sim1[sim1 > qtrim] <- qtrim } } else { # If this is a new problem variable, lets stop and look at it stop(paste("Unable to produce a sane prediction:", v, "- ens", ens, "; problem child =", paste(cols.redo, collapse=" "))) } - } + # } # End if else } # End force sanity - - + + # Un-transform variables where we encounter zero-truncation issues - # NOTE: Need to do this *before* we sum the components!! + # NOTE: Need to do this *before* we sum the components!! #if(v %in% vars.transform){ # sim1 <- sim1^2 # # met.src[met.src$ind==ind,"X"] <- met.src[met.src$ind==ind,"X"]^2 - #} - - - # For preciptiation, we need to make sure we don't have constant drizzle and have + #} + + + # For preciptiation, we need to make sure we don't have constant drizzle and have # at least some dry days. To deal with this, I make the assumption that there hasn't - # been a trend in number of rainless days over the past 1000 years and use the mean & + # been a trend in number of rainless days over the past 1000 years and use the mean & # sd of rainless days in the training data to randomly distribute the rain in the past # Update: We also need to look at the distribution of consequtive rainless days if(v=="precipitation_flux"){ @@ -838,7 +865,7 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU for(y in min(met.src[met.src$ind==ind, "year"]):max(met.src[met.src$ind==ind, "year"])){ # Figure out which rows belong to this particular year rows.yr <- which(met.src[met.src$ind==ind, "year"]==y) - + # Before adjusting rainless days, make sure we get rid of our negative days first dry <- rows.yr[which(sim1[rows.yr,j] < 0)] while(length(dry)>0){ # until we have our water year balanced @@ -851,12 +878,12 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU } dry <- rows.yr[which(sim1[rows.yr,j] < 0)] # update our dry days } - + # n.now = number of rainless days for this sim - n.now <- round(rnorm(1, mean(rainless, na.rm=T), sd(rainless, na.rm=T)), 0) + n.now <- round(rnorm(1, mean(rainless, na.rm=T), sd(rainless, na.rm=T)), 0) if(n.now < rainless.min) n.now <- rainless.min # Make sure we don't have negative or no rainless days if(n.now > rainless.max) n.now <- rainless.max # Make sure we have at least one day with rain - + # We're having major seasonality issues, so lets randomly redistribute our precip # Pull ~twice what we need and randomly select from that so that we don't have such clean cuttoffs # set.seed(12) @@ -866,9 +893,9 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # cutoff <- 1-cutoff dry1 <- rows.yr[which(sim1[rows.yr,j] > cutoff)] dry <- sample(dry1, 365-n.now, replace=T) - + wet <- sample(rows.yr[!rows.yr %in% dry], length(dry), replace=T) - + # Go through and randomly redistribute the precipitation to days we're not designating as rainless # Note, if we don't loop through, we might lose some of our precip # IN the case of redistributing rain to prevent super droughts, divide by 2 @@ -876,24 +903,24 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU sim1[wet[r],j] <- sim1[dry[r],j]/2 sim1[dry[r],j] <- sim1[dry[r],j]/2 } - + } else { - # Figure out which days are currently below our cutoff and randomly distribute - # their precip to days that are not below the cutoff (this causes a more bi-modal - # distribution hwere dry days get drier), but other options ended up with either - # too few rainless days because of only slight redistribution (r+1) or buildup + # Figure out which days are currently below our cutoff and randomly distribute + # their precip to days that are not below the cutoff (this causes a more bi-modal + # distribution hwere dry days get drier), but other options ended up with either + # too few rainless days because of only slight redistribution (r+1) or buildup # towards the end of the year (random day that hasn't happened) dry1 <- rows.yr[which(sim1[rows.yr,j] < cutoff)] dry <- sample(dry1, min(n.now, length(dry1)), replace=F) dry1 <- dry1[!dry1 %in% dry] # dry <- dry[order(dry)] - + # Figure out how close together our dry are # Now checking to see if we need to move rainy days # calculating the mean & sd for rainless days redistrib=T - # wet.max <- round(rnorm(1, mean(cons.wet, na.rm=T), sd(cons.wet, na.rm=T)), 0) + # wet.max <- round(rnorm(1, mean(cons.wet, na.rm=T), sd(cons.wet, na.rm=T)), 0) while(redistrib==T & length(dry1)>1){ ens.wet <- vector() wet.end <- vector() @@ -902,7 +929,7 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # If we don't have rain, add it to our tally if(!rows.yr[z] %in% dry){ tally=tally+1 - } + } # If we have rain and it resets our tally, # - store tally in our vector; then reset if(rows.yr[z] %in% dry & tally>0){ @@ -911,32 +938,32 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU tally=0 } } # end z - + # If we have a worryingly high number of consequtive wet days (outside of 6 sd); try a new dry if(max(ens.wet) > max(cons.wet)+sd(cons.wet) ){ # print("redistributing dry days") - # If we have a wet period that's too long, lets find the random dry that's - # closest to the midpoint of the longest + # If we have a wet period that's too long, lets find the random dry that's + # closest to the midpoint of the longest # Finding what we're going to insert as our new dry day wet.max <- which(ens.wet==max(ens.wet))[1] dry.diff <- abs(dry1 - round(wet.end[wet.max]-ens.wet[wet.max]/2)+1) dry.new <- which(dry.diff==min(dry.diff))[1] - + # Finding the closest dry date to shift dry.diff2 <- abs(dry - round(wet.end[wet.max]-ens.wet[wet.max]/2)+1) dry.replace <- which(dry.diff2==min(dry.diff2))[1] dry[dry.replace] <- dry1[dry.new] - + dry1 <- dry1[dry1!=dry1[dry.new]] # Drop the one we just moved so we don't get in an infinite loop } else { redistrib=F } } - # - + # + # Figure out where to put the extra rain; allow replacement for good measure wet <- sample(rows.yr[!rows.yr %in% dry], length(dry), replace=T) - + # Go through and randomly redistribute the precipitation to days we're not designating as rainless # Note, if we don't loop through, we might lose some of our precip for(r in 1:length(dry)){ @@ -945,32 +972,33 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU } } - + } # End year (y) } # End sim (j) } # End precip - + # Randomly pick one from this meta-ensemble to save # this *should* be propogating uncertainty because we have the ind effects in all of the models and we're randomly adding as we go - if(uncert.prop=="random"){ - sim.final[,ens] <- sim1[,sample(1:ncol(sim1),1)] - } - if(uncert.prop=="mean"){ - sim.final[,ens] <- apply(sim1, 1, mean) - } - + sim.final[,ens] <- as.vector(sim1) + # if(uncert.prop=="random"){ + # sim.final[,ens] <- sim1[,sample(1:ncol(sim1),1)] + # } + # if(uncert.prop=="mean"){ + # sim.final[,ens] <- apply(sim1, 1, mean) + # } + utils::setTxtProgressBar(pb, pb.ind) pb.ind <- pb.ind+1 - + rm(mod.bias, anom.train, anom.src, mod.anom, Xp, Xp.anom, sim1, sim1a, sim1b) - } + } # End ensemble loop - if(v == "precipitation_flux"){ + if(v == "precipitation_flux"){ # sim1 <- sim1*sim1c met.src$X <- met.src$X*met.src$X.tot met.src$anom.raw <- met.src$anom.raw*met.src$X.tot } - + if(v %in% vars.transform){ sim.final <- sim.final^2 dat.clim[,c("X", "Y")] <- (dat.clim[,c("X", "Y")]^2) @@ -978,40 +1006,51 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU met.train$X <- (met.train$X)^2 met.train$Y <- (met.train$Y)^2 } - + # Store the output in our dat.out dat.out[[v]] <- sim.final # ------------- - + # ------------- # Save some diagnostic graphs if useful # ------------- if(save.diagnostics==TRUE){ dir.create(path.diagnostics, recursive=T, showWarnings=F) - + dat.pred <- source.data$time + dat.pred$Date <- as.POSIXct(dat.pred$Date) dat.pred$obs <- apply(source.data[[v]], 1, mean, na.rm=T) dat.pred$mean <- apply(dat.out[[v]], 1, mean, na.rm=T) dat.pred$lwr <- apply(dat.out[[v]], 1, quantile, 0.025, na.rm=T) dat.pred$upr <- apply(dat.out[[v]], 1, quantile, 0.975, na.rm=T) - + # Plotting the observed and the bias-corrected 95% CI - grDevices::png(file.path(path.diagnostics, paste(ens.name, v, "day.png", sep="_"))) + grDevices::png(file.path(path.diagnostics, paste(ens.name, v, "day.png", sep="_")), height=6, width=6, units="in", res=220) print( ggplot2::ggplot(data=dat.pred[dat.pred$Year>=mean(dat.pred$Year)-1 & dat.pred$Year<=mean(dat.pred$Year)+1,]) + - ggplot2::geom_ribbon(ggplot2::aes(x=Date, ymin=lwr, ymax=upr), fill="red", alpha=0.5) + - ggplot2::geom_line(ggplot2::aes(x=Date, y=mean), color="red", size=0.5) + - ggplot2::geom_line(ggplot2::aes(x=Date, y=obs), color='black', size=0.5) + + ggplot2::geom_ribbon(ggplot2::aes(x=Date, ymin=lwr, ymax=upr, fill="corrected"), alpha=0.5) + + ggplot2::geom_line(ggplot2::aes(x=Date, y=mean, color="corrected"), size=0.5) + + ggplot2::geom_line(ggplot2::aes(x=Date, y=obs, color="original"), size=0.5) + + ggplot2::scale_color_manual(values=c("corrected" = "red", "original"="black")) + + ggplot2::scale_fill_manual(values=c("corrected" = "red", "original"="black")) + + ggplot2::guides(fill=F) + ggplot2::ggtitle(paste0(v, " - ensemble mean & 95% CI (daily slice)")) + ggplot2::theme_bw() ) grDevices::dev.off() - + # Plotting a few random series to get an idea for what an individual pattern looks liek - stack.sims <- utils::stack(data.frame(dat.out[[v]][,sample(1:n.ens, min(3, n.ens))])) + col.samp <- paste0("X", sample(1:n.ens, min(3, n.ens))) + + sim.sub <- data.frame(dat.out[[v]])[,col.samp] + for(i in 1:ncol(sim.sub)){ + sim.sub[,i] <- as.vector(sim.sub[,i]) + } + # names(test) <- col.samp + stack.sims <- utils::stack(sim.sub) stack.sims[,c("Year", "DOY", "Date")] <- dat.pred[,c("Year", "DOY", "Date")] - - grDevices::png(file.path(path.diagnostics, paste(ens.name, v, "day2.png", sep="_"))) + + grDevices::png(file.path(path.diagnostics, paste(ens.name, v, "day2.png", sep="_")), height=6, width=6, units="in", res=220) print( ggplot2::ggplot(data=stack.sims[stack.sims$Year>=mean(stack.sims$Year)-2 & stack.sims$Year<=mean(stack.sims$Year)+2,]) + ggplot2::geom_line(ggplot2::aes(x=Date, y=values, color=ind), size=0.2, alpha=0.8) + @@ -1019,43 +1058,47 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU ggplot2::theme_bw() ) grDevices::dev.off() - + # Looking tat the annual means over the whole time series to make sure we're getting decent interannual variability dat.yr <- aggregate(dat.pred[,c("obs", "mean", "lwr", "upr")], by=list(dat.pred$Year), FUN=mean) names(dat.yr)[1] <- "Year" - - grDevices::png(file.path(path.diagnostics, paste(ens.name, v, "annual.png", sep="_"))) + + grDevices::png(file.path(path.diagnostics, paste(ens.name, v, "annual.png", sep="_")), height=6, width=6, units="in", res=220) print( ggplot2::ggplot(data=dat.yr[,]) + - ggplot2::geom_ribbon(ggplot2::aes(x=Year, ymin=lwr, ymax=upr), fill="red", alpha=0.5) + - ggplot2::geom_line(ggplot2::aes(x=Year, y=mean), color="red", size=0.5) + - ggplot2::geom_line(ggplot2::aes(x=Year, y=obs), color='black', size=0.5) + + ggplot2::geom_ribbon(ggplot2::aes(x=Year, ymin=lwr, ymax=upr, fill="corrected"), alpha=0.5) + + ggplot2::geom_line(ggplot2::aes(x=Year, y=mean, color="corrected"), size=0.5) + + ggplot2::geom_line(ggplot2::aes(x=Year, y=obs, color="original"), size=0.5) + + ggplot2::scale_color_manual(values=c("corrected" = "red", "original"="black")) + + ggplot2::scale_fill_manual(values=c("corrected" = "red", "original"="black")) + + ggplot2::guides(fill=F) + + ggplot2::ggtitle(paste0(v, " - annual mean time series")) + ggplot2::theme_bw() ) grDevices::dev.off() - + } # ------------- - + } # End looping through variables # ------------------------------------------- - - + + # Save the output - nc.info <- data.frame(CF.name = c("air_temperature", "air_temperature_minimum", "air_temperature_maximum", "precipitation_flux", - "surface_downwelling_shortwave_flux_in_air", "surface_downwelling_longwave_flux_in_air", - "air_pressure", "specific_humidity", "wind_speed"), - longname = c("2 meter air temperature", "2 meter minimum air temperature", "2 meter maximum air temperature", - "cumulative precipitation (water equivalent)", "incident (downwelling) showtwave radiation", - "incident (downwelling) longwave radiation", "air pressure at the surface", - "Specific humidity measured at the lowest level of the atmosphere", - "wind_speed speed"), + nc.info <- data.frame(CF.name = c("air_temperature", "air_temperature_minimum", "air_temperature_maximum", "precipitation_flux", + "surface_downwelling_shortwave_flux_in_air", "surface_downwelling_longwave_flux_in_air", + "air_pressure", "specific_humidity", "wind_speed"), + longname = c("2 meter air temperature", "2 meter minimum air temperature", "2 meter maximum air temperature", + "cumulative precipitation (water equivalent)", "incident (downwelling) showtwave radiation", + "incident (downwelling) longwave radiation", "air pressure at the surface", + "Specific humidity measured at the lowest level of the atmosphere", + "wind_speed speed"), units = c("K", "K", "K", "kg m-2 s-1", "W m-2", "W m-2", "Pa", "kg kg-1", "m s-1") ) - + # Define our lat/lon dims since those will be constant dim.lat <- ncdf4::ncdim_def(name='latitude', units='degree_north', vals=lat.in, create_dimvar=TRUE) dim.lon <- ncdf4::ncdim_def(name='longitude', units='degree_east', vals=lon.in, create_dimvar=TRUE) @@ -1068,35 +1111,35 @@ debias.met.regression <- function(train.data, source.data, n.ens, vars.debias=NU # Doing some row/time indexing rows.yr <- which(dat.out$time$Year==yr) nday <- ifelse(lubridate::leap_year(yr), 366, 365) - + # Finish defining our time variables (same for all ensemble members) dim.time <- ncdf4::ncdim_def(name='time', units="sec", vals=seq(1*24*360, (nday+1-1/24)*24*360, length.out=length(rows.yr)), create_dimvar=TRUE, unlim=TRUE) nc.dim=list(dim.lat,dim.lon,dim.time) - + # Setting up variables and dimensions var.list = list() dat.list = list() - + for(j in 1:length(vars.debias)){ - var.list[[j]] = ncdf4::ncvar_def(name=vars.debias[j], - units=as.character(nc.info[nc.info$CF.name==vars.debias[j], "units"]), + var.list[[j]] = ncdf4::ncvar_def(name=vars.debias[j], + units=as.character(nc.info[nc.info$CF.name==vars.debias[j], "units"]), longname=as.character(nc.info[nc.info$CF.name==vars.debias[j], "longname"]), dim=nc.dim, missval=-999, verbose=verbose) } names(var.list) <- vars.debias - + # Loop through & write each ensemble member for(i in 1:n.ens){ # Setting up file structure ens.path <- file.path(outfolder, paste(ens.name, ens.mems[i], sep="_")) dir.create(ens.path, recursive=T, showWarnings=F) loc.file <- file.path(ens.path, paste(ens.name, ens.mems[i], stringr::str_pad(yr, width=4, side="left", pad="0"), "nc", sep = ".")) - + for(j in 1:length(vars.debias)){ dat.list[[j]] = array(dat.out[[vars.debias[j]]][rows.yr,i], dim=c(length(lat.in), length(lon.in), length(rows.yr))) # Go ahead and make the arrays } names(dat.list) <- vars.debias - + ## put data in new file loc <- ncdf4::nc_create(filename=loc.file, vars=var.list, verbose=verbose) for(j in 1:length(vars.debias)){ diff --git a/modules/data.atmosphere/R/download.AmerifluxLBL.R b/modules/data.atmosphere/R/download.AmerifluxLBL.R index 64cd4180a1c..93aa712bdf0 100644 --- a/modules/data.atmosphere/R/download.AmerifluxLBL.R +++ b/modules/data.atmosphere/R/download.AmerifluxLBL.R @@ -65,7 +65,7 @@ download.AmerifluxLBL <- function(sitename, outfolder, start_date, end_date, endname <- strsplit(outfname, "_") endname <- endname[[1]][length(endname[[1]])] - endname <- substr(endname, 1, nchar(endname) - 4) + endname <- gsub("\\..*", "", endname) outcsvname <- paste0(substr(outfname, 1, 15), "_", file_timestep_hh, "_", endname, ".csv") output_csv_file <- file.path(outfolder, outcsvname) outcsvname_hr <- paste0(substr(outfname, 1, 15), "_", file_timestep_hr, "_", endname, ".csv") diff --git a/modules/data.atmosphere/R/download.CRUNCEP_Global.R b/modules/data.atmosphere/R/download.CRUNCEP_Global.R index a8ce003a3dd..54fb4cea4f7 100644 --- a/modules/data.atmosphere/R/download.CRUNCEP_Global.R +++ b/modules/data.atmosphere/R/download.CRUNCEP_Global.R @@ -4,7 +4,6 @@ ##' @param outfolder Directory where results should be written ##' @param start_date,end_date Range of years to retrieve. Format is YYYY-MM-DD, ##' but only the year portion is used and the resulting files always contain a full year of data. -##' @param site_id numeric. Currently ignored ##' @param lat.in site latitude in decimal degrees ##' @param lon.in site longitude in decimal degrees ##' @param overwrite logical. Download a fresh version even if a local file with the same name already exists? @@ -22,11 +21,11 @@ ##' @export ##' ##' @author James Simkins, Mike Dietze, Alexey Shiklomanov -download.CRUNCEP <- function(outfolder, start_date, end_date, site_id, lat.in, lon.in, +download.CRUNCEP <- function(outfolder, start_date, end_date, lat.in, lon.in, overwrite = FALSE, verbose = FALSE, maxErrors = 10, sleep = 2, - method = "opendap", ...) { + method = "ncss", ...) { - if (is.null(method)) method <- "opendap" + if (is.null(method)) method <- "ncss" if (!method %in% c("opendap", "ncss")) { PEcAn.logger::logger.severe(glue::glue( "Bad method '{method}'. Currently, only 'opendap' or 'ncss' are supported." @@ -67,7 +66,7 @@ download.CRUNCEP <- function(outfolder, start_date, end_date, site_id, lat.in, l utils::download.file(mask_url, maskfile) mask_nc <- ncdf4::nc_open(maskfile) - on.exit(ncdf4::nc_close(mask_nc)) + on.exit(ncdf4::nc_close(mask_nc), add = TRUE) # Set search radius to up to 2 pixels (1 degree) in any direction mask_minlat <- lat_grid - 2 @@ -202,9 +201,20 @@ download.CRUNCEP <- function(outfolder, start_date, end_date, site_id, lat.in, l "time_end={year}-12-31T21:00:00Z&", "accept=netcdf" ) - tmp_file <- tempfile() - utils::download.file(ncss_query, tmp_file) - dap <- ncdf4::nc_open(tmp_file) + # Cache raw CRUNCEP files so that later workflows don't have to download + # them (even if they do have to do some reprocessing). + raw_file <- file.path( + outfolder, + glue::glue("cruncep-raw-{year}-{lat.in}-{lon.in}-{current_var}.nc") + ) + if (overwrite || !file.exists(raw_file)) { + utils::download.file(ncss_query, raw_file) + } else { + PEcAn.logger::logger.debug(glue::glue( + "Skipping file because it already exists: {raw_file}" + )) + } + dap <- ncdf4::nc_open(raw_file) } # confirm that timestamps match @@ -220,7 +230,6 @@ download.CRUNCEP <- function(outfolder, start_date, end_date, site_id, lat.in, l "but got", min(dap_time), "..", max(dap_time)) } - dat.list[[j]] <- PEcAn.utils::retry.func( ncdf4::ncvar_get( dap, diff --git a/modules/data.atmosphere/R/download.ERA5.R b/modules/data.atmosphere/R/download.ERA5.R index a1c11fa4d7e..59d1d134a5f 100644 --- a/modules/data.atmosphere/R/download.ERA5.R +++ b/modules/data.atmosphere/R/download.ERA5.R @@ -51,7 +51,7 @@ download.ERA5.old <- function(outfolder, start_date, end_date, lat.in, lon.in, "This function is an incomplete prototype! Use with caution!" ) - PEcAn.utils:::need_packages("reticulate") + need_packages("reticulate") if (!is.null(reticulate_python)) { reticulate::use_python(reticulate_python) diff --git a/modules/data.atmosphere/R/download.FACE.R b/modules/data.atmosphere/R/download.FACE.R index 88e00cb2d5b..735571f5e88 100644 --- a/modules/data.atmosphere/R/download.FACE.R +++ b/modules/data.atmosphere/R/download.FACE.R @@ -3,12 +3,15 @@ ##' @name download.FACE ##' @title download.FACE ##' @export -##' @param sitename -##' @param outfolder -##' @param start_year -##' @param end_year +##' +##' @param sitename sitename +##' @param outfolder location where output is stored ##' @param method Optional. Passed to download.file() function. Use this to set custom programs such as ncftp to use when ##' downloading files from FTP sites +##' @param start_date desired start date YYYY-MM-DD +##' @param end_date desired end date YYYY-MM-DD +##' @param overwrite overwrite existing files? Default is FALSE +##' @param ... other inputs ##' ##' @author Betsy Cowdery download.FACE <- function(sitename, outfolder, start_date, end_date, overwrite = FALSE, method, ...) { diff --git a/modules/data.atmosphere/R/download.GLDAS.R b/modules/data.atmosphere/R/download.GLDAS.R index 2ba558807e5..13971492f86 100644 --- a/modules/data.atmosphere/R/download.GLDAS.R +++ b/modules/data.atmosphere/R/download.GLDAS.R @@ -3,12 +3,16 @@ ##' Download and convert single grid point GLDAS to CF single grid point from hydro1.sci.gsfc.nasa.gov using OPENDAP interface ##' ##' @export -##' @param outfolder -##' @param start_date -##' @param end_date -##' @param site_id -##' @param lat.in -##' @param lon.in +##' +##' @param outfolder location where output is stored +##' @param start_date desired start date +##' @param end_date desired end date +##' @param site_id desired site id +##' @param lat.in latitude of site +##' @param lon.in longistude of site +##' @param overwrite overwrite existing files? Default is FALSE +##' @param verbose Default is FALSE, used as input for ncdf4::ncvar_def +##' @param ... other inputs ##' ##' @author Christy Rollinson download.GLDAS <- function(outfolder, start_date, end_date, site_id, lat.in, lon.in, diff --git a/modules/data.atmosphere/R/download.ICOS.R b/modules/data.atmosphere/R/download.ICOS.R new file mode 100644 index 00000000000..853f671209c --- /dev/null +++ b/modules/data.atmosphere/R/download.ICOS.R @@ -0,0 +1,249 @@ +#' Download ICOS Ecosystem data products +#' +#' Currently available products: +#' Drought-2018 ecosystem eddy covariance flux product https://www.icos-cp.eu/data-products/YVR0-4898 +#' ICOS Final Fully Quality Controlled Observational Data (Level 2) https://www.icos-cp.eu/data-products/ecosystem-release +#' +#' +#' @param sitename ICOS id of the site. Example - "BE-Bra" +#' @param outfolder path to the directory where the output file is stored. If specified directory does not exists, it is created. +#' @param start_date start date of the data request in the form YYYY-MM-DD +#' @param end_date end date area of the data request in the form YYYY-MM-DD +#' @param product ICOS product to be downloaded. Currently supported options: "Drought2018", "ETC" +#' @param overwrite should existing files be overwritten. Default False. +#' @param ... used when extra arguments are present. +#' @return information about the output file +#' @export +#' @examples +#' \dontrun{ +#' download.ICOS("FI-Sii", "/home/carya/pecan", "2016-01-01", "2018-01-01", product="Drought2018") +#' } +#' @author Ayush Prasad +#' +download.ICOS <- + function(sitename, + outfolder, + start_date, + end_date, + product, + overwrite = FALSE, ...) { + + # make sure output folder exists + if (!file.exists(outfolder)) { + dir.create(outfolder, showWarnings = FALSE, recursive = TRUE) + } + + + download_file_flag <- TRUE + extract_file_flag <- TRUE + sitename <- sub(".* \\((.*)\\)", "\\1", sitename) + + if (tolower(product) == "drought2018") { + # construct output CSV file name + output_file_name <- + paste0( + "FLX_", + sitename, + "_FLUXNET2015_FULLSET_HH_" + ) + + # construct zip file name + zip_file_name <- + paste0(outfolder, "/Drought", sitename, ".zip") + + # data type, can be found from the machine readable page of the product + data_type <- + "http://meta.icos-cp.eu/resources/cpmeta/dought2018ArchiveProduct" + + file_name <- + paste0('FLX_', sitename, '_FLUXNET2015_FULLSET_HH') + + format_name <- "ICOS_ECOSYSTEM_HH" + + } else if (tolower(product) == "etc") { + output_file_name <- + paste0("ICOSETC_", sitename, "_FLUXNET_HH_01.csv") + + # construct zip file name + zip_file_name <- + paste0(outfolder, "/ICOSETC_Archive_", sitename, ".zip") + + # data type, can be found from the machine readable page of the product + data_type <- + "http://meta.icos-cp.eu/resources/cpmeta/etcArchiveProduct" + + file_name <- + paste0("ICOSETC_", sitename, "_FLUXNET_HH") + + format_name <- "ICOS_ECOSYSTEM_HH" + + } else { + PEcAn.logger::logger.severe("Invalid product. Product should be one of 'Drought2018', 'ETC' ") + } + + output_file <- list.files(path = outfolder, pattern = output_file_name) + if(length(output_file != 0) && !overwrite){ + PEcAn.logger::logger.info("Output CSV file for the requested site already exists") + download_file_flag <- FALSE + extract_file_flag <- FALSE + output_file_name <- output_file + } + + if (extract_file_flag && + file.exists(zip_file_name) && !overwrite) { + PEcAn.logger::logger.info("Zip file for the requested site already exists, extracting it...") + download_file_flag <- FALSE + extract_file_flag <- TRUE + } + + if (download_file_flag) { + # Find dataset product id by using the site name + + # ICOS SPARQL end point + url <- "https://meta.icos-cp.eu/sparql?type=JSON" + + # RDF query to find out the information about the data set using the site name + body <- " + prefix cpmeta: + prefix prov: + select ?dobj ?spec ?timeStart ?timeEnd + where { + VALUES ?spec {} + ?dobj cpmeta:hasObjectSpec ?spec . + VALUES ?station {} + ?dobj cpmeta:wasAcquiredBy/prov:wasAssociatedWith ?station . + ?dobj cpmeta:hasStartTime | (cpmeta:wasAcquiredBy / prov:startedAtTime) ?timeStart . + ?dobj cpmeta:hasEndTime | (cpmeta:wasAcquiredBy / prov:endedAtTime) ?timeEnd . + FILTER NOT EXISTS {[] cpmeta:isNextVersionOf ?dobj} + } + " + body <- gsub("data_type", data_type, body) + body <- gsub("sitename", sitename, body) + response <- httr::POST(url, body = body) + response <- httr::content(response, as = "text") + response <- jsonlite::fromJSON(response) + dataset_url <- response$results$bindings$dobj$value + dataset_start_date <- + lubridate::as_datetime( + strptime(response$results$bindings$timeStart$value, format = "%Y-%m-%dT%H:%M:%S") + ) + dataset_end_date <- + lubridate::as_datetime( + strptime(response$results$bindings$timeEnd$value, format = "%Y-%m-%dT%H:%M:%S") + ) + if (is.null(dataset_url)) { + PEcAn.logger::logger.severe("Data is not available for the requested site") + } + if (dataset_start_date > lubridate::as_datetime(start_date)) { + PEcAn.logger::logger.severe( + paste( + "Data is not available for the requested start date. Please try again with", + dataset_start_date, + "as start date." + ) + ) + } + + if (dataset_end_date < lubridate::as_date(end_date)) { + PEcAn.logger::logger.severe( + paste( + "Data is not available for the requested end date. Please try again with", + dataset_end_date, + "as end date." + ) + ) + } + dataset_id <- sub(".*/", "", dataset_url) + + # construct the download URL + download_url <- + paste0('https://data.icos-cp.eu/licence_accept?ids=%5B%22', + dataset_id, + '%22%5D') + # Download the zip file + file <- + httr::GET(url = download_url, + httr::write_disk(zip_file_name, + overwrite = TRUE), + httr::progress()) + } + + if (extract_file_flag) { + # extract only the hourly data file + zipped_csv_name <- + grep( + paste0('*', file_name), + utils::unzip(zip_file_name, list = TRUE)$Name, + ignore.case = TRUE, + value = TRUE + ) + utils::unzip(zip_file_name, + files = zipped_csv_name, + junkpaths = TRUE, + exdir = outfolder) + if (tolower(product) == "drought2018") { + output_file_name <- zipped_csv_name + }else if (tolower(product) == "etc") { + # reformat file slightly so that both Drought2018 and ETC files can use the same format + tmp_csv <- utils::read.csv(file.path(outfolder, output_file_name)) + new_tmp <- cbind(tmp_csv[, -which(colnames(tmp_csv)=="LW_OUT")], tmp_csv[, which(colnames(tmp_csv)=="LW_OUT")]) + colnames(new_tmp) <- c(colnames(tmp_csv)[-which(colnames(tmp_csv)=="LW_OUT")], "LW_OUT") + utils::write.csv(new_tmp, file = file.path(outfolder, output_file_name), row.names = FALSE) + } + } + + + # get start and end year of data from file + firstline <- + system(paste0("head -2 ", file.path(outfolder, output_file_name)), intern = TRUE) + firstline <- firstline[2] + lastline <- + system(paste0("tail -1 ", file.path(outfolder, output_file_name)), intern = TRUE) + + firstdate_st <- paste0( + substr(firstline, 1, 4), + "-", + substr(firstline, 5, 6), + "-", + substr(firstline, 7, 8), + " ", + substr(firstline, 9, 10), + ":", + substr(firstline, 11, 12) + ) + lastdate_st <- paste0( + substr(lastline, 1, 4), + "-", + substr(lastline, 5, 6), + "-", + substr(lastline, 7, 8), + " ", + substr(lastline, 9, 10), + ":", + substr(lastline, 11, 12) + ) + + + rows <- 1 + results <- data.frame( + file = character(rows), + host = character(rows), + mimetype = character(rows), + formatname = character(rows), + startdate = character(rows), + enddate = character(rows), + dbfile.name = substr(basename(output_file_name), 1, nchar(basename(output_file_name)) - 4), + stringsAsFactors = FALSE + ) + + results$file[rows] <- + file.path(outfolder, output_file_name) + results$host[rows] <- PEcAn.remote::fqdn() + results$startdate[rows] <- firstdate_st + results$enddate[rows] <- lastdate_st + results$mimetype[rows] <- "text/csv" + results$formatname[rows] <- format_name + + return(results) + + } diff --git a/modules/data.atmosphere/R/download.MACA.R b/modules/data.atmosphere/R/download.MACA.R index b3cb02e6aba..f4bc93253fb 100644 --- a/modules/data.atmosphere/R/download.MACA.R +++ b/modules/data.atmosphere/R/download.MACA.R @@ -2,14 +2,19 @@ ##' @name download.MACA ##' @title download.MACA ##' @export -##' @param outfolder +##' +##' @param outfolder location where output is stored ##' @param start_date , of the format "YEAR-01-01 00:00:00" ##' @param end_date , of the format "YEAR-12-31 23:59:59" -##' @param lat -##' @param lon ##' @param model , select which MACA model to run (options are BNU-ESM, CNRM-CM5, CSIRO-Mk3-6-0, bcc-csm1-1, bcc-csm1-1-m, CanESM2, GFDL-ESM2M, GFDL-ESM2G, HadGEM2-CC365, HadGEM2-ES365, inmcm4, MIROC5, MIROC-ESM, MIROC-ESM-CHEM, MRI-CGCM3, CCSM4, IPSL-CM5A-LR, IPSL-CM5A-MR, IPSL-CM5B-LR, NorESM1-M) ##' @param scenario , select which scenario to run (options are rcp45, rcp85) ##' @param ensemble_member , r1i1p1 is the only ensemble member available for this dataset, CCSM4 uses r6i1p1 instead +##' @param site_id BETY site id +##' @param lat.in latitude of site +##' @param lon.in longitude of site +##' @param overwrite overwrite existing files? Default is FALSE +##' @param verbose Default is FALSE, used as input in ncdf4::ncvar_def +##' @param ... other inputs ##' ##' @author James Simkins download.MACA <- function(outfolder, start_date, end_date, site_id, lat.in, lon.in, model='IPSL-CM5A-LR', scenario='rcp85', ensemble_member='r1i1p1', diff --git a/modules/data.atmosphere/R/download.MERRA.R b/modules/data.atmosphere/R/download.MERRA.R new file mode 100644 index 00000000000..a21502a38c9 --- /dev/null +++ b/modules/data.atmosphere/R/download.MERRA.R @@ -0,0 +1,326 @@ +#' Download MERRA data +#' +#' @inheritParams download.CRUNCEP +#' @param ... Not used -- silently soak up extra arguments from `convert.input`, etc. +#' @return `data.frame` of meteorology data metadata +#' @author Alexey Shiklomanov +#' @export +download.MERRA <- function(outfolder, start_date, end_date, + lat.in, lon.in, + overwrite = FALSE, + verbose = FALSE, + ...) { + + dates <- seq.Date(as.Date(start_date), as.Date(end_date), "1 day") + + dir.create(outfolder, showWarnings = FALSE, recursive = TRUE) + + # Download all MERRA files first. This skips files that have already been downloaded. + for (i in seq_along(dates)) { + date <- dates[[i]] + PEcAn.logger::logger.debug(paste0( + "Downloading ", as.character(date), " (", i, " of ", length(dates), ")" + )) + get_merra_date(date, lat.in, lon.in, outfolder, overwrite = overwrite) + } + + # Now, post-process + start_year <- lubridate::year(start_date) + end_year <- lubridate::year(end_date) + ylist <- seq(start_year, end_year) + + nyear <- length(ylist) + results <- data.frame( + file = character(nyear), + host = "", + mimetype = "", + formatname = "", + startdate = "", + enddate = "", + dbfile.name = "MERRA", + stringsAsFactors = FALSE + ) + + for (i in seq_len(nyear)) { + year <- ylist[i] + baseday <- paste0(year, "-01-01T00:00:00Z") + + # Accommodate partial years + y_startdate <- pmax(ISOdate(year, 01, 01, 0, tz = "UTC"), + lubridate::as_datetime(start_date)) + y_enddate <- pmin(ISOdate(year, 12, 31, 23, 59, 59, tz = "UTC"), + lubridate::as_datetime(paste(end_date, "23:59:59Z"))) + + timeseq <- as.numeric(difftime( + seq(y_startdate, y_enddate, "hours"), + baseday, + tz = "UTC", units = "days" + )) + ntime <- length(timeseq) + + loc.file <- file.path(outfolder, paste("MERRA", year, "nc", sep = ".")) + results$file[i] <- loc.file + results$host[i] <- PEcAn.remote::fqdn() + results$startdate[i] <- paste0(year, "-01-01 00:00:00") + results$enddate[i] <- paste0(year, "-12-31 23:59:59") + results$mimetype[i] <- "application/x-netcdf" + results$formatname[i] <- "CF Meteorology" + + ## Create dimensions + lat <- ncdf4::ncdim_def(name = "latitude", units = "degree_north", vals = lat.in, create_dimvar = TRUE) + lon <- ncdf4::ncdim_def(name = "longitude", units = "degree_east", vals = lon.in, create_dimvar = TRUE) + time <- ncdf4::ncdim_def(name = "time", units = paste("Days since ", baseday), + vals = timeseq, create_dimvar = TRUE, unlim = TRUE) + dim <- list(lat, lon, time) + + ## Create output variables + var_list <- list() + for (dat in list(merra_vars, merra_pres_vars, merra_flux_vars, merra_lfo_vars)) { + for (j in seq_len(nrow(dat))) { + var_list <- c(var_list, list(ncdf4::ncvar_def( + name = dat[j, ][["CF_name"]], + units = dat[j, ][["units"]], + dim = dim, + missval = -999 + ))) + } + } + + # Add additional derived flux variables + var_list <- c(var_list, list( + # Direct PAR + Direct NIR + ncdf4::ncvar_def( + name = "surface_direct_downwelling_shortwave_flux_in_air", + units = "W/m2", dim = dim, missval = -999 + ), + # Diffuse PAR + Diffuse NIR + ncdf4::ncvar_def( + name = "surface_diffuse_downwelling_shortwave_flux_in_air", + units = "W/m2", dim = dim, missval = -999 + ) + )) + + ## Create output file + if (file.exists(loc.file)) { + PEcAn.logger::logger.warn( + "Target file ", loc.file, " already exists.", + "It will be overwritten." + ) + } + loc <- ncdf4::nc_create(loc.file, var_list) + on.exit(ncdf4::nc_close(loc), add = TRUE) + + # Populate output file + dates_yr <- dates[lubridate::year(dates) == year] + for (d in seq_along(dates_yr)) { + date <- dates_yr[[d]] + end <- d * 24 + start <- end - 23 + mostfile <- file.path(outfolder, sprintf("merra-most-%s.nc", as.character(date))) + nc <- ncdf4::nc_open(mostfile) + for (r in seq_len(nrow(merra_vars))) { + x <- ncdf4::ncvar_get(nc, merra_vars[r,][["MERRA_name"]]) + ncdf4::ncvar_put(loc, merra_vars[r,][["CF_name"]], x, + start = c(1, 1, start), count = c(1, 1, 24)) + } + ncdf4::nc_close(nc) + presfile <- file.path(outfolder, sprintf("merra-pres-%s.nc", as.character(date))) + nc <- ncdf4::nc_open(presfile) + for (r in seq_len(nrow(merra_pres_vars))) { + x <- ncdf4::ncvar_get(nc, merra_pres_vars[r,][["MERRA_name"]]) + ncdf4::ncvar_put(loc, merra_pres_vars[r,][["CF_name"]], x, + start = c(1, 1, start), count = c(1, 1, 24)) + } + ncdf4::nc_close(nc) + fluxfile <- file.path(outfolder, sprintf("merra-flux-%s.nc", as.character(date))) + nc <- ncdf4::nc_open(fluxfile) + for (r in seq_len(nrow(merra_flux_vars))) { + x <- ncdf4::ncvar_get(nc, merra_flux_vars[r,][["MERRA_name"]]) + ncdf4::ncvar_put(loc, merra_flux_vars[r,][["CF_name"]], x, + start = c(1, 1, start), count = c(1, 1, 24)) + } + lfofile <- file.path(outfolder, sprintf("merra-lfo-%s.nc", as.character(date))) + nc <- ncdf4::nc_open(lfofile) + for (r in seq_len(nrow(merra_lfo_vars))) { + x <- ncdf4::ncvar_get(nc, merra_lfo_vars[r,][["MERRA_name"]]) + ncdf4::ncvar_put(loc, merra_lfo_vars[r,][["CF_name"]], x, + start = c(1, 1, start), count = c(1, 1, 24)) + } + + ncdf4::nc_close(nc) + } + + # Add derived variables + # Total SW diffuse = Diffuse PAR + Diffuse NIR + sw_diffuse <- + ncdf4::ncvar_get(loc, "surface_diffuse_downwelling_photosynthetic_radiative_flux_in_air") + + ncdf4::ncvar_get(loc, "surface_diffuse_downwelling_nearinfrared_radiative_flux_in_air") + ncdf4::ncvar_put(loc, "surface_diffuse_downwelling_shortwave_flux_in_air", sw_diffuse, + start = c(1, 1, 1), count = c(1, 1, -1)) + + # Total SW direct = Direct PAR + Direct NIR + sw_direct <- + ncdf4::ncvar_get(loc, "surface_direct_downwelling_photosynthetic_radiative_flux_in_air") + + ncdf4::ncvar_get(loc, "surface_direct_downwelling_nearinfrared_radiative_flux_in_air") + ncdf4::ncvar_put(loc, "surface_direct_downwelling_shortwave_flux_in_air", sw_direct, + start = c(1, 1, 1), count = c(1, 1, -1)) + } + + return(results) +} + +get_merra_date <- function(date, latitude, longitude, outdir, overwrite = FALSE) { + date <- as.character(date) + dpat <- "([[:digit:]]{4})-([[:digit:]]{2})-([[:digit:]]{2})" + year <- as.numeric(gsub(dpat, "\\1", date)) + month <- as.numeric(gsub(dpat, "\\2", date)) + day <- as.numeric(gsub(dpat, "\\3", date)) + dir.create(outdir, showWarnings = FALSE, recursive = TRUE) + version <- if (year >= 2011) { + 400 + } else if (year >= 2001) { + 300 + } else { + 200 + } + base_url <- "https://goldsmr4.gesdisc.eosdis.nasa.gov/opendap/MERRA2" + + lat_grid <- seq(-90, 90, 0.5) + lon_grid <- seq(-180, 180, 0.625) + ilat <- which.min(abs(lat_grid - latitude)) + ilon <- which.min(abs(lon_grid - longitude)) + idxstring <- sprintf("[0:1:23][%d][%d]", ilat, ilon) + + # Standard variables + url <- glue::glue( + "{base_url}/{merra_prod}/{year}/{sprintf('%02d', month)}/", + "MERRA2_{version}.{merra_file}.", + "{year}{sprintf('%02d', month)}{sprintf('%02d', day)}.nc4.nc4" + ) + qvars <- sprintf("%s%s", merra_vars$MERRA_name, idxstring) + qstring <- paste(qvars, collapse = ",") + outfile <- file.path(outdir, sprintf("merra-most-%d-%02d-%02d.nc", + year, month, day)) + if (overwrite || !file.exists(outfile)) { + req <- httr::GET( + paste(url, qstring, sep = "?"), + httr::authenticate(user = "pecanproject", password = "Data4pecan3"), + httr::write_disk(outfile, overwrite = TRUE) + ) + } + + # Pressure + url <- glue::glue( + "{base_url}/{merra_pres_prod}/{year}/{sprintf('%02d', month)}/", + "MERRA2_{version}.{merra_pres_file}.", + "{year}{sprintf('%02d', month)}{sprintf('%02d', day)}.nc4.nc4" + ) + qvars <- sprintf("%s%s", merra_pres_vars$MERRA_name, idxstring) + qstring <- paste(qvars, collapse = ",") + outfile <- file.path(outdir, sprintf("merra-pres-%d-%02d-%02d.nc", + year, month, day)) + if (overwrite || !file.exists(outfile)) { + req <- httr::GET( + paste(url, qstring, sep = "?"), + httr::authenticate(user = "pecanproject", password = "Data4pecan3"), + httr::write_disk(outfile, overwrite = TRUE) + ) + } + + # Flux + url <- glue::glue( + "{base_url}/{merra_flux_prod}/{year}/{sprintf('%02d', month)}/", + "MERRA2_{version}.{merra_flux_file}.", + "{year}{sprintf('%02d', month)}{sprintf('%02d', day)}.nc4.nc4" + ) + qvars <- sprintf("%s%s", merra_flux_vars$MERRA_name, idxstring) + qstring <- paste(qvars, collapse = ",") + outfile <- file.path(outdir, sprintf("merra-flux-%d-%02d-%02d.nc", + year, month, day)) + if (overwrite || !file.exists(outfile)) { + req <- robustly(httr::GET, n = 10)( + paste(url, qstring, sep = "?"), + httr::authenticate(user = "pecanproject", password = "Data4pecan3"), + httr::write_disk(outfile, overwrite = TRUE) + ) + } + + # Land forcing + url <- glue::glue( + "{base_url}/{merra_lfo_prod}/{year}/{sprintf('%02d', month)}/", + "MERRA2_{version}.{merra_lfo_file}.", + "{year}{sprintf('%02d', month)}{sprintf('%02d', day)}.nc4.nc4" + ) + qvars <- sprintf("%s%s", merra_lfo_vars$MERRA_name, idxstring) + qstring <- paste(qvars, collapse = ",") + outfile <- file.path(outdir, sprintf("merra-lfo-%d-%02d-%02d.nc", + year, month, day)) + if (overwrite || !file.exists(outfile)) { + req <- robustly(httr::GET, n = 10)( + paste(url, qstring, sep = "?"), + httr::authenticate(user = "pecanproject", password = "Data4pecan3"), + httr::write_disk(outfile, overwrite = TRUE) + ) + } +} + +# For more on MERRA variables, see: +# - The MERRA2 readme -- https://goldsmr4.gesdisc.eosdis.nasa.gov/data/MERRA2/M2T1NXRAD.5.12.4/doc/MERRA2.README.pdf +# - The MERRA2 file spec -- https://gmao.gsfc.nasa.gov/pubs/docs/Bosilovich785.pdf +# Page numbers below correspond to pages in the file spec. + +# Surface flux diagnostics (pg. 33) +merra_prod <- "M2T1NXFLX.5.12.4" +merra_file <- "tavg1_2d_flx_Nx" +merra_vars <- tibble::tribble( + ~CF_name, ~MERRA_name, ~units, + # TLML - Surface air temperature + "air_temperature", "TLML", "Kelvin", + # ULML - Surface eastward wind + "eastward_wind", "ULML", "m/s", + # VLML - Surface northward wind + "northward_wind", "VLML", "m/s", + # QSH - Effective surface specific humidity + "specific_humidity", "QSH", "g/g", + # PRECTOT - Total precipitation from atmospheric model physics + "precipitation_flux", "PRECTOT", "kg/m2/s", + # NIRDF - Surface downwelling nearinfared diffuse flux + "surface_diffuse_downwelling_nearinfrared_radiative_flux_in_air", "NIRDF", "W/m2", + # NIRDR - Surface downwelling nearinfrared beam flux + "surface_direct_downwelling_nearinfrared_radiative_flux_in_air", "NIRDR", "W/m2" +) + +# Single-level diagnostics (pg. 17) +merra_pres_prod <- "M2I1NXASM.5.12.4" +merra_pres_file <- "inst1_2d_asm_Nx" +merra_pres_vars <- tibble::tribble( + ~CF_name, ~MERRA_name, ~units, + # PS - Surface pressure + "air_pressure", "PS", "Pascal", +) + +# Radiation diagnostics (pg. 43) +# NOTE: Downwelling longwave is calculated as Net + Absorbed + Emitted (because +# Net = Downwelling - Absorbed - Emitted). +merra_flux_prod <- "M2T1NXRAD.5.12.4" +merra_flux_file <- "tavg1_2d_rad_Nx" +merra_flux_vars <- tibble::tribble( + ~CF_name, ~MERRA_name, ~units, + # LWGAB is 'Surface absorbed longwave radiation' -- In MERRA, surface net + # longwave flux is `absorbed - emitted`, so we assume this is the correct variable + "surface_downwelling_longwave_flux_in_air", "LWGAB", "W/m2", + # SWGDN is 'Surface incoming shortwave flux' + "surface_downwelling_shortwave_flux_in_air", "SWGDN", "W/m2" +) + + +# Land surface forcings (pg. 39) +merra_lfo_prod <- "M2T1NXLFO.5.12.4" +merra_lfo_file <- "tavg1_2d_lfo_Nx" +merra_lfo_vars <- tibble::tribble( + ~CF_name, ~MERRA_name, ~units, + # Surface downwelling PAR diffuse flux, PARDF + "surface_diffuse_downwelling_photosynthetic_radiative_flux_in_air", "PARDF", "W/m2", + # Surface downwelling PAR beam flux, PARDR + "surface_direct_downwelling_photosynthetic_radiative_flux_in_air", "PARDR", "W/m2" +) diff --git a/modules/data.atmosphere/R/download.MsTMIP_NARR.R b/modules/data.atmosphere/R/download.MsTMIP_NARR.R index 73937411785..5a0c66e86f8 100644 --- a/modules/data.atmosphere/R/download.MsTMIP_NARR.R +++ b/modules/data.atmosphere/R/download.MsTMIP_NARR.R @@ -2,11 +2,16 @@ ##' @name download.MsTMIP_NARR ##' @title download.MsTMIP_NARR ##' @export -##' @param outfolder +##' +##' @param outfolder location where output is stored ##' @param start_date YYYY-MM-DD +##' @param site_id BETY site id +##' @param lat.in latitude of site +##' @param lon.in longitude of site +##' @param overwrite overwrite existing files? Default is FALSE +##' @param verbose Default is FALSE, used in ncdf4::ncvar_def +##' @param ... Other inputs ##' @param end_date YYYY-MM-DD -##' @param lat decimal degrees [-90, 90] -##' @param lon decimal degrees [-180, 180] ##' ##' @author James Simkins download.MsTMIP_NARR <- function(outfolder, start_date, end_date, site_id, lat.in, lon.in, diff --git a/modules/data.atmosphere/R/download.NARR.R b/modules/data.atmosphere/R/download.NARR.R index 364d3110dc6..19e117042d6 100644 --- a/modules/data.atmosphere/R/download.NARR.R +++ b/modules/data.atmosphere/R/download.NARR.R @@ -1,11 +1,12 @@ ##' Download NARR files ##' -##' @param outfolder -##' @param start_year -##' @param end_year +##' @param outfolder location where output is stored ##' @param overwrite Overwrite existing files? Default=FALSE ##' @param verbose Turn on verbose output? Default=FALSE ##' @param method Method of file retrieval. Can set this using the options(download.ftp.method=[method]) in your Rprofile. +##' @param start_date desired start date YYYY-MM-DD +##' @param end_date desired end date YYYY-MM-DD +##' @param ... other inputs ##' example options(download.ftp.method="ncftpget") ##' @importFrom magrittr %>% ##' diff --git a/modules/data.atmosphere/R/download.NARR_site.R b/modules/data.atmosphere/R/download.NARR_site.R index d63e71ab2f9..61195cbdbea 100644 --- a/modules/data.atmosphere/R/download.NARR_site.R +++ b/modules/data.atmosphere/R/download.NARR_site.R @@ -8,15 +8,15 @@ #' @param overwrite Overwrite existing files? Default=FALSE #' @param verbose Turn on verbose output? Default=FALSE #' @param parallel Download in parallel? Default = TRUE -#' @param ncores Number of cores for parallel download. Default is +#' @param ncores Number of cores for parallel download. Default is #' `parallel::detectCores()` #' #' @examples -#' +#' #' \dontrun{ #' download.NARR_site(tempdir(), "2001-01-01", "2001-01-12", 43.372, -89.907) #' } -#' +#' #' #' @export #' @@ -44,13 +44,13 @@ download.NARR_site <- function(outfolder, narr_byyear <- narr_data %>% dplyr::mutate(year = lubridate::year(datetime)) %>% - dplyr::group_by(year) %>% + dplyr::group_by(.data$year) %>% tidyr::nest() # Prepare result data frame result_full <- narr_byyear %>% dplyr::mutate( - file = file.path(outfolder, paste("NARR", year, "nc", sep = ".")), + file = file.path(outfolder, paste("NARR", .data$year, "nc", sep = ".")), host = PEcAn.remote::fqdn(), start_date = date_limits_chr[1], end_date = date_limits_chr[2], @@ -73,10 +73,10 @@ download.NARR_site <- function(outfolder, narr_proc <- result_full %>% dplyr::mutate( - data_nc = purrr::map2(data, file, prepare_narr_year, lat = lat, lon = lon) + data_nc = purrr::map2(.data$data, .data$file, prepare_narr_year, lat = lat, lon = lon) ) - results <- dplyr::select(result_full, -data) + results <- dplyr::select(result_full, -.data$data) return(invisible(results)) } # download.NARR_site @@ -86,8 +86,8 @@ download.NARR_site <- function(outfolder, #' @param file Full path to target file #' @param lat_nc `ncdim` object for latitude #' @param lon_nc `ncdim` object for longitude -#' @param verbose -#' @return List of NetCDF variables in data. Creates NetCDF file containing +#' @param verbose logical: ask`ncdf4` functions to be very chatty while they work? +#' @return List of NetCDF variables in data. Creates NetCDF file containing #' data as a side effect prepare_narr_year <- function(dat, file, lat_nc, lon_nc, verbose = FALSE) { starttime <- min(dat$datetime) @@ -109,7 +109,7 @@ prepare_narr_year <- function(dat, file, lat_nc, lon_nc, verbose = FALSE) { dims = list(lat_nc, lon_nc, time_nc) ) nc <- ncdf4::nc_create(file, ncvar_list, verbose = verbose) - on.exit(ncdf4::nc_close(nc)) + on.exit(ncdf4::nc_close(nc), add = TRUE) purrr::iwalk(nc_values, ~ncdf4::ncvar_put(nc, .y, .x, verbose = verbose)) invisible(ncvar_list) } @@ -117,11 +117,11 @@ prepare_narr_year <- function(dat, file, lat_nc, lon_nc, verbose = FALSE) { #' Create `ncvar` object from variable name #' #' @param variable CF variable name -#' @param dims List of NetCDF dimension objects (passed to +#' @param dims List of NetCDF dimension objects (passed to #' `ncdf4::ncvar_def(..., dim)`) #' @return `ncvar` object (from `ncvar_def`) col2ncvar <- function(variable, dims) { - var_info <- narr_all_vars %>% dplyr::filter(CF_name == variable) + var_info <- narr_all_vars %>% dplyr::filter(.data$CF_name == variable) ncdf4::ncvar_def( name = variable, units = var_info$units, @@ -136,9 +136,9 @@ col2ncvar <- function(variable, dims) { #' @param end_date End date for meteorology #' @param lat.in Latitude coordinate #' @param lon.in Longitude coordinate -#' @param progress Whether or not to show a progress bar (default = `TRUE`). +#' @param progress Whether or not to show a progress bar (default = `TRUE`). #' Requires the `progress` package to be installed. -#' @param drop_outside Whether or not to drop dates outside of `start_date` to +#' @param drop_outside Whether or not to drop dates outside of `start_date` to #' `end_date` range (default = `TRUE`). #' @inheritParams download.NARR_site #' @return `tibble` containing time series of NARR data for the given site @@ -209,7 +209,7 @@ get_NARR_thredds <- function(start_date, end_date, lat.in, lon.in, # Load dimensions, etc. from first netCDF file nc1 <- robustly(ncdf4::nc_open, n = 20, timeout = 0.5)(flx_df$url[1]) - on.exit(ncdf4::nc_close(nc1)) + on.exit(ncdf4::nc_close(nc1), add = TRUE) xy <- latlon2narr(nc1, lat.in, lon.in) if (parallel) { @@ -228,6 +228,7 @@ get_NARR_thredds <- function(start_date, end_date, lat.in, lon.in, get_dfs <- dplyr::bind_rows(flx_df, sfc_df) cl <- parallel::makeCluster(ncores) doParallel::registerDoParallel(cl) + flx <- NULL get_dfs$data <- foreach::`%dopar%`( foreach::foreach( url = get_dfs$url, flx = get_dfs$flx, @@ -236,8 +237,8 @@ get_NARR_thredds <- function(start_date, end_date, lat.in, lon.in, ), robustly(get_narr_url)(url, xy = xy, flx = flx) ) - flx_data_raw <- dplyr::filter(get_dfs, flx) - sfc_data_raw <- dplyr::filter(get_dfs, !flx) + flx_data_raw <- dplyr::filter(get_dfs, .data$flx) + sfc_data_raw <- dplyr::filter(get_dfs, !.data$flx) } else { # Retrieve remaining variables by iterating over URLs @@ -294,21 +295,21 @@ get_NARR_thredds <- function(start_date, end_date, lat.in, lon.in, #' @param dat Nested `tibble` from mapped call to [get_narr_url] post_process <- function(dat) { dat %>% - tidyr::unnest(data) %>% + tidyr::unnest(.data$data) %>% dplyr::ungroup() %>% - dplyr::mutate(datetime = startdate + lubridate::dhours(dhours)) %>% - dplyr::select(-startdate, -dhours) %>% + dplyr::mutate(datetime = .data$startdate + lubridate::dhours(.data$dhours)) %>% + dplyr::select(-.data$startdate, -.data$dhours) %>% dplyr::select(datetime, dplyr::everything()) %>% dplyr::select(-url, url) } #' Generate NARR url from a vector of dates #' -#' Figures out file names for the given dates, based on NARR's convoluted and +#' Figures out file names for the given dates, based on NARR's convoluted and #' inconsistent naming scheme. #' #' @param dates Vector of dates for which to generate URL -#' @param flx (Logical) If `TRUE`, format for `flx` variables. Otherwise, +#' @param flx (Logical) If `TRUE`, format for `flx` variables. Otherwise, #' format for `sfc` variables. See [narr_flx_vars]. #' @author Alexey Shiklomanov generate_narr_url <- function(dates, flx) { @@ -322,25 +323,25 @@ generate_narr_url <- function(dates, flx) { ) tibble::tibble(date = dates) %>% dplyr::mutate( - year = lubridate::year(date), - month = lubridate::month(date), - daygroup = daygroup(date, flx) + year = lubridate::year(.data$date), + month = lubridate::month(.data$date), + daygroup = daygroup(.data$date, flx) ) %>% - dplyr::group_by(year, month, daygroup) %>% + dplyr::group_by(.data$year, .data$month, .data$daygroup) %>% dplyr::summarize( - startdate = min(date), + startdate = min(.data$date), url = sprintf( "%s/%d/NARR%s_%d%02d_%s.tar", base_url, - unique(year), + unique(.data$year), tag, - unique(year), - unique(month), - unique(daygroup) + unique(.data$year), + unique(.data$month), + unique(.data$daygroup) ) ) %>% dplyr::ungroup() %>% - dplyr::select(startdate, url) + dplyr::select(.data$startdate, .data$url) } #' Assign daygroup tag for a given date @@ -373,7 +374,7 @@ daygroup <- function(date, flx) { get_narr_url <- function(url, xy, flx, pb = NULL) { stopifnot(length(xy) == 2, length(url) == 1, is.character(url)) nc <- ncdf4::nc_open(url) - on.exit(ncdf4::nc_close(nc)) + on.exit(ncdf4::nc_close(nc), add = TRUE) timevar <- if (flx) "time" else "reftime" dhours <- ncdf4::ncvar_get(nc, timevar) # HACK: Time variable seems inconsistent. @@ -382,7 +383,7 @@ get_narr_url <- function(url, xy, flx, pb = NULL) { if (dhours[1] == 3) dhours <- dhours - 3 narr_vars <- if (flx) narr_flx_vars else narr_sfc_vars result <- purrr::pmap( - narr_vars %>% dplyr::select(variable = NARR_name, unit = units), + narr_vars %>% dplyr::select(variable = .data$NARR_name, unit = .data$units), read_narr_var, nc = nc, xy = xy, flx = flx, pb = pb ) @@ -445,7 +446,7 @@ narr_all_vars <- dplyr::bind_rows(narr_flx_vars, narr_sfc_vars) #' #' @inheritParams read_narr_var #' @inheritParams get_NARR_thredds -#' @return Vector length 2 containing NARR `x` and `y` indices, which can be +#' @return Vector length 2 containing NARR `x` and `y` indices, which can be #' used in `ncdf4::ncvar_get` `start` argument. #' @author Alexey Shiklomanov latlon2narr <- function(nc, lat.in, lon.in) { @@ -457,11 +458,11 @@ latlon2narr <- function(nc, lat.in, lon.in) { c(x = x_ind, y = y_ind) } -#' Convert latitude and longitude to x-y coordinates (in km) in Lambert +#' Convert latitude and longitude to x-y coordinates (in km) in Lambert #' conformal conic projection (used by NARR) #' #' @inheritParams get_NARR_thredds -#' @return `sp::SpatialPoints` object containing transformed x and y +#' @return `sp::SpatialPoints` object containing transformed x and y #' coordinates, in km, which should match NARR coordinates #' @importFrom rgdal checkCRSArgs # ^not used directly here, but needed by sp::CRS. diff --git a/modules/data.atmosphere/R/download.NLDAS.R b/modules/data.atmosphere/R/download.NLDAS.R index c8a2fe00661..7e028ea5fe3 100644 --- a/modules/data.atmosphere/R/download.NLDAS.R +++ b/modules/data.atmosphere/R/download.NLDAS.R @@ -2,12 +2,16 @@ ##' ##' Download and convert single grid point NLDAS to CF single grid point from hydro1.sci.gsfc.nasa.gov using OPENDAP interface ##' -##' @param outfolder -##' @param start_date -##' @param end_date -##' @param site_id -##' @param lat -##' @param lon +##' @param outfolder location of output +##' @param start_date desired start date YYYY-MM-DD +##' @param end_date desired end date YYYY-MM-DD +##' @param lat.in latitude of site +##' @param lon.in longitude of site +##' @param overwrite overwrite existing files? Default is FALSE +##' @param verbose Turn on verbose output? Default=FALSE +##' @param ... Other inputs +##' @param site_id site id (BETY) +##' ##' @export ##' ##' @author Christy Rollinson (with help from Ankur Desai) diff --git a/modules/data.atmosphere/R/download.NOAA_GEFS.R b/modules/data.atmosphere/R/download.NOAA_GEFS.R index eda2354cac5..d3c6045f8e6 100644 --- a/modules/data.atmosphere/R/download.NOAA_GEFS.R +++ b/modules/data.atmosphere/R/download.NOAA_GEFS.R @@ -1,13 +1,14 @@ ##' @title Download NOAA GEFS Weather Data ##' ##' @section Information on Units: -##' Information on NOAA weather units can be found below. Note that the temperature is measured in degrees C, but is converted at the station and downlaoded -##' in Kelvin. +##' Information on NOAA weather units can be found below. Note that the temperature is measured in degrees C, +##' but is converted at the station and downlaoded in Kelvin. ##' @references https://www.ncdc.noaa.gov/crn/measurements.html ##' ##' @section NOAA_GEFS General Information: -##' This function downloads NOAA GEFS weather data. GEFS is an ensemble of 21 different weather forecast models. A 16 day forecast is avaliable -##' every 6 hours. Each forecast includes information on a total of 8 variables. These are transformed from the NOAA standard to the internal PEcAn +##' This function downloads NOAA GEFS weather data. GEFS is an ensemble of 21 different weather forecast models. +##' A 16 day forecast is avaliable every 6 hours. Each forecast includes information on a total of 8 variables. +##' These are transformed from the NOAA standard to the internal PEcAn ##' standard. ##' ##' @section Data Avaliability: @@ -25,249 +26,73 @@ ##' data frame contains information about one file. ##' ##' @param outfolder Directory where results should be written -##' @param start_date, end_date Range of dates/times to be downloaded (default assumed time of day is 0:00, midnight) -##' @param lat site latitude in decimal degrees -##' @param lon site longitude in decimal degrees -##' @param sitename The unique ID given to each site. This is used as part of the file name. +##' @param start_date, Range of dates/times to be downloaded (default assumed to be time that function is run) +##' @param end_date, end date for range of dates to be downloaded (default 16 days from start_date) +##' @param lat.in site latitude in decimal degrees +##' @param lon.in site longitude in decimal degrees +##' @param site_id The unique ID given to each site. This is used as part of the file name. +##' @param sitename Site name +##' @param username username from pecan workflow ##' @param overwrite logical. Download a fresh version even if a local file with the same name already exists? -##' @param verbose logical. Print additional debug information. Passed on to functions in the netcdf4 package to provide debugging info. -##' @param ... Other arguments, currently ignored +##' @param downscale logical, assumed True. Indicated whether data should be downscaled to hourly +##' @param ... Additional optional parameters +##' ##' @export ##' ##' @examples ##' \dontrun{ -##' download.NOAA_GEFS(outfolder="~/Working/results", lat.in= 45.805925, lon.in = -90.07961, sitename="US-WCr") +##' download.NOAA_GEFS(outfolder="~/Working/results", +##' lat.in= 45.805925, +##' lon.in = -90.07961, +##' site_id = 676) ##' } ##' -##' @author Luke Dramko +##' @author Quinn Thomas, modified by K Zarada ##' -download.NOAA_GEFS <- function(outfolder, lat.in, lon.in, sitename, start_date = Sys.time(), end_date = (as.POSIXct(start_date, tz="UTC") + lubridate::days(16)), - overwrite = FALSE, verbose = FALSE, ...) { - - start_date <- as.POSIXct(start_date, tz = "UTC") - end_date <- as.POSIXct(end_date, tz = "UTC") - - #It takes about 2 hours for NOAA GEFS weather data to be posted. Therefore, if a request is made within that 2 hour window, - #we instead want to adjust the start time to the previous forecast, which is the most recent one avaliable. (For example, if - #there's a request at 7:00 a.m., the data isn't up yet, so the function grabs the data at midnight instead.) - if (abs(as.numeric(Sys.time() - start_date, units="hours")) <= 2) { - start_date = start_date - lubridate::hours(2) - end_date = end_date - lubridate::hours(2) - } - - #Date/time error checking - Checks to see if the start date is before the end date - if (start_date > end_date) { - PEcAn.logger::logger.severe("Invalid dates: end date occurs before start date") - } else if (as.numeric(end_date - start_date, units="hours") < 6) { #Done separately to produce a more helpful error message. - PEcAn.logger::logger.severe("Times not far enough appart for a forecast to fall between them. Forecasts occur every six hours; make sure start - and end dates are at least 6 hours appart.") - } - - #Set the end forecast date (default is the full 16 days) - if (end_date > start_date + lubridate::days(16)) { - end_date = start_date + lubridate::days(16) - } - - #Round the starting date/time down to the previous block of 6 hours. Adjust the time frame to match. - forecast_hour = (lubridate::hour(start_date) %/% 6) * 6 #Integer division by 6 followed by re-multiplication acts like a "floor function" for multiples of 6 - increments = as.integer(as.numeric(end_date - start_date, units = "hours") / 6) #Calculating the number of forecasts between start and end dates. - increments = increments + ((lubridate::hour(end_date) - lubridate::hour(start_date)) %/% 6) #These calculations are required to use the rnoaa package. - - end_hour = sprintf("%04d", ((forecast_hour + (increments * 6)) %% 24) * 100) #Calculating the starting hour as a string, which is required type to access the - #data via the rnoaa package - forecast_hour = sprintf("%04d", forecast_hour * 100) #Having the end date as a string is useful later, too. - - #Recreate the adjusted start and end dates. - start_date = as.POSIXct(paste0(lubridate::year(start_date), "-", lubridate::month(start_date), "-", lubridate::day(start_date), " ", - substring(forecast_hour, 1,2), ":00:00"), tz="UTC") - end_date = start_date + lubridate::hours(increments * 6) - - #Bounds date checking - #NOAA's GEFS database maintains a rolling 12 days of forecast data for access through this function. - #We do want Sys.Date() here - NOAA makes data unavaliable days at a time, not forecasts at a time. - NOAA_GEFS_Start_Date = as.POSIXct(Sys.Date(), tz="UTC") - lubridate::days(11) #Subtracting 11 days is correct, not 12. - - #Check to see if start_date is valid. This must be done after date adjustment. - if (as.POSIXct(Sys.time(), tz="UTC") < start_date || start_date < NOAA_GEFS_Start_Date) { - PEcAn.logger::logger.severe(sprintf('Start date (%s) exceeds the NOAA GEFS range (%s to %s).', - start_date, - NOAA_GEFS_Start_Date, Sys.Date())) - } - - if (lubridate::hour(start_date) > 23) { - PEcAn.logger::logger.severe(sprintf("Start time %s is not a valid time", lubridate::hour(start_date))) - } - - if (lubridate::hour(end_date) > 23) { #Done separately from the previous if statement in order to have more specific error messages. - PEcAn.logger::logger.severe(sprintf("End time %s is not a valid time", lubridate::hour(end_date))) - } - #End date/time error checking - - ################################################# - #NOAA variable downloading - #Uses the rnoaa package to download data - - #We want data for each of the following variables. Here, we're just getting the raw data; later, we will convert it to the - #cf standard format when relevant. - noaa_var_names = c("Temperature_height_above_ground_ens", "Pressure_surface_ens", "Relative_humidity_height_above_ground_ens", "Downward_Long-Wave_Radp_Flux_surface_6_Hour_Average_ens", - "Downward_Short-Wave_Radiation_Flux_surface_6_Hour_Average_ens", "Total_precipitation_surface_6_Hour_Accumulation_ens", - "u-component_of_wind_height_above_ground_ens", "v-component_of_wind_height_above_ground_ens") - - #These are the cf standard names - cf_var_names = c("air_temperature", "air_pressure", "specific_humidity", "surface_downwelling_longwave_flux_in_air", - "surface_downwelling_shortwave_flux_in_air", "precipitation_flux", "eastward_wind", "northward_wind") - cf_var_units = c("K", "Pa", "1", "Wm-2", "Wm-2", "kgm-2s-1", "ms-1", "ms-1") #Negative numbers indicate negative exponents - - # This debugging loop allows you to check if the cf variables are correctly mapped to the equivalent - # NOAA variable names. This is very important, as much of the processing below will be erroneous if - # these fail to match up. - # for (i in 1:length(cf_var_names)) { - # print(sprintf("cf / noaa : %s / %s", cf_var_names[[i]], noaa_var_names[[i]])) - #} - - noaa_data = list() - - #Downloading the data here. It is stored in a matrix, where columns represent time in intervals of 6 hours, and rows represent - #each ensemble member. Each variable gets its own matrix, which is stored in the list noaa_data. - for (i in 1:length(noaa_var_names)) { - noaa_data[[i]] = rnoaa::gefs(noaa_var_names[i], lat.in, lon.in, raw=TRUE, time_idx = 1:increments, forecast_time = forecast_hour, date=format(start_date, "%Y%m%d"))$data - } - - #Fills in data with NaNs if there happens to be missing columns. - for (i in 1:length(noaa_var_names)) { - if (!is.null(ncol(noaa_data[[i]]))) { # Is a matrix - nans <- rep(NaN, nrow(noaa_data[[i]])) - while (ncol(noaa_data[[i]]) < increments) { - noaa_data[[i]] <- cbind(noaa_data[[i]], nans) - } - } else { # Is a vector - while (length(noaa_data[[i]]) < increments) { - noaa_data[[i]] <- c(noaa_data[[i]], NaN); - } - } - } - - ################################################### - # Not all NOAA data units match the cf data standard. In this next section, data are processed to - # confirm with the standard when necessary. - # The following is a list of variables which need to be processed: - # 1. NOAA's relative humidity must be converted to specific humidity - # 2. NOAA's measure of precipitation is the accumulation over 6 hours; cf's standard is precipitation per second - - #Convert NOAA's relative humidity to specific humidity - humid_index = which(cf_var_names == "specific_humidity") - - #Temperature, pressure, and relative humidity are required to calculate specific humidity. - humid_data = noaa_data[[humid_index]] - temperature_data = noaa_data[[which(cf_var_names == "air_temperature")]] - pressure_data = noaa_data[[which(cf_var_names == "air_pressure")]] - - #Depending on the volume and dimensions of data you download, sometimes R stores it as a vector and sometimes - #as a matrix; the different cases must be processed with different loops. - #(The specific corner case in which a vector would be generated is if only one hour is requested; for example, - #only the data at time_idx 1, for example). - if (as.logical(nrow(humid_data))) { - for (i in 1:length(humid_data)) { - humid_data[i] = PEcAn.data.atmosphere::rh2qair(humid_data[i], temperature_data[i], pressure_data[i]) - } - } else { - for (i in 1:nrow(humid_data)) { - for (j in 1:ncol(humid_data)) { - humid_data[i,j] = PEcAn.data.atmosphere::rh2qair(humid_data[i,j], temperature_data[i,j], pressure_data[i,j]) - } - } - } - - #Update the noaa_data list with the correct data - noaa_data[[humid_index]] <- humid_data - - # Convert NOAA's total precipitation (kg m-2) to precipitation flux (kg m-2 s-1) - #NOAA precipitation data is an accumulation over 6 hours. - precip_index = which(cf_var_names == "precipitation_flux") - - #The statement udunits2::ud.convert(1, "kg m-2 6 hr-1", "kg m-2 s-1") is equivalent to udunits2::ud.convert(1, "kg m-2 hr-1", "kg m-2 s-1") * 6, - #which is a little unintuitive. What will do the conversion we want is what's below: - noaa_data[[precip_index]] = udunits2::ud.convert(noaa_data[[precip_index]], "kg m-2 hr-1", "kg m-2 6 s-1") #There are 21600 seconds in 6 hours - - ############################################# - # Done with data processing. Now writing the data to the specified directory. Each ensemble member is written to its own file, for a total - # of 21 files. - if (!dir.exists(outfolder)) { - dir.create(outfolder, recursive=TRUE, showWarnings = FALSE) - } - - # Create a data frame with information about the file. This data frame's format is an internal PEcAn standard, and is stored in the BETY database to - # locate the data file. The data file is stored on the local machine where the download occured. Because NOAA GEFS is an - # ensemble of 21 different forecast models, each model gets its own data frame. All of the information is the same for - # each file except for the file name. - results = data.frame( - file = "", #Path to the file (added in loop below). - host = PEcAn.remote::fqdn(), #Name of the server where the file is stored - mimetype = "application/x-netcdf", #Format the data is saved in - formatname = "CF Meteorology", #Type of data - startdate = paste0(format(start_date, "%Y-%m-%dT%H:%M:00")), #starting date and time, down to the second - enddate = paste0(format(end_date, "%Y-%m-%dT%H:%M:00")), #ending date and time, down to the second - dbfile.name = "NOAA_GEFS", #Source of data (ensemble number will be added later) - stringsAsFactors = FALSE - ) - - results_list = list() - - #Each ensemble gets its own file. - #These dimensions will be used for all 21 ncdf4 file members, so they're all declared once here. - #The data is really one-dimensional for each file (though we include lattitude and longitude dimensions - #to comply with the PEcAn standard). - time_dim = ncdf4::ncdim_def(name="time", - paste(units="hours since", format(start_date, "%Y-%m-%dT%H:%M")), - seq(6, 6 * increments, by = 6), - create_dimvar = TRUE) - lat_dim = ncdf4::ncdim_def("latitude", "degree_north", lat.in, create_dimvar = TRUE) - lon_dim = ncdf4::ncdim_def("longitude", "degree_east", lon.in, create_dimvar = TRUE) - - dimensions_list = list(time_dim, lat_dim, lon_dim) - - nc_var_list = list() - for (i in 1:length(cf_var_names)) { #Each ensemble member will have data on each variable stored in their respective file. - nc_var_list[[i]] = ncdf4::ncvar_def(cf_var_names[i], cf_var_units[i], dimensions_list, missval=NaN) - } - - #For each ensemble - for (i in 1:21) { # i is the ensemble number - #Generating a unique identifier string that characterizes a particular data set. - identifier = paste("NOAA_GEFS", sitename, i, format(start_date, "%Y-%m-%dT%H:%M"), - format(end_date, "%Y-%m-%dT%H:%M"), sep=".") - - ensemble_folder = file.path(outfolder, identifier) - - #Each file will go in its own folder. - if (!dir.exists(ensemble_folder)) { - dir.create(ensemble_folder, recursive=TRUE, showWarnings = FALSE) - } - - flname = file.path(ensemble_folder, paste(identifier, "nc", sep = ".")) - - #Each ensemble member gets its own unique data frame, which is stored in results_list - #Object references in R work differently than in other languages. When adding an item to a list, R creates a copy of it - #for you instead of just inserting the object reference, so this works. - results$file <- flname - results$dbfile.name <- flname - results_list[[i]] <- results - - if (!file.exists(flname) | overwrite) { - nc_flptr = ncdf4::nc_create(flname, nc_var_list, verbose=verbose) - - #For each variable associated with that ensemble - for (j in 1:length(cf_var_names)) { - # "j" is the variable number. "i" is the ensemble number. Remember that each row represents an ensemble - ncdf4::ncvar_put(nc_flptr, nc_var_list[[j]], noaa_data[[j]][i,]) - } - - ncdf4::nc_close(nc_flptr) #Write to the disk/storage - } else { - PEcAn.logger::logger.info(paste0("The file ", flname, " already exists. It was not overwritten.")) - } - - } - - return(results_list) -} #download.NOAA_GEFS \ No newline at end of file +download.NOAA_GEFS <- function(site_id, + sitename = NULL, + username = 'pecan', + lat.in, + lon.in, + outfolder, + start_date= Sys.Date(), + end_date = start_date + lubridate::days(16), + downscale = TRUE, + overwrite = FALSE, + ...){ + + forecast_date = as.Date(start_date) + forecast_time = (lubridate::hour(start_date) %/% 6)*6 + + end_hr = (as.numeric(difftime(end_date, start_date, units = 'hours')) %/% 6)*6 + + model_name <- "NOAAGEFS_6hr" + model_name_ds <-"NOAAGEFS_1hr" #Downscaled NOAA GEFS + model_name_raw <- "NOAAGEFS_raw" + + PEcAn.logger::logger.info(paste0("Downloading GEFS for site ", site_id, " for ", start_date)) + + PEcAn.logger::logger.info(paste0("Overwrite existing files: ", overwrite)) + + + noaa_grid_download(lat_list = lat.in, + lon_list = lon.in, + end_hr = end_hr, + forecast_time = forecast_time, + forecast_date = forecast_date, + model_name_raw = model_name_raw, + output_directory = outfolder) + + results <- process_gridded_noaa_download(lat_list = lat.in, + lon_list = lon.in, + site_id = site_id, + downscale = downscale, + overwrite = overwrite, + forecast_date = forecast_date, + forecast_time = forecast_time, + model_name = model_name, + model_name_ds = model_name_ds, + model_name_raw = model_name_raw, + output_directory = outfolder) + return(results) +} \ No newline at end of file diff --git a/modules/data.atmosphere/R/download.NOAA_GEFS_downscale.R b/modules/data.atmosphere/R/download.NOAA_GEFS_downscale.R deleted file mode 100644 index e23404f4835..00000000000 --- a/modules/data.atmosphere/R/download.NOAA_GEFS_downscale.R +++ /dev/null @@ -1,345 +0,0 @@ -##' @title Downscale NOAA GEFS Weather Data -##' -##' @section Information on Units: -##' Information on NOAA weather units can be found below. Note that the temperature is measured in degrees C, but is converted at the station and downlaoded -##' in Kelvin. -##' @references https://www.ncdc.noaa.gov/crn/measurements.html -##' -##' @section NOAA_GEFS General Information: -##' This function downloads NOAA GEFS weather data. GEFS is an ensemble of 21 different weather forecast models. A 16 day forecast is avaliable -##' every 6 hours. Each forecast includes information on a total of 8 variables. These are transformed from the NOAA standard to the internal PEcAn -##' standard. -##' -##' @section Data Avaliability: -##' NOAA GEFS weather data is avaliable on a rolling 12 day basis; dates provided in "start_date" must be within this range. The end date can be any point after -##' that, but if the end date is beyond 16 days, only 16 days worth of forecast are recorded. Times are rounded down to the previous 6 hour forecast. NOAA -##' GEFS weather data isn't always posted immediately, and to compensate, this function adjusts requests made in the last two hours -##' back two hours (approximately the amount of time it takes to post the data) to make sure the most current forecast is used. -##' -##' @section Data Save Format: -##' Data is saved in the netcdf format to the specified directory. File names reflect the precision of the data to the given range of days. -##' NOAA.GEFS.willow creek.3.2018-06-08T06:00.2018-06-24T06:00.nc specifies the forecast, using ensemble nubmer 3 at willow creek on -##' June 6th, 2018 at 6:00 a.m. to June 24th, 2018 at 6:00 a.m. -##' -##' @return A list of data frames is returned containing information about the data file that can be used to locate it later. Each -##' data frame contains information about one file. -##' -##' @param outfolder Directory where results should be written -##' @param start_date, end_date Range of dates/times to be downloaded (default assumed time of day is 0:00, midnight) -##' @param lat site latitude in decimal degrees -##' @param lon site longitude in decimal degrees -##' @param sitename The unique ID given to each site. This is used as part of the file name. -##' @param overwrite logical. Download a fresh version even if a local file with the same name already exists? -##' @param verbose logical. Print additional debug information. Passed on to functions in the netcdf4 package to provide debugging info. -##' @param ... Other arguments, currently ignored -##' @export -##' -##' @examples -##' \dontrun{ -##' download.NOAA_GEFS(outfolder="~/Working/results", lat.in= 45.805925, lon.in = -90.07961, sitename="US-WCr") -##' } -##' -##' @author Katie Zarada - modified code from Luke Dramko and Laura Puckett -##' -##' - - -download.NOAA_GEFS_downscale <- function(outfolder, lat.in, lon.in, sitename, start_date = Sys.time(), end_date = (as.POSIXct(start_date, tz="UTC") + lubridate::days(16)), - overwrite = FALSE, verbose = FALSE, ...) { - - start_date <- as.POSIXct(start_date, tz = "UTC") - end_date <- as.POSIXct(end_date, tz = "UTC") - - #It takes about 2 hours for NOAA GEFS weather data to be posted. Therefore, if a request is made within that 2 hour window, - #we instead want to adjust the start time to the previous forecast, which is the most recent one avaliable. (For example, if - #there's a request at 7:00 a.m., the data isn't up yet, so the function grabs the data at midnight instead.) - if (abs(as.numeric(Sys.time() - start_date, units="hours")) <= 2) { - start_date = start_date - lubridate::hours(2) - end_date = end_date - lubridate::hours(2) - } - - #Date/time error checking - Checks to see if the start date is before the end date - if (start_date > end_date) { - PEcAn.logger::logger.severe("Invalid dates: end date occurs before start date") - } else if (as.numeric(end_date - start_date, units="hours") < 6) { #Done separately to produce a more helpful error message. - PEcAn.logger::logger.severe("Times not far enough appart for a forecast to fall between them. Forecasts occur every six hours; make sure start - and end dates are at least 6 hours appart.") - } - - #Set the end forecast date (default is the full 16 days) - if (end_date > start_date + lubridate::days(16)) { - end_date = start_date + lubridate::days(16) - PEcAn.logger::logger.info(paste0("Updated end date is ", end_date)) - } - - #Round the starting date/time down to the previous block of 6 hours. Adjust the time frame to match. - forecast_hour = (lubridate::hour(start_date) %/% 6) * 6 #Integer division by 6 followed by re-multiplication acts like a "floor function" for multiples of 6 - increments = as.integer(as.numeric(end_date - start_date, units = "hours") / 6) #Calculating the number of forecasts between start and end dates. - increments = increments + ((lubridate::hour(end_date) - lubridate::hour(start_date)) %/% 6) #These calculations are required to use the rnoaa package. - - end_hour = sprintf("%04d", ((forecast_hour + (increments * 6)) %% 24) * 100) #Calculating the starting hour as a string, which is required type to access the - #data via the rnoaa package - forecast_hour = sprintf("%04d", forecast_hour * 100) #Having the end date as a string is useful later, too. - - #Recreate the adjusted start and end dates. - start_date = as.POSIXct(paste0(lubridate::year(start_date), "-", lubridate::month(start_date), "-", lubridate::day(start_date), " ", - substring(forecast_hour, 1,2), ":00:00"), tz="UTC") - - end_date = start_date + lubridate::hours(increments * 6) - - - #Bounds date checking - #NOAA's GEFS database maintains a rolling 12 days of forecast data for access through this function. - #We do want Sys.Date() here - NOAA makes data unavaliable days at a time, not forecasts at a time. - NOAA_GEFS_Start_Date = as.POSIXct(Sys.Date(), tz="UTC") - lubridate::days(11) #Subtracting 11 days is correct, not 12. - - #Check to see if start_date is valid. This must be done after date adjustment. - if (as.POSIXct(Sys.time(), tz="UTC") < start_date || start_date < NOAA_GEFS_Start_Date) { - PEcAn.logger::logger.severe(sprintf('Start date (%s) exceeds the NOAA GEFS range (%s to %s).', - start_date, - NOAA_GEFS_Start_Date, Sys.Date())) - } - - if (lubridate::hour(start_date) > 23) { - PEcAn.logger::logger.severe(sprintf("Start time %s is not a valid time", lubridate::hour(start_date))) - } - - if (lubridate::hour(end_date) > 23) { #Done separately from the previous if statement in order to have more specific error messages. - PEcAn.logger::logger.severe(sprintf("End time %s is not a valid time", lubridate::hour(end_date))) - } - #End date/time error checking - - ################################################# - #NOAA variable downloading - #Uses the rnoaa package to download data - - #We want data for each of the following variables. Here, we're just getting the raw data; later, we will convert it to the - #cf standard format when relevant. - noaa_var_names = c("Temperature_height_above_ground_ens", "Pressure_surface_ens", "Relative_humidity_height_above_ground_ens", "Downward_Long-Wave_Radp_Flux_surface_6_Hour_Average_ens", - "Downward_Short-Wave_Radiation_Flux_surface_6_Hour_Average_ens", "Total_precipitation_surface_6_Hour_Accumulation_ens", - "u-component_of_wind_height_above_ground_ens", "v-component_of_wind_height_above_ground_ens") - - cf_var_names = c("air_temperature", "air_pressure", "specific_humidity", "surface_downwelling_longwave_flux_in_air", - "surface_downwelling_shortwave_flux_in_air", "precipitation_flux", "eastward_wind", "northward_wind") - #These are the cf standard names - cf_var_names1 = c("air_temperature", "air_pressure", "specific_humidity", "surface_downwelling_longwave_flux_in_air", - "surface_downwelling_shortwave_flux_in_air", "precipitation_flux", "wind_speed") - cf_var_units = c("K", "Pa", "1", "Wm-2", "Wm-2", "kgm-2s-1", "ms-1") #Negative numbers indicate negative exponents - - # This debugging loop allows you to check if the cf variables are correctly mapped to the equivalent - # NOAA variable names. This is very important, as much of the processing below will be erroneous if - # these fail to match up. - # for (i in 1:length(cf_var_names)) { - # print(sprintf("cf / noaa : %s / %s", cf_var_names[[i]], noaa_var_names[[i]])) - #} - - noaa_data = list() - - #Downloading the data here. It is stored in a matrix, where columns represent time in intervals of 6 hours, and rows represent - #each ensemble member. Each variable getxs its own matrix, which is stored in the list noaa_data. - - - for (i in 1:length(noaa_var_names)) { - noaa_data[[i]] = rnoaa::gefs(noaa_var_names[i], lat.in, lon.in, raw=TRUE, time_idx = seq_len(increments), forecast_time = forecast_hour, date=format(start_date, "%Y%m%d"))$data - } - - #Fills in data with NaNs if there happens to be missing columns. - for (i in 1:length(noaa_var_names)) { - if (!is.null(ncol(noaa_data[[i]]))) { # Is a matrix - nans <- rep(NaN, nrow(noaa_data[[i]])) - while (ncol(noaa_data[[i]]) < increments) { - noaa_data[[i]] <- cbind(noaa_data[[i]], nans) - } - } else { # Is a vector - while (length(noaa_data[[i]]) < increments) { - noaa_data[[i]] <- c(noaa_data[[i]], NaN); - } - } - } - - ################################################### - # Not all NOAA data units match the cf data standard. In this next section, data are processed to - # confirm with the standard when necessary. - # The following is a list of variables which need to be processed: - # 1. NOAA's relative humidity must be converted to specific humidity - # 2. NOAA's measure of precipitation is the accumulation over 6 hours; cf's standard is precipitation per second - - #Convert NOAA's relative humidity to specific humidity - humid_index = which(cf_var_names == "specific_humidity") - - #Temperature, pressure, and relative humidity are required to calculate specific humidity. - humid_data = noaa_data[[humid_index]] - temperature_data = noaa_data[[which(cf_var_names == "air_temperature")]] - pressure_data = noaa_data[[which(cf_var_names == "air_pressure")]] - - #Depending on the volume and dimensions of data you download, sometimes R stores it as a vector and sometimes - #as a matrix; the different cases must be processed with different loops. - #(The specific corner case in which a vector would be generated is if only one hour is requested; for example, - #only the data at time_idx 1, for example). - if (as.logical(nrow(humid_data))) { - for (i in 1:length(humid_data)) { - humid_data[i] = PEcAn.data.atmosphere::rh2qair(humid_data[i], temperature_data[i], pressure_data[i]) - } - } else { - for (i in 1:nrow(humid_data)) { - for (j in 1:ncol(humid_data)) { - humid_data[i,j] = PEcAn.data.atmosphere::rh2qair(humid_data[i,j], temperature_data[i,j], pressure_data[i,j]) - } - } - } - - #Update the noaa_data list with the correct data - noaa_data[[humid_index]] <- humid_data - - # Convert NOAA's total precipitation (kg m-2) to precipitation flux (kg m-2 s-1) - #NOAA precipitation data is an accumulation over 6 hours. - precip_index = which(cf_var_names == "precipitation_flux") - - #The statement udunits2::ud.convert(1, "kg m-2 6 hr-1", "kg m-2 s-1") is equivalent to udunits2::ud.convert(1, "kg m-2 hr-1", "kg m-2 s-1") * 6, - #which is a little unintuitive. What will do the conversion we want is what's below: - noaa_data[[precip_index]] = udunits2::ud.convert(noaa_data[[precip_index]], "kg m-2 hr-1", "kg m-2 6 s-1") #There are 21600 seconds in 6 hours - - - ##################################### - #done with data processing- now want to take the list and make one df for downscaling - - time = seq(from = start_date + lubridate::hours(6), to = end_date, by = "6 hour") - forecasts = matrix(ncol = length(noaa_data)+ 2, nrow = 0) - colnames(forecasts) <- c(cf_var_names, "timestamp", "NOAA.member") - - index = matrix(ncol = length(noaa_data), nrow = 64) - for(i in 1:21){ - rm(index) - index = matrix(ncol = length(noaa_data), nrow = 64) - for(j in 1:length(noaa_data)){ - index[,j] <- noaa_data[[j]][i,] - colnames(index) <- c(cf_var_names) - index <- as.data.frame(index) - } - index$timestamp <- as.POSIXct(time) - index$NOAA.member <- rep(i, times = 64) - forecasts <- rbind(forecasts, index) - } - - forecasts <- forecasts %>% tidyr::drop_na() - #forecasts$timestamp <- as.POSIXct(rep(time, 21)) - forecasts$wind_speed <- sqrt(forecasts$eastward_wind^ 2 + forecasts$northward_wind^ 2) - - ### Downscale state variables - gefs_hour <- PEcAn.data.atmosphere::downscale_spline_to_hourly(df = forecasts, VarNamesStates = c("air_temperature", "wind_speed", "specific_humidity", "precipitation_flux", "air_pressure")) - - ## convert longwave to hourly (just copy 6 hourly values over past 6-hour time period) - nonSW.flux.hrly <- forecasts %>% - dplyr::select(timestamp, NOAA.member, surface_downwelling_longwave_flux_in_air) %>% - PEcAn.data.atmosphere::downscale_repeat_6hr_to_hrly() %>% dplyr::group_by_at(c("NOAA.member", "timestamp")) %>% - dplyr::summarize(surface_downwelling_longwave_flux_in_air = mean(surface_downwelling_longwave_flux_in_air)) - - ## downscale shortwave to hourly - time0 = min(forecasts$timestamp) - time_end = max(forecasts$timestamp) - ShortWave.ds = PEcAn.data.atmosphere::downscale_ShortWave_to_hrly(forecasts, time0, time_end, lat = lat.in, lon = lon.in, output_tz= "UTC")%>% - dplyr::group_by_at(c("NOAA.member", "timestamp")) %>% - dplyr::summarize(surface_downwelling_shortwave_flux_in_air = mean(surface_downwelling_shortwave_flux_in_air)) - - - joined<- dplyr::inner_join(gefs_hour, nonSW.flux.hrly, by = c("NOAA.member", "timestamp")) - - joined <- dplyr::inner_join(joined, ShortWave.ds, by = c("NOAA.member", "timestamp")) %>% - dplyr::distinct() %>% - dplyr::mutate(surface_downwelling_shortwave_flux_in_air = dplyr::if_else(surface_downwelling_shortwave_flux_in_air < 0, 0, surface_downwelling_shortwave_flux_in_air), - specific_humidity = dplyr::if_else(specific_humidity <0, 0, specific_humidity), - air_temperature = dplyr::if_else(air_temperature > 320, NA_real_, air_temperature), - air_temperature = dplyr::if_else(air_temperature < 240, NA_real_, air_temperature), - precipitation_flux = dplyr::if_else(precipitation_flux < 0, 0, precipitation_flux), - surface_downwelling_longwave_flux_in_air = dplyr::if_else(surface_downwelling_longwave_flux_in_air < 0, NA_real_, surface_downwelling_longwave_flux_in_air), - wind_speed = dplyr::if_else(wind_speed <0, 0, wind_speed)) %>% - dplyr::filter(is.na(timestamp) == FALSE) - - - - - ############################################# - # Done with data processing. Now writing the data to the specified directory. Each ensemble member is written to its own file, for a total - # of 21 files. - if (!dir.exists(outfolder)) { - dir.create(outfolder, recursive=TRUE, showWarnings = FALSE) - } - - # Create a data frame with information about the file. This data frame's format is an internal PEcAn standard, and is stored in the BETY database to - # locate the data file. The data file is stored on the local machine where the download occured. Because NOAA GEFS is an - # ensemble of 21 different forecast models, each model gets its own data frame. All of the information is the same for - # each file except for the file name. - results = data.frame( - file = "", #Path to the file (added in loop below). - host = PEcAn.remote::fqdn(), #Name of the server where the file is stored - mimetype = "application/x-netcdf", #Format the data is saved in - formatname = "CF Meteorology", #Type of data - startdate = paste0(format(start_date, "%Y-%m-%dT%H:%M:00")), #starting date and time, down to the second - enddate = paste0(format(end_date, "%Y-%m-%dT%H:%M:00")), #ending date and time, down to the second - dbfile.name = "NOAA_GEFS_downscale", #Source of data (ensemble number will be added later) - stringsAsFactors = FALSE - ) - - results_list = list() - - #Each ensemble gets its own file. - #These dimensions will be used for all 21 ncdf4 file members, so they're all declared once here. - #The data is really one-dimensional for each file (though we include lattitude and longitude dimensions - #to comply with the PEcAn standard). - time_dim = ncdf4::ncdim_def(name="time", - units = paste("hours since", format(start_date, "%Y-%m-%dT%H:%M")), - seq(from = 6, length.out = length(unique(joined$timestamp))), #GEFS forecast starts 6 hours from start time - create_dimvar = TRUE) - lat_dim = ncdf4::ncdim_def("latitude", "degree_north", lat.in, create_dimvar = TRUE) - lon_dim = ncdf4::ncdim_def("longitude", "degree_east", lon.in, create_dimvar = TRUE) - - dimensions_list = list(time_dim, lat_dim, lon_dim) - - nc_var_list = list() - for (i in 1:length(cf_var_names1)) { #Each ensemble member will have data on each variable stored in their respective file. - nc_var_list[[i]] = ncdf4::ncvar_def(cf_var_names1[i], cf_var_units[i], dimensions_list, missval=NaN) - } - - #For each ensemble - for (i in 1:21) { # i is the ensemble number - #Generating a unique identifier string that characterizes a particular data set. - identifier = paste("NOAA_GEFS_downscale", sitename, i, format(start_date, "%Y-%m-%dT%H:%M"), - format(end_date, "%Y-%m-%dT%H:%M"), sep=".") - - ensemble_folder = file.path(outfolder, identifier) - data = as.data.frame(joined %>% dplyr::select(NOAA.member, cf_var_names1) %>% - dplyr::filter(NOAA.member == i) %>% - dplyr::select(-NOAA.member)) - - #Each file will go in its own folder. - if (!dir.exists(ensemble_folder)) { - dir.create(ensemble_folder, recursive=TRUE, showWarnings = FALSE) - } - - flname = file.path(ensemble_folder, paste(identifier, "nc", sep = ".")) - - #Each ensemble member gets its own unique data frame, which is stored in results_list - #Object references in R work differently than in other languages. When adding an item to a list, R creates a copy of it - #for you instead of just inserting the object reference, so this works. - results$file <- flname - results$dbfile.name <- flname - results_list[[i]] <- results - - if (!file.exists(flname) | overwrite) { - nc_flptr = ncdf4::nc_create(flname, nc_var_list, verbose=verbose) - - #For each variable associated with that ensemble - for (j in 1:length(cf_var_names1)) { - # "j" is the variable number. "i" is the ensemble number. Remember that each row represents an ensemble - ncdf4::ncvar_put(nc_flptr, nc_var_list[[j]], data[,j]) - } - - ncdf4::nc_close(nc_flptr) #Write to the disk/storage - } else { - PEcAn.logger::logger.info(paste0("The file ", flname, " already exists. It was not overwritten.")) - } - - } - - return(results_list) -} #downscale.NOAA_GEFS diff --git a/modules/data.atmosphere/R/download.PalEON.R b/modules/data.atmosphere/R/download.PalEON.R index f6bc4261833..50a55ffe9c5 100644 --- a/modules/data.atmosphere/R/download.PalEON.R +++ b/modules/data.atmosphere/R/download.PalEON.R @@ -3,9 +3,13 @@ ##' @name download.PalEON ##' @title download.PalEON ##' @export -##' @param outfolder -##' @param start_date -##' @param end_date +##' +##' @param outfolder desired output location +##' @param start_date desired start date YYYY-MM-DD +##' @param end_date desired end date YYYY-MM-DD +##' @param sitename sitename +##' @param overwrite overwrite existing files? Default is FALSE +##' @param ... Other inputs ##' ##' @author Betsy Cowdery download.PalEON <- function(sitename, outfolder, start_date, end_date, overwrite = FALSE, ...) { diff --git a/modules/data.atmosphere/R/download.PalEON_ENS.R b/modules/data.atmosphere/R/download.PalEON_ENS.R index 9f2ed487bbd..2858b6a4447 100644 --- a/modules/data.atmosphere/R/download.PalEON_ENS.R +++ b/modules/data.atmosphere/R/download.PalEON_ENS.R @@ -1,9 +1,13 @@ ##' @title Download PalEON met ensemble files ##' ##' @export -##' @param outfolder -##' @param start_date -##' @param end_date +##' +##' @param outfolder desired output folder +##' @param start_date desired start date YYYY-MM-DD +##' @param end_date desired end date YYYY-MM-DD +##' @param sitename sitename +##' @param overwrite overwrite existing files? Default is FALSE +##' @param ... Other inputs ##' ##' @author Betsy Cowdery, Mike Dietze download.PalEON_ENS <- function(sitename, outfolder, start_date, end_date, overwrite = FALSE, ...) { diff --git a/modules/data.atmosphere/R/download.US_Syv.R b/modules/data.atmosphere/R/download.US_Syv.R deleted file mode 100644 index 4638945e8c6..00000000000 --- a/modules/data.atmosphere/R/download.US_Syv.R +++ /dev/null @@ -1,115 +0,0 @@ -##' @title download.US-Syv -##' -##' @section General Description: -##' Obtains data from Ankur Desai's Sylvannia flux tower, and selects certain variables (NEE and LE) to return -##' Data is retruned at the given timestep in the given range. -##' -##' This data includes information on a number of flux variables. -##' -##' The timestep parameter is measured in hours, but is then converted to half hours because the data's timestep -##' is every half hour. -##' -##' @param start_date Start date/time data should be downloaded for -##' @param end_date End date/time data should be downloaded for -##' @param timestep How often to take data points from the file. Must be a multiple of 0.5 -##' @export -##' -##' @author Luke Dramko and K Zarada -download.US_Syv <- function(start_date, end_date, timestep = 1) { - timestep = 2 * timestep #data is actually every half hour - - if (timestep != as.integer(timestep)) { - PEcAn.logger::logger.severe(paste0("Invalid timestep ", timestep/2, ". Timesteps must be at ", - "least every half hour (timestep = 0.5).")) - } - - start_date <- as.POSIXct(start_date, tz="UTC") - end_date <- as.POSIXct(end_date, tz="UTC") - - nee_col = 10 # Column number of NEE - le_col = 15 # Column number of LE - - # Data is found here - # Original url: http://flux.aos.wisc.edu/data/cheas/wcreek/flux/prelim/wcreek2018_flux.txt - base_url <- "http://flux.aos.wisc.edu/data/cheas/sylvania/flux/prelim/sylvania" - - flux = NULL; - - for (year in as.integer(format(start_date, "%Y")):as.integer(format(end_date, "%Y"))) { - url <- paste0(base_url, "flux_", year, ".txt") #Build proper url - PEcAn.logger::logger.info(paste0("Reading data for year ", year)) - print(url) - influx <- tryCatch(read.csv(url, skip = 20, header = F, sep = ","), error=function(e) {NULL}, warning=function(e) {NULL}) - if (is.null(influx)) { #Error encountered in data fetching. - PEcAn.logger::logger.warn(paste0("Data not avaliable for year ", year, ". All values for ", year, " will be NA.")) - # Determine the number of days in the year - rows_in_year <- udunits2::ud.convert(lubridate::as.duration(lubridate::interval(as.POSIXct(paste0(year, "-01-01")), as.POSIXct(paste0(year + 1, "-01-01")))), "s", "day") - rows_in_year = rows_in_year * 48 # 24 measurements per day, one every hour. - influx <- matrix(rep(-999, rows_in_year * 13), nrow=rows_in_year, ncol = 13) - } - flux <- rbind(flux, influx) - } - PEcAn.logger::logger.info("Flux data has been read.") - - # Contains only the data needed in a data frame - new.flux <- data.frame(DOY = flux[,4], - HRMIN = flux[,5], - NEE = as.numeric(flux[,nee_col]), - LE = as.numeric(flux[,le_col])) - - # Calculate minutes from start year to find the right row to pull data from. - year_start <- as.POSIXct(format(start_date, "%Y-01-01 00:00:00"), tz="UTC") - - start_interval <- lubridate::interval(year_start, start_date) - days <- lubridate::as.duration(start_interval) # Actually returns a number of seconds - days <- udunits2::ud.convert(as.integer(days), "s", "day") # Days, including fractional part, if any. - hours <- floor(udunits2::ud.convert(days - floor(days), "day", "hr")) # Extract the hour component, round to the previous hour. - if (days - floor(days) >= 0.5) { # Flux data is at half-hour precision - hours <- hours + 0.5 - } - days <- floor(days) # Extract the whole day component - - start_row <- as.integer(days * 48 + hours * 2) - - data_interval <- lubridate::interval(start_date, end_date) - days <- lubridate::as.duration(data_interval) # a number of seconds - days <- udunits2::ud.convert(as.integer(days), "s", "day") - hours <- floor(udunits2::ud.convert(as.integer(days - floor(days)), "day", "hr")) # Round down to the nearest half hour - if (days - floor(days) >= 0.5) { - hours <- hours + 0.5 - } - days <- floor(days) - end_row <- start_row + as.integer(days * 48 + hours * 2) - - # Calculations are one time point behind the actual start time; corrects the off-by-one error - start_row = start_row + 1; - end_row = end_row + 1; - - # Vectors that will contain the output data - out_nee = NULL - out_le = NULL - - PEcAn.logger::logger.info("Starting at row (nonconverted) ") - print(new.flux[start_row,]) #print gives a much more interpretable output than pasting in the logger call. - - for (d in seq(start_row, end_row, by=timestep)) { - row = new.flux[d,] - - # NEE values - val <- as.numeric(row$NEE) - if (val == -999) { val <- NA } else { - val <- PEcAn.utils::misc.convert(row$NEE, "umol C m-2 s-1", "kg C m-2 s-1") - } - out_nee <- c(out_nee, val) - - # LE values - val <- as.numeric(row$LE) - if (val == -9999) { val <- NA } - out_le <- c(out_le, val) - } - - return(list(nee=out_nee[-1], qle=out_le[-1])) # Start time not included in the forecast -} # download.US_Syv.R - -# This line is great for testing. -#download.US_Syv('2018-07-23 06:00', '2018-08-08 06:00', timestep=12) diff --git a/modules/data.atmosphere/R/download.raw.met.module.R b/modules/data.atmosphere/R/download.raw.met.module.R index a87b77fcfba..3d7f9270fe8 100644 --- a/modules/data.atmosphere/R/download.raw.met.module.R +++ b/modules/data.atmosphere/R/download.raw.met.module.R @@ -1,3 +1,33 @@ +#' @name download.raw.met.module +#' @title download.raw.met.module +#' +#' @return A list of data frames is returned containing information about the data file that can be used to locate it later. Each +#' data frame contains information about one file. +#' +#' @param dir directory to write outputs to +#' @param met source included in input_met +#' @param register register.xml, provided by met.process +#' @param machine machine associated with hostname, provided by met.process +#' @param start_date the start date of the data to be downloaded (will only use the year part of the date) +#' @param end_date the end date of the data to be downloaded (will only use the year part of the date) +#' @param str_ns substitute for site_id if not provided, provided by met.process +#' @param con database connection based on dbparms in met.process +#' @param input_met Which data source to process +#' @param site.id site id +#' @param lat.in site latitude, provided by met.process +#' @param lon.in site longitude, provided by met.process +#' @param host host info from settings file +#' @param site site info from settings file +#' @param username database username +#' @param overwrite whether to force download.raw.met.module to proceed +#' @param dbparms database settings from settings file +#' @param Ens.Flag default set to FALSE +#' +#' +#' @export +#' +#' + .download.raw.met.module <- function(dir, met, @@ -87,7 +117,9 @@ username = username, lat.in = lat.in, lon.in = lon.in, - pattern = met + pattern = met, + site_id = site.id, + product = input_met$product ) } else { diff --git a/modules/data.atmosphere/R/downscale_ShortWave_to_hrly.R b/modules/data.atmosphere/R/downscale_ShortWave_to_hrly.R deleted file mode 100644 index 471c5ec93a6..00000000000 --- a/modules/data.atmosphere/R/downscale_ShortWave_to_hrly.R +++ /dev/null @@ -1,56 +0,0 @@ -##' @title Downscale shortwave to hourly -##' @return A dataframe of downscaled state variables -##' -##' @param debiased, data frame of variables -##' @param time0, first timestep -##' @param time_end, last time step -##' @param lat, lat of site -##' @param lon, long of site -##' @param output_tz, output timezone -##' @export -##' -##' @author Laura Puckett -##' -##' - -downscale_ShortWave_to_hrly <- function(debiased, time0, time_end, lat, lon, output_tz = "UTC"){ - ## downscale shortwave to hourly - - - downscale_solar_geom <- function(doy, lon, lat) { - - dt <- median(diff(doy)) * 86400 # average number of seconds in time interval - hr <- (doy - floor(doy)) * 24 # hour of day for each element of doy - - ## calculate potential radiation - cosz <- PEcAn.data.atmosphere::cos_solar_zenith_angle(doy, lat, lon, dt, hr) - rpot <- 1366 * cosz - return(rpot) - } - grouping = append("NOAA.member", "timestamp") - - surface_downwelling_shortwave_flux_in_air<- rep(debiased$surface_downwelling_shortwave_flux_in_air, each = 6) - time = rep(seq(from = as.POSIXct(time0 - lubridate::hours(5), tz = output_tz), to = as.POSIXct(time_end, tz = output_tz), by = 'hour'), times = 21) - - ShortWave.hours <- as.data.frame(surface_downwelling_shortwave_flux_in_air) - ShortWave.hours$timestamp = time - ShortWave.hours$NOAA.member = rep(debiased$NOAA.member, each = 6) - ShortWave.hours$hour = as.numeric(format(time, "%H")) - ShortWave.hours$group = rep(seq(1, length(debiased$NOAA.member)/6), each= 6) - - - - ShortWave.ds <- ShortWave.hours %>% - dplyr::mutate(doy = lubridate::yday(timestamp) + hour/24) %>% - dplyr::mutate(rpot = downscale_solar_geom(doy, lon, lat)) %>% # hourly sw flux calculated using solar geometry - dplyr::group_by_at(c("group", "NOAA.member")) %>% - dplyr::mutate(avg.rpot = mean(rpot, na.rm = TRUE)) %>% # daily sw mean from solar geometry - dplyr::ungroup() %>% - dplyr::mutate(surface_downwelling_shortwave_flux_in_air = ifelse(avg.rpot > 0, rpot* (surface_downwelling_shortwave_flux_in_air/avg.rpot),0)) %>% - dplyr::select(timestamp, NOAA.member, surface_downwelling_shortwave_flux_in_air) %>% - dplyr::filter(timestamp >= min(debiased$timestamp) & timestamp <= max(debiased$timestamp)) - - -} - - diff --git a/modules/data.atmosphere/R/downscale_repeat_6hr_to_hrly.R b/modules/data.atmosphere/R/downscale_repeat_6hr_to_hrly.R deleted file mode 100644 index c55dbc2b99c..00000000000 --- a/modules/data.atmosphere/R/downscale_repeat_6hr_to_hrly.R +++ /dev/null @@ -1,28 +0,0 @@ -##' @title Downscale repeat to hourly -##' @return A dataframe of downscaled data -##' -##' @param data.6hr, dataframe of data to be downscaled (Longwave) -##' @export -##' -##' @author Laura Puckett -##' -##' - -downscale_repeat_6hr_to_hrly <- function(data.6hr){ - data.hrly = data.6hr %>% - dplyr::group_by_all() %>% - tidyr::expand(timestamp = c(timestamp, - timestamp + lubridate::hours(1), - timestamp + lubridate::hours(2), - timestamp + lubridate::hours(3), - timestamp + lubridate::hours(4), - timestamp + lubridate::hours(5), - timestamp + lubridate::hours(6))) %>% - dplyr::ungroup() %>% - dplyr::mutate(timestamp = lubridate::as_datetime(timestamp, tz = "UTC")) %>% - dplyr::filter(timestamp >= min(data.6hr$timestamp) & timestamp <= max(data.6hr$timestamp)) %>% - dplyr::distinct() - - #arrange(timestamp) -return(data.hrly) -} diff --git a/modules/data.atmosphere/R/downscale_spline_to_hourly.R b/modules/data.atmosphere/R/downscale_spline_to_hourly.R deleted file mode 100644 index 34ffabcb331..00000000000 --- a/modules/data.atmosphere/R/downscale_spline_to_hourly.R +++ /dev/null @@ -1,56 +0,0 @@ -##' @title Downscale spline to hourly -##' @return A dataframe of downscaled state variables -##' -##' @param df, dataframe of data to be downscales -##' @param VarNamesStates, names of vars that are state variables -##' @export -##' -##' @author Laura Puckett -##' -##' - -downscale_spline_to_hourly <- function(df,VarNamesStates){ - # -------------------------------------- - # purpose: interpolates debiased forecasts from 6-hourly to hourly - # Creator: Laura Puckett, December 16 2018 - # -------------------------------------- - # @param: df, a dataframe of debiased 6-hourly forecasts - - interpolate <- function(jday, var){ - result <- splinefun(jday, var, method = "monoH.FC") - return(result(seq(min(as.numeric(jday)), max(as.numeric(jday)), 1/24))) - } - - - - t0 = min(df$timestamp) - df <- df %>% - dplyr::mutate(days_since_t0 = difftime(.$timestamp, t0, units = "days")) - - if("dscale.member" %in% colnames(df)){ - by.ens <- df %>% - dplyr::group_by(NOAA.member, dscale.member) - }else{ - by.ens <- df %>% - dplyr::group_by(NOAA.member) - } - - interp.df.days <- by.ens %>% dplyr::do(days = seq(min(df$days_since_t0), as.numeric(max(df$days_since_t0)), 1/24)) - interp.df <- interp.df.days - - for(Var in 1:length(VarNamesStates)){ - assign(paste0("interp.df.",VarNamesStates[Var]), dplyr::do(by.ens, var = interpolate(.$days_since_t0,unlist(.[,VarNamesStates[Var]]))) %>% dplyr::rename(!!VarNamesStates[Var] := "var")) - if("dscale.member" %in% colnames(df)){ - interp.df <- dplyr::inner_join(interp.df, get(paste0("interp.df.",VarNamesStates[Var])), by = c("NOAA.member", "dscale.member")) - }else{ - interp.df <- dplyr::inner_join(interp.df, get(paste0("interp.df.",VarNamesStates[Var])), by = c("NOAA.member")) - } - } - - # converting from time difference back to timestamp - interp.df = interp.df %>% - tidyr::unnest() %>% - dplyr::mutate(timestamp = lubridate::as_datetime(t0 + days, tz = attributes(t0)$tzone)) - return(interp.df) -} - diff --git a/modules/data.atmosphere/R/downscaling_helper_functions.R b/modules/data.atmosphere/R/downscaling_helper_functions.R new file mode 100644 index 00000000000..09c7f1ab83f --- /dev/null +++ b/modules/data.atmosphere/R/downscaling_helper_functions.R @@ -0,0 +1,173 @@ +#' @title Downscale spline to hourly +#' @param df, dataframe of data to be downscales +#' @param VarNames, variable names to be downscaled +#' @param hr, hour to downscale to- default is 1 +#' @return A dataframe of downscaled state variables +#' @importFrom rlang .data +#' @author Laura Puckett +#' @export +#' + +downscale_spline_to_hrly <- function(df,VarNames, hr = 1){ + # -------------------------------------- + # purpose: interpolates debiased forecasts from 6-hourly to hourly + # Creator: Laura Puckett, December 16 2018 + # -------------------------------------- + # @param: df, a dataframe of debiased 6-hourly forecasts + time <- NULL + t0 = min(df$time) + df <- df %>% + dplyr::mutate(days_since_t0 = difftime(.data$time, t0, units = "days")) + + interp.df.days <- seq(min(df$days_since_t0), as.numeric(max(df$days_since_t0)), 1/(24/hr)) + + noaa_data_interp <- tibble::tibble(time = lubridate::as_datetime(t0 + interp.df.days, tz = "UTC")) + + for(Var in 1:length(VarNames)){ + curr_data <- stats::spline(x = df$days_since_t0, y = unlist(df[VarNames[Var]]), method = "fmm", xout = interp.df.days)$y + noaa_data_interp <- cbind(noaa_data_interp, curr_data) + } + + names(noaa_data_interp) <- c("time",VarNames) + + return(noaa_data_interp) +} + +#' @title Downscale shortwave to hourly +#' @return A dataframe of downscaled state variables +#' +#' @param df, data frame of variables +#' @param lat, lat of site +#' @param lon, long of site +#' @param hr, hour to downscale to- default is 1 +#' @importFrom rlang .data +#' @return ShortWave.ds +#' @author Laura Puckett +#' @export +#' +#' + +downscale_ShortWave_to_hrly <- function(df,lat, lon, hr = 1){ + + ## downscale shortwave to hourly + + t0 <- min(df$time) + df <- df %>% + dplyr::select(.data$time, .data$surface_downwelling_shortwave_flux_in_air) %>% + dplyr::mutate(days_since_t0 = difftime(.data$time, t0, units = "days")) %>% + dplyr::mutate(lead_var = dplyr::lead(.data$surface_downwelling_shortwave_flux_in_air, 1)) + + interp.df.days <- seq(min(df$days_since_t0), as.numeric(max(df$days_since_t0)), 1/(24/hr)) + + noaa_data_interp <- tibble::tibble(time = lubridate::as_datetime(t0 + interp.df.days)) + + data.hrly <- noaa_data_interp %>% + dplyr::left_join(df, by = "time") + + data.hrly$group_6hr <- NA + + group <- 0 + for(i in 1:nrow(data.hrly)){ + if(!is.na(data.hrly$lead_var[i])){ + curr <- data.hrly$lead_var[i] + data.hrly$surface_downwelling_shortwave_flux_in_air[i] <- curr + group <- group + 1 + data.hrly$group_6hr[i] <- group + }else{ + data.hrly$surface_downwelling_shortwave_flux_in_air[i] <- curr + data.hrly$group_6hr[i] <- group + } + } + + ShortWave.ds <- data.hrly %>% + dplyr::mutate(hour = lubridate::hour(.data$time)) %>% + dplyr::mutate(doy = lubridate::yday(.data$time) + .data$hour/(24/hr))%>% + dplyr::mutate(rpot = downscale_solar_geom(.data$doy, as.vector(lon), as.vector(lat))) %>% # hourly sw flux calculated using solar geometry + dplyr::group_by(.data$group_6hr) %>% + dplyr::mutate(avg.rpot = mean(.data$rpot, na.rm = TRUE)) %>% # daily sw mean from solar geometry + dplyr::ungroup() %>% + dplyr::mutate(surface_downwelling_shortwave_flux_in_air = ifelse(.data$avg.rpot > 0, .data$rpot* (.data$surface_downwelling_shortwave_flux_in_air/.data$avg.rpot),0)) %>% + dplyr::select(.data$time,.data$surface_downwelling_shortwave_flux_in_air) + + return(ShortWave.ds) + +} + + +#' @title Downscale repeat to hourly +#' @param df, dataframe of data to be downscaled (Longwave) +#' @param varName, variable names to be downscaled +#' @param hr, hour to downscale to- default is 1 +#' @return A dataframe of downscaled data +#' @importFrom rlang .data +#' @author Laura Puckett +#' @export +#' + +downscale_repeat_6hr_to_hrly <- function(df, varName, hr = 1){ + + #bind variables + lead_var <- time <- NULL + #Get first time point + t0 <- min(df$time) + + df <- df %>% + dplyr::select("time", all_of(varName)) %>% + #Calculate time difference + dplyr::mutate(days_since_t0 = difftime(.data$time, t0, units = "days")) %>% + #Shift valued back because the 6hr value represents the average over the + #previous 6hr period + dplyr::mutate(lead_var = dplyr::lead(df[,varName], 1)) + + #Create new vector with all hours + interp.df.days <- seq(min(df$days_since_t0), + as.numeric(max(df$days_since_t0)), + 1 / (24 / hr)) + + #Create new data frame + noaa_data_interp <- tibble::tibble(time = lubridate::as_datetime(t0 + interp.df.days)) + + #Join 1 hr data frame with 6 hr data frame + data.hrly <- noaa_data_interp %>% + dplyr::left_join(df, by = "time") + + #Fill in hours + for(i in 1:nrow(data.hrly)){ + if(!is.na(data.hrly$lead_var[i])){ + curr <- data.hrly$lead_var[i] + }else{ + data.hrly$lead_var[i] <- curr + } + } + + #Clean up data frame + data.hrly <- data.hrly %>% dplyr::select("time", .data$lead_var) %>% + dplyr::arrange(.data$time) + + names(data.hrly) <- c("time", varName) + + return(data.hrly) +} + + + +#' @title Calculate potential shortwave radiation +#' +#' @param doy, day of year in decimal +#' @param lon, longitude +#' @param lat, latitude +#' @return vector of potential shortwave radiation for each doy +#' +#' @author Quinn Thomas +#' @export +#' +downscale_solar_geom <- function(doy, lon, lat) { + + dt <- stats::median(diff(doy)) * 86400 # average number of seconds in time interval + hr <- (doy - floor(doy)) * 24 # hour of day for each element of doy + + ## calculate potential radiation + cosz <- cos_solar_zenith_angle(doy, lat, lon, dt, hr) + rpot <- 1366 * cosz + return(rpot) +} diff --git a/modules/data.atmosphere/R/extract_ERA5.R b/modules/data.atmosphere/R/extract_ERA5.R index d9a7eb684eb..bf219b4a509 100644 --- a/modules/data.atmosphere/R/extract_ERA5.R +++ b/modules/data.atmosphere/R/extract_ERA5.R @@ -13,7 +13,6 @@ #' @details For the list of variables check out the documentation at \link{https://confluence.ecmwf.int/display/CKB/ERA5+data+documentation#ERA5datadocumentation-Spatialgrid} #' #' @return a list of xts objects with all the variables for the requested years -#' @import xts #' @export #' @examples #' \dontrun{ @@ -36,6 +35,7 @@ extract.nc.ERA5 <- overwrite = FALSE, ...) { + # library(xts) # Distributing the job between whatever core is available. years <- seq(lubridate::year(start_date), diff --git a/modules/data.atmosphere/R/extract_local_CMIP5.R b/modules/data.atmosphere/R/extract_local_CMIP5.R index df5bab1c33c..45952de9d8a 100644 --- a/modules/data.atmosphere/R/extract_local_CMIP5.R +++ b/modules/data.atmosphere/R/extract_local_CMIP5.R @@ -1,11 +1,9 @@ ##' Extract NLDAS from local download -##' Extract NLDAS meteorology for a poimt from a local download of the full grid -# ----------------------------------- +##' Extract NLDAS meteorology for a point from a local download of the full grid +# ----------------------------------- # Description # ----------------------------------- -##' @title extract.local.CMIP5 -##' @family -##' @author Christy Rollinson, +##' @author Christy Rollinson ##' @description This function extracts CMIP5 data from grids that have been downloaded and stored locally. ##' Files are saved as a netCDF file in CF conventions at *DAILY* resolution. Note: At this point ##' in time, variables that are only available at a native monthly resolution will be repeated to @@ -18,7 +16,6 @@ ##' @param in.path - path to the raw full grids ##' @param start_date - first day for which you want to extract met (yyyy-mm-dd) ##' @param end_date - last day for which you want to extract met (yyyy-mm-dd) -##' @param site_id name to associate with extracted files ##' @param lat.in site latitude in decimal degrees ##' @param lon.in site longitude in decimal degrees ##' @param model which GCM to extract data from @@ -27,17 +24,15 @@ ##' @param date.origin (optional) specify the date of origin for timestamps in the files being read. ##' If NULL defaults to 1850 for historical simulations (except MPI-ESM-P) and ##' 850 for p1000 simulations (plus MPI-ESM-P historical). Format: YYYY-MM-DD -##' @param no.leap (optional, logical) if you know your GCM of interest is missing leap year, you can specify it here. -##' otherwise the code will automatically determine if leap year is missing and if it should be -##' added in. +##' @param adjust.pr - adjustment factor fore preciptiation when the extracted values seem off ##' @param overwrite logical. Download a fresh version even if a local file with the same name already exists? ##' @param verbose logical. to control printing of debug info ##' @param ... Other arguments, currently ignored ##' @export -##' @examples +##' # ----------------------------------- -extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_id, lat.in, lon.in, - model , scenario , ensemble_member = "r1i1p1", date.origin=NULL, no.leap=NULL, +extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, lat.in, lon.in, + model , scenario , ensemble_member = "r1i1p1", date.origin=NULL, adjust.pr=1, overwrite = FALSE, verbose = FALSE, ...){ # Some GCMs don't do leap year; we'll have to deal with this separately @@ -49,7 +44,8 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i } else if(scenario == "historical" & GCM!="MPI-ESM-P") { date.origin=as.Date("1850-01-01") } else { - PEcAn.logger::logger.error("No date.origin specified and scenario not implemented yet") + # PEcAn.logger::logger.error("No date.origin specified and scenario not implemented yet") + date.origin=as.Date("0001-01-01") } } @@ -79,25 +75,42 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i # The table of var name conversion # psl; sfcWind; tasmax; tasmin; huss - var <- data.frame(DAP.name = c("tas", "tasmax", "tasmin", "rlds", "ps", "rsds", "uas", "vas", "sfcWind", "ua", "va", "huss", "pr"), + #"co2", "mole_fraction_of_carbon_dioxide_in_air", "1e-6" + var <- data.frame(DAP.name = c("tas", "tasmax", "tasmin", "rlds", "ps", "rsds", "uas", "vas", "sfcWind", "ua", "va", "huss", "pr", "co2mass"), CF.name = c("air_temperature", "air_temperature_maximum", "air_temperature_minimum", "surface_downwelling_longwave_flux_in_air", "air_pressure", "surface_downwelling_shortwave_flux_in_air", "eastward_wind", "northward_wind", "wind_speed", "eastward_wind", "northward_wind", - "specific_humidity", "precipitation_flux"), - units = c("Kelvin", "Kelvin", "Kelvin", "W/m2", "Pascal", "W/m2", "m/s", "m/s", "m/s", "m/s", "m/s", "g/g", "kg/m2/s")) - + "specific_humidity", "precipitation_flux", "mole_fraction_of_carbon_dioxide_in_air"), + units = c("Kelvin", "Kelvin", "Kelvin", "W/m2", "Pascal", "W/m2", "m/s", "m/s", "m/s", "m/s", "m/s", "g/g", "kg/m2/s", "1e-6")) + + # Some constants for converting CO2 if it's there + co2.molmass <- 44.01 # g/mol https://en.wikipedia.org/wiki/Carbon_dioxide#Atmospheric_concentration + atm.molmass <- 28.97 # g/mol https://en.wikipedia.org/wiki/Density_of_air + atm.masstot <- 5.1480e18 # kg https://journals.ametsoc.org/doi/10.1175/JCLI-3299.1 + atm.mol <- atm.masstot/atm.molmass + # Figuring out what we have daily for and what we only have monthly for - vars.gcm.day <- dir(file.path(in.path, "day")) - vars.gcm.mo <- dir(file.path(in.path, "month")) + path.day <- file.path(in.path, "day") + path.mo <- file.path(in.path, "month") + + vars.gcm.day <- dir(path.day) + vars.gcm.mo <- dir(path.mo) + # If our extraction bath is different from what we had, modify it + if("atmos" %in% vars.gcm.day){ + path.day <- file.path(in.path, "day", "atmos", "day", ensemble_member, "latest") + path.mo <- file.path(in.path, "mon", "atmos", "Amon", ensemble_member, "latest") + + vars.gcm.day <- dir(path.day) + vars.gcm.mo <- dir(path.mo) + } vars.gcm.mo <- vars.gcm.mo[!vars.gcm.mo %in% vars.gcm.day] vars.gcm <- c(vars.gcm.day, vars.gcm.mo) # Rewriting the dap name to get the closest variable that we have for the GCM (some only give uss stuff at sea level) - library(car) # having trouble gettins stuff to work otherwise - if(!("huss" %in% vars.gcm)) var$DAP.name <- car::recode(var$DAP.name, "'huss'='hus'") - if(!("ps" %in% vars.gcm )) var$DAP.name <- car::recode(var$DAP.name, "'ps'='psl'") + if(!("huss" %in% vars.gcm)) var$DAP.name[var$DAP.name=="huss"] <- "hus" + if(!("ps" %in% vars.gcm)) var$DAP.name[var$DAP.name=="ps"] <- "psl" # Making sure we're only trying to grab the variables we have (i.e. don't try sfcWind if we don't have it) var <- var[var$DAP.name %in% vars.gcm,] @@ -111,25 +124,38 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i for(v in var$DAP.name){ files.var[[v]] <- list() if(v %in% vars.gcm.day){ - # Get a list of file names - files.var[[v]] <- data.frame(file.name=dir(file.path(in.path, "day", v)) ) + v.res="day" + # Get a list of file names + files.var[[v]] <- data.frame(file.name=dir(file.path(path.day, v))) } else { - files.var[[v]] <- data.frame(file.name=dir(file.path(in.path, "month", v))) + v.res="month" + files.var[[v]] <- data.frame(file.name=dir(file.path(path.mo, v))) } # Set up an index to help us find out which file we'll need - # files.var[[v]][["years"]] <- data.frame(first.year=NA, last.year=NA) + # files.var[[v]][["years"]] <- data.frame(first.date=NA, last.date=NA) for(i in 1:nrow(files.var[[v]])){ - yr.str <- stringr::str_split(stringr::str_split(files.var[[v]][i,"file.name"], "_")[[1]][6], "-")[[1]] + dt.str <- stringr::str_split(stringr::str_split(files.var[[v]][i,"file.name"], "_")[[1]][6], "-")[[1]] # Don't bother storing this file if we don't want those years - files.var[[v]][i, "first.year"] <- as.numeric(substr(yr.str[1], 1, 4)) - files.var[[v]][i, "last.year" ] <- as.numeric(substr(yr.str[2], 1, 4)) + if(v.res=="day"){ + files.var[[v]][i, "first.date"] <- as.Date(dt.str[1], format="%Y%m%d") + files.var[[v]][i, "last.date" ] <- as.Date(substr(dt.str[2], 1, 8), format="%Y%m%d") + } else { + # For monthly data, we can assume the first day of the month is day 1 of that month + # dfirst <- lubridate::days_in_month(as.numeric(substr(dt.str[1], 5, 6))) + files.var[[v]][i, "first.date"] <- as.Date(paste0(dt.str[1], 01), format="%Y%m%d") + + # For the last day, i wish we could assume it ends in December, but some models are + # jerks, so we should double check + dlast <- lubridate::days_in_month(as.numeric(substr(dt.str[2], 5, 6))) + files.var[[v]][i, "last.date" ] <- as.Date(paste0(substr(dt.str[2], 1, 6), dlast), format="%Y%m%d") + } } # End file loop # get rid of files outside of what we actually need - files.var[[v]] <- files.var[[v]][files.var[[v]]$first.year<=end_year & files.var[[v]]$last.year>=start_year,] + files.var[[v]] <- files.var[[v]][files.var[[v]]$first.date<=as.Date(end_date) & files.var[[v]]$last.date>=as.Date(start_date),] # if(as.numeric(substr(yr.str[1], 1, 4)) > end_year | as.numeric(substr(yr.str[2], 1, 4))< start_year) next n.file=n.file+nrow(files.var[[v]]) @@ -154,6 +180,7 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i dat.all[[v]] <- vector() # initialize the layer # Figure out the temporal resolution of the variable v.res <- ifelse(var.now %in% vars.gcm.day, "day", "month") + p.res <- ifelse(var.now %in% vars.gcm.day, path.day, path.mo) # Figure out what file we need # file.ind <- which(files.var[[var.now]][i]) @@ -164,39 +191,75 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i # print(f.now) # Open up the file - ncT <- ncdf4::nc_open(file.path(in.path, v.res, var.now, f.now)) + ncT <- ncdf4::nc_open(file.path(p.res, var.now, f.now)) # Extract our dimensions - lat_bnd <- ncdf4::ncvar_get(ncT, "lat_bnds") - lon_bnd <- ncdf4::ncvar_get(ncT, "lon_bnds") + # Check to see if we need to extract lat/lon or not + if(ncT$var[[var.now]]$ndims>1){ + lat_bnd <- ncdf4::ncvar_get(ncT, "lat_bnds") + lon_bnd <- ncdf4::ncvar_get(ncT, "lon_bnds") + } nc.time <- ncdf4::ncvar_get(ncT, "time") + if(v.res=="day"){ + date.leaps <- seq(files.var[[var.now]][i,"first.date"], files.var[[var.now]][i,"last.date"], by="day") + } else { + # if we're dealing with monthly data, start with the first of the month + date.leaps <- seq(files.var[[var.now]][i,"first.date"], files.var[[var.now]][i,"last.date"], by="day") + } + # Figure out if we're missing leap dat + no.leap <- ifelse(length(nc.time)!=length(date.leaps), TRUE, FALSE) + # splt.ind <- ifelse(GCM %in% c("MPI-ESM-P"), 4, 3) # date.origin <- as.Date(stringr::str_split(ncT$dim$time$units, " ")[[1]][splt.ind]) - nc.date <- date.origin + nc.time - date.leaps <- seq(as.Date(paste0(files.var[[var.now]][i,"first.year"], "-01-01")), as.Date(paste0(files.var[[var.now]][i,"last.year"], "-12-31")), by="day") - # Figure out if we're missing leap dat - no.leap <- ifelse(is.null(no.leap) & length(nc.date)!=length(date.leaps), TRUE, FALSE) + if(v.res == "day"){ + nc.date <- date.origin + nc.time + + nc.min <- as.Date(min(nc.date)) + # mean(diff(nc.date)) + date.ref <- files.var[[var.now]][i,"first.date"]+0.5 # Set a half-day offset to make centered + + # If things don't align with the specified origin, update it & try again + if(nc.min != date.ref){ + date.off <- date.ref - nc.min # Figure out our date offset + + nc.date <- date.origin + nc.time + date.off + } + } else { + dfirst <- lubridate::days_in_month(lubridate::month(files.var[[var.now]][i,"first.date"])) + + dates.mo <- seq.Date(files.var[[var.now]][i,"first.date"]+dfirst/2, files.var[[var.now]][i,"last.date"], by="month") + + if(length(dates.mo) == length(nc.time)){ + nc.date <- dates.mo + } else { + # I have no freaking clue what to do if things don't work out, so lets just go back to whatever we first tried + date.off <- date.ref - nc.min # Figure out our date offset + + nc.date <- nc.date + date.off + 1 + } + } + # If we're missing leap year, lets adjust our date stamps so we can only pull what we need if(v.res=="day" & no.leap==TRUE){ cells.bump <- which(lubridate::leap_year(lubridate::year(date.leaps)) & lubridate::month(date.leaps)==02 & lubridate::day(date.leaps)==29) for(j in 1:length(cells.bump)){ - nc.date[cells.bump[j]:length(nc.date)] <- nc.date[cells.bump[j]:length(nc.date)]+1 + nc.date[(cells.bump[j]-1):length(nc.date)] <- nc.date[(cells.bump[j]-1):length(nc.date)]+1 } } # Find our time index if(v.res=="day"){ - time.ind <- which(lubridate::year(nc.date)>=start_year & lubridate::year(nc.date)<=end_year) + time.ind <- which(nc.date>=as.Date(start_date) & nc.date<=as.Date(end_date)+0.5) } else { - yr.ind <- rep(files.var[[var.now]][i,"first.year"]:files.var[[var.now]][i,"last.year"], each=12) - time.ind <- which(yr.ind>=start_year & yr.ind<=end_year) + # date.ind <- rep(files.var[[var.now]][i,"first.date"]:files.var[[var.now]][i,"last.date"], each=12) + time.ind <- which(nc.date>=as.Date(start_date) & nc.date<=as.Date(end_date)+0.5) } # Subset our dates & times to match our index nc.date <- nc.date[time.ind] - date.leaps <- date.leaps[which(lubridate::year(date.leaps)>=start_year & lubridate::year(date.leaps)<=end_year)] + date.leaps <- date.leaps[which(date.leaps>=as.Date(start_date) & date.leaps<=as.Date(end_date))] # Find the closest grid cell for our site (using harvard as a protoype) ind.lat <- which(lat_bnd[1,]<=lat.in & lat_bnd[2,]>=lat.in) @@ -218,15 +281,22 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i dat.temp <- ncdf4::ncvar_get(ncT, var.now, c(ind.lon, ind.lat, puse, time.ind[1]), c(1,1,1,length(time.ind))) } } else { - dat.temp <- ncdf4::ncvar_get(ncT, var.now, c(ind.lon, ind.lat, time.ind[1]), c(1,1,length(time.ind))) + # Note that CO2 appears to be a global value + if(ncT$var[[var.now]]$ndims==1){ + dat.temp <- ncdf4::ncvar_get(ncT, var.now, c(time.ind[1]), c(length(time.ind))) + } else { + dat.temp <- ncdf4::ncvar_get(ncT, var.now, c(ind.lon, ind.lat, time.ind[1]), c(1,1,length(time.ind))) + } } # Add leap year and trick monthly into daily # Figure out if we're missing leap year if(v.res=="day" & no.leap==TRUE){ cells.dup <- which(lubridate::leap_year(lubridate::year(date.leaps)) & lubridate::month(date.leaps)==02 & lubridate::day(date.leaps)==28) - for(j in 1:length(cells.dup)){ - dat.temp <- append(dat.temp, dat.temp[cells.dup[j]], cells.dup[j]) + if(length(cells.dup)>0){ + for(j in 1:length(cells.dup)){ + dat.temp <- append(dat.temp, dat.temp[cells.dup[j]], cells.dup[j]) + } } } @@ -234,7 +304,7 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i # If we have monthly data, lets trick it into being daily if(v.res == "month"){ mo.ind <- rep(1:12, length.out=length(dat.temp)) - yr.ind <- rep(files.var[[var.now]][i,"first.year"]:files.var[[var.now]][i,"last.year"], each=12) + yr.ind <- lubridate::year(nc.date) dat.trick <- vector() for(j in 1:length(dat.temp)){ if(lubridate::leap_year(yr.ind[j]) & mo.ind[j]==2){ @@ -320,7 +390,15 @@ extract.local.CMIP5 <- function(outfolder, in.path, start_date, end_date, site_i for(v in 1:nrow(var)){ dat.list[[v]] <- dat.all[[v]][yr.ind] } # End variable loop - + + # Adjusting Preciptiation if necessary + dat.list[["precipitation_flux"]] <- dat.list[["precipitation_flux"]]*adjust.pr + + if("mole_fraction_of_carbon_dioxide_in_air" %in% names(dat.list)){ + co2.mol <- dat.list[["mole_fraction_of_carbon_dioxide_in_air"]]/co2.molmass # kg co2 + dat.list[["mole_fraction_of_carbon_dioxide_in_air"]] <- co2.mol/atm.mol*1e6 # kmol/kmol * 1e6 to be in CF units (ppm) + } + ## put data in new file loc <- ncdf4::nc_create(filename=loc.file, vars=var.list, verbose=verbose) for(j in 1:nrow(var)){ diff --git a/modules/data.atmosphere/R/extract_local_NLDAS.R b/modules/data.atmosphere/R/extract_local_NLDAS.R index a879517426b..a23c4d74531 100644 --- a/modules/data.atmosphere/R/extract_local_NLDAS.R +++ b/modules/data.atmosphere/R/extract_local_NLDAS.R @@ -1,11 +1,9 @@ ##' Extract NLDAS from local download -##' Extract NLDAS meteorology for a poimt from a local download of the full grid -# ----------------------------------- +##' Extract NLDAS meteorology for a point from a local download of the full grid +# ----------------------------------- # Description # ----------------------------------- -##' @title extract.local.NLDAS -##' @family -##' @author Christy Rollinson, +##' @author Christy Rollinson ##' @description This function extracts NLDAS data from grids that have been downloaded and stored locally. ##' Once upon a time, you could query these files directly from the internet, but now they're ##' behind a tricky authentication wall. Files are saved as a netCDF file in CF conventions. @@ -18,7 +16,6 @@ ##' @param in.path - path to the raw full grids ##' @param start_date - first day for which you want to extract met (yyyy-mm-dd) ##' @param end_date - last day for which you want to extract met (yyyy-mm-dd) -##' @param site_id name to associate with extracted files ##' @param lat.in site latitude in decimal degrees ##' @param lon.in site longitude in decimal degrees ##' @param overwrite logical. Download a fresh version even if a local file with the same name already exists? @@ -27,7 +24,7 @@ ##' @param ... Other arguments, currently ignored ##' @export # ----------------------------------- -extract.local.NLDAS <- function(outfolder, in.path, start_date, end_date, site_id, lat.in, lon.in, +extract.local.NLDAS <- function(outfolder, in.path, start_date, end_date, lat.in, lon.in, overwrite = FALSE, verbose = FALSE, ...){ # Date stuff @@ -145,6 +142,8 @@ extract.local.NLDAS <- function(outfolder, in.path, start_date, end_date, site_i v.nldas <- paste(var$NLDAS.name[v]) v.cf <- paste(var$CF.name [v]) + if(!v.nldas %in% names(dap_file$var) & v.cf %in% names(dap_file$var)) v.nldas <- v.cf + # Variables have different dimensions (which is a pain in the butt) # so we need to check to see whether we're pulling 4 dimensions or just 3 if(dap_file$var[[v.nldas]]$ndims == 4){ diff --git a/modules/data.atmosphere/R/get_cf_variables_table.R b/modules/data.atmosphere/R/get_cf_variables_table.R index 61a912192e6..efc76e2735b 100644 --- a/modules/data.atmosphere/R/get_cf_variables_table.R +++ b/modules/data.atmosphere/R/get_cf_variables_table.R @@ -17,9 +17,9 @@ get_cf_variables_table <- function(cf_url = build_cf_variables_table_url(57)) { purrr::map_dfc(unlist, recursive = TRUE) entries_df %>% dplyr::select( - cf_standard_name = .attrs, - unit = canonical_units, - description, + cf_standard_name = .data$.attrs, + unit = .data$canonical_units, + .data$description, dplyr::everything() ) } @@ -36,7 +36,13 @@ get_cf_variables_table <- function(cf_url = build_cf_variables_table_url(57)) { #' @return Complete URL, as a string #' @author Alexey Shiklomanov #' @export -build_cf_variables_table_url <- function(version, - url_format_string = "http://cfconventions.org/Data/cf-standard-names/%d/src/src-cf-standard-name-table.xml") { +build_cf_variables_table_url <- function( + version, + url_format_string = paste0( + # this paste0 is solely to hush R package checks, + # which complain if any usage line is wider than 90 chars + "http://cfconventions.org/", + "Data/cf-standard-names/%d/src/", + "src-cf-standard-name-table.xml")) { sprintf(url_format_string, version) } diff --git a/modules/data.atmosphere/R/half_hour_downscale.R b/modules/data.atmosphere/R/half_hour_downscale.R new file mode 100644 index 00000000000..7272185205f --- /dev/null +++ b/modules/data.atmosphere/R/half_hour_downscale.R @@ -0,0 +1,282 @@ +#' @name half_hour_downscale +#' @title half_hour_downscale +#' +#' @return A list of data frames is returned containing information about the data file that can be used to locate it later. Each +#' data frame contains information about one file. +#' +#' @param input_file location of NOAAGEFS_1hr files +#' @param output_file location where to store half_hour files +#' @param overwrite whether to force hamf_hour_downscale to proceed +#' @param hr set half hour +#' +#' @export +#' +#' @examples +temporal_downscale_half_hour <- function(input_file, output_file, overwrite = TRUE, hr = 0.5){ + + # open netcdf + nc <- ncdf4::nc_open(input_file) + + if(stringr::str_detect(input_file, "ens")){ + ens_postion <- stringr::str_locate(input_file, "ens") + ens_name <- stringr::str_sub(input_file, start = ens_postion[1], end = ens_postion[2] + 2) + ens <- as.numeric(stringr::str_sub(input_file, start = ens_postion[2] + 1, end = ens_postion[2] + 2)) + }else{ + ens <- 0 + ens_name <- "ens00" + } + + # retrive variable names + cf_var_names <- names(nc$var) + + # generate time vector + time <- ncdf4::ncvar_get(nc, "time") + begining_time <- lubridate::ymd_hm(ncdf4::ncatt_get(nc, "time", + attname = "units")$value) + time <- begining_time + lubridate::hours(time) + + # retrive lat and lon + lat.in <- ncdf4::ncvar_get(nc, "latitude") + lon.in <- ncdf4::ncvar_get(nc, "longitude") + + # generate data frame from netcdf variables and retrive units + noaa_data <- tibble::tibble(time = time) + var_units <- rep(NA, length(cf_var_names)) + for(i in 1:length(cf_var_names)){ + curr_data <- ncdf4::ncvar_get(nc, cf_var_names[i]) + noaa_data <- cbind(noaa_data, curr_data) + var_units[i] <- ncdf4::ncatt_get(nc, cf_var_names[i], attname = "units")$value + } + + ncdf4::nc_close(nc) + + names(noaa_data) <- c("time",cf_var_names) + + # spline-based downscaling + if(length(which(c("air_temperature", "wind_speed","specific_humidity", "air_pressure") %in% cf_var_names) == 4)){ + forecast_noaa_ds <- downscale_spline_to_half_hrly(df = noaa_data, VarNames = c("air_temperature", "wind_speed","specific_humidity", "air_pressure")) + }else{ + #Add error message + } + + # Convert splined SH, temperature, and presssure to RH + forecast_noaa_ds <- forecast_noaa_ds %>% + dplyr::mutate(relative_humidity = qair2rh(qair = forecast_noaa_ds$specific_humidity, temp = forecast_noaa_ds$air_temperature, press = forecast_noaa_ds$air_pressure)) %>% + dplyr::mutate(relative_humidity = ifelse(.data$relative_humidity > 1, 1, .data$relative_humidity)) + + # convert longwave to hourly (just copy 6 hourly values over past 6-hour time period) + if("surface_downwelling_longwave_flux_in_air" %in% cf_var_names){ + LW.flux.hrly <- downscale_repeat_6hr_to_half_hrly(df = noaa_data, varName = "surface_downwelling_longwave_flux_in_air") + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, LW.flux.hrly, by = "time") + }else{ + #Add error message + } + + # convert precipitation to hourly (just copy 6 hourly values over past 6-hour time period) + if("surface_downwelling_longwave_flux_in_air" %in% cf_var_names){ + Precip.flux.hrly <- downscale_repeat_6hr_to_half_hrly(df = noaa_data, varName = "precipitation_flux") + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, Precip.flux.hrly, by = "time") + }else{ + #Add error message + } + + # convert cloud_area_fraction to hourly (just copy 6 hourly values over past 6-hour time period) + if("cloud_area_fraction" %in% cf_var_names){ + cloud_area_fraction.flux.hrly <- downscale_repeat_6hr_to_half_hrly(df = noaa_data, varName = "cloud_area_fraction") + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, cloud_area_fraction.flux.hrly, by = "time") + }else{ + #Add error message + } + + # use solar geometry to convert shortwave from 6 hr to 1 hr + if("surface_downwelling_shortwave_flux_in_air" %in% cf_var_names){ + ShortWave.hrly <- downscale_ShortWave_to_half_hrly(df = noaa_data, lat = lat.in, lon = lon.in) + forecast_noaa_ds <- dplyr::inner_join(forecast_noaa_ds, ShortWave.hrly, by = "time") + }else{ + #Add error message + } + + #Add dummy ensemble number to work with write_noaa_gefs_netcdf() + forecast_noaa_ds$NOAA.member <- ens + + #Make sure var names are in correct order + forecast_noaa_ds <- forecast_noaa_ds %>% + dplyr::select("time", tidyselect::all_of(cf_var_names), "NOAA.member") + + #Write netCDF + write_noaa_gefs_netcdf(df = forecast_noaa_ds, + ens = ens, + lat = lat.in, + lon = lon.in, + cf_units = var_units, + output_file = output_file, + overwrite = overwrite) + +} #temporal_downscale + + +#' @title Downscale spline to half hourly +#' @param df dataframe of data to be downscales +#' @param VarNames variable names to be downscaled +#' @param hr hour to downscale to- default is 0.5 +#' @return A dataframe of half hourly downscaled state variables +#' @importFrom rlang .data +#' @author Laura Puckett +#' @export +#' + +downscale_spline_to_half_hrly <- function(df,VarNames, hr = 0.5){ + time <- NULL + t0 = min(df$time) + df <- df %>% + dplyr::mutate(days_since_t0 = difftime(.data$time, t0, units = "days")) + + interp.df.days <- seq(min(df$days_since_t0), as.numeric(max(df$days_since_t0)), 1/(24/hr)) + + noaa_data_interp <- tibble::tibble(time = lubridate::as_datetime(t0 + interp.df.days, tz = "UTC")) + + for(Var in 1:length(VarNames)){ + curr_data <- stats::spline(x = df$days_since_t0, y = unlist(df[VarNames[Var]]), method = "fmm", xout = interp.df.days)$y + noaa_data_interp <- cbind(noaa_data_interp, curr_data) + } + + names(noaa_data_interp) <- c("time",VarNames) + + return(noaa_data_interp) +} + +#' @title Downscale shortwave to half hourly +#' @return A dataframe of downscaled state variables +#' +#' @param df data frame of variables +#' @param lat lat of site +#' @param lon long of site +#' @param hr hour to downscale to- default is 1 +#' @importFrom rlang .data +#' @return ShortWave.ds +#' @author Laura Puckett +#' @export +#' + +downscale_ShortWave_to_half_hrly <- function(df,lat, lon, hr = 0.5){ + ## downscale shortwave to half hourly + + t0 <- min(df$time) + df <- df %>% + dplyr::select("time", "surface_downwelling_shortwave_flux_in_air") %>% + dplyr::mutate(days_since_t0 = difftime(.data$time, t0, units = "days")) %>% + dplyr::mutate(lead_var = dplyr::lead(.data$surface_downwelling_shortwave_flux_in_air, 1)) + + interp.df.days <- seq(min(df$days_since_t0), as.numeric(max(df$days_since_t0)), 1/(24/hr)) + + noaa_data_interp <- tibble::tibble(time = lubridate::as_datetime(t0 + interp.df.days)) + + data.hrly <- noaa_data_interp %>% + dplyr::left_join(df, by = "time") + + data.hrly$group_6hr <- NA + + group <- 0 + for(i in 1:nrow(data.hrly)){ + if(!is.na(data.hrly$lead_var[i])){ + curr <- data.hrly$lead_var[i] + data.hrly$surface_downwelling_shortwave_flux_in_air[i] <- curr + group <- group + 1 + data.hrly$group_6hr[i] <- group + }else{ + data.hrly$surface_downwelling_shortwave_flux_in_air[i] <- curr + data.hrly$group_6hr[i] <- group + } + } + + ShortWave.ds <- data.hrly %>% + dplyr::mutate(hour = lubridate::hour(.data$time)) %>% + dplyr::mutate(doy = lubridate::yday(.data$time) + .data$hour/(24/hr))%>% + dplyr::mutate(rpot = downscale_solar_geom_halfhour(.data$doy, as.vector(lon), as.vector(lat))) %>% # hourly sw flux calculated using solar geometry + dplyr::group_by(.data$group_6hr) %>% + dplyr::mutate(avg.rpot = mean(.data$rpot, na.rm = TRUE)) %>% # daily sw mean from solar geometry + dplyr::ungroup() %>% + dplyr::mutate(surface_downwelling_shortwave_flux_in_air = ifelse(.data$avg.rpot > 0, .data$rpot* (.data$surface_downwelling_shortwave_flux_in_air/.data$avg.rpot),0)) %>% + dplyr::select(.data$time, .data$surface_downwelling_shortwave_flux_in_air) + + return(ShortWave.ds) + +} + + +#' @title Downscale repeat to half hourly +#' @param df dataframe of data to be downscaled (Longwave) +#' @param varName variable names to be downscaled +#' @param hr hour to downscale to- default is 0.5 +#' @return A dataframe of downscaled data +#' @importFrom rlang .data +#' @author Laura Puckett +#' @export +#' + +downscale_repeat_6hr_to_half_hrly <- function(df, varName, hr = 0.5){ + + #bind variables + lead_var <- time <- NULL + #Get first time point + t0 <- min(df$time) + + df <- df %>% + dplyr::select("time", all_of(varName)) %>% + #Calculate time difference + dplyr::mutate(days_since_t0 = difftime(.data$time, t0, units = "days")) %>% + #Shift valued back because the 6hr value represents the average over the + #previous 6hr period + dplyr::mutate(lead_var = dplyr::lead(df[,varName], 1)) + + #Create new vector with all hours + interp.df.days <- seq(min(df$days_since_t0), + as.numeric(max(df$days_since_t0)), + 1 / (24 / hr)) + + #Create new data frame + noaa_data_interp <- tibble::tibble(time = lubridate::as_datetime(t0 + interp.df.days)) + + #Join 1 hr data frame with 6 hr data frame + data.hrly <- noaa_data_interp %>% + dplyr::left_join(df, by = "time") + + #Fill in hours + for(i in 1:nrow(data.hrly)){ + if(!is.na(data.hrly$lead_var[i])){ + curr <- data.hrly$lead_var[i] + }else{ + data.hrly$lead_var[i] <- curr + } + } + + #Clean up data frame + data.hrly <- data.hrly %>% dplyr::select("time", .data$lead_var) %>% + dplyr::arrange(.data$time) + + names(data.hrly) <- c("time", varName) + + return(data.hrly) +} + +#' @title Calculate potential shortwave radiation +#' +#' @param doy, day of year in decimal +#' @param lon, longitude +#' @param lat, latitude +#' @return vector of potential shortwave radiation for each doy +#' +#' @author Quinn Thomas +#' @export +#' +#' +downscale_solar_geom_halfhour <- function(doy, lon, lat) { + + dt <- stats::median(diff(doy)) * 86400 # average number of seconds in time interval + hr <- (doy - floor(doy)) * 48 # hour of day for each element of doy + + ## calculate potential radiation + cosz <- cos_solar_zenith_angle(doy, lat, lon, dt, hr) + rpot <- 1366 * cosz + return(rpot) +} diff --git a/modules/data.atmosphere/R/load.cfmet.R b/modules/data.atmosphere/R/load.cfmet.R index 71fb8bce8d1..fb5de4938bd 100644 --- a/modules/data.atmosphere/R/load.cfmet.R +++ b/modules/data.atmosphere/R/load.cfmet.R @@ -71,10 +71,9 @@ load.cfmet <- function(met.nc, lat, lon, start.date, end.date) { results <- list() - utils::data(mstmip_vars, package = "PEcAn.utils", envir = environment()) ## pressure naming hack pending https://github.com/ebimodeling/model-drivers/issues/2 - standard_names <- append(as.character(mstmip_vars$standard_name), "surface_pressure") + standard_names <- append(as.character(PEcAn.utils::standard_vars$standard_name), "surface_pressure") variables <- as.character(standard_names[standard_names %in% c("surface_pressure", attributes(met.nc$var)$names)]) diff --git a/modules/data.atmosphere/R/merge.met.variable.R b/modules/data.atmosphere/R/merge.met.variable.R index f583d9906f3..85cde6a2c59 100644 --- a/modules/data.atmosphere/R/merge.met.variable.R +++ b/modules/data.atmosphere/R/merge.met.variable.R @@ -10,7 +10,7 @@ #' print debugging information as they run? #' @param ... #' -#' @return +#' @return Currently nothing. TODO: Return a data frame summarizing the merged files. #' @export #' #' @details Currently modifies the files IN PLACE rather than creating a new copy of the files an a new DB record. diff --git a/modules/data.atmosphere/R/met.process.R b/modules/data.atmosphere/R/met.process.R index f61749c67ef..c14551a99b4 100644 --- a/modules/data.atmosphere/R/met.process.R +++ b/modules/data.atmosphere/R/met.process.R @@ -1,6 +1,6 @@ ##' @name met.process ##' @title met.process -##' @export +##' ##' ##' @param site Site info from settings file ##' @param input_met Which data source to process. @@ -13,6 +13,7 @@ ##' @param spin spin-up settings passed to model-specific met2model. List containing nyear (number of years of spin-up), nsample (first n years to cycle), and resample (TRUE/FALSE) ##' @param overwrite Whether to force met.process to proceed. ##' +##' ##' `overwrite` may be a list with individual components corresponding to ##' `download`, `met2cf`, `standardize`, and `met2model`. If it is instead a simple boolean, ##' the default behavior for `overwrite=FALSE` is to overwrite nothing, as you might expect. @@ -20,7 +21,7 @@ ##' *except* raw met downloads. I.e., it corresponds to: ##' ##' list(download = FALSE, met2cf = TRUE, standardize = TRUE, met2model = TRUE) -##' +##' @export ##' @author Elizabeth Cowdery, Michael Dietze, Ankur Desai, James Simkins, Ryan Kelly met.process <- function(site, input_met, start_date, end_date, model, host = "localhost", dbparms, dir, browndog = NULL, spin=NULL, @@ -87,13 +88,9 @@ met.process <- function(site, input_met, start_date, end_date, model, } # set up connection and host information - bety <- dplyr::src_postgres(dbname = dbparms$dbname, - host = dbparms$host, - user = dbparms$user, - password = dbparms$password) - - con <- bety$con - on.exit(PEcAn.DB::db.close(con)) + con <- PEcAn.DB::db.open(dbparms) + + on.exit(PEcAn.DB::db.close(con), add = TRUE) username <- ifelse(is.null(input_met$username), "pecan", input_met$username) machine.host <- ifelse(host == "localhost" || host$name == "localhost", PEcAn.remote::fqdn(), host$name) machine <- PEcAn.DB::db.query(paste0("SELECT * from machines where hostname = '", machine.host, "'"), con) @@ -128,10 +125,10 @@ met.process <- function(site, input_met, start_date, end_date, model, # first attempt at function that designates where to start met.process if (is.null(input_met$id)) { stage <- list(download.raw = TRUE, met2cf = TRUE, standardize = TRUE, met2model = TRUE) - format.vars <- PEcAn.DB::query.format.vars(bety = bety, format.id = register$format$id) # query variable info from format id + format.vars <- PEcAn.DB::query.format.vars(bety = con, format.id = register$format$id) # query variable info from format id } else { stage <- met.process.stage(input.id=input_met$id, raw.id=register$format$id, con) - format.vars <- PEcAn.DB::query.format.vars(bety = bety, input.id = input_met$id) # query DB to get format variable information if available + format.vars <- PEcAn.DB::query.format.vars(bety = con, input.id = input_met$id) # query DB to get format variable information if available # Is there a situation in which the input ID could be given but not the file path? # I'm assuming not right now assign(stage$id.name, @@ -147,6 +144,8 @@ met.process <- function(site, input_met, start_date, end_date, model, stage$download.raw <- FALSE stage$local <- TRUE } + }else{ + stage$local <- FALSE } PEcAn.logger::logger.debug(stage) @@ -203,17 +202,13 @@ met.process <- function(site, input_met, start_date, end_date, model, dbparms=dbparms ) - if (met %in% c("CRUNCEP", "GFDL","NOAA_GEFS_downscale")) { + if (met %in% c("CRUNCEP", "GFDL", "NOAA_GEFS", "MERRA")) { ready.id <- raw.id # input_met$id overwrites ready.id below, needs to be populated here input_met$id <- raw.id stage$met2cf <- FALSE stage$standardize <- FALSE - } else if (met %in% c("NOAA_GEFS")) { # Can sometimes have missing values, so the gapfilling step is required. - cf.id <- raw.id - input_met$id <-raw.id - stage$met2cf <- FALSE - } + } }else if (stage$local){ # In parallel to download met module this needs to check if the files are already downloaded or not db.file <- PEcAn.DB::dbfile.input.check( @@ -278,7 +273,7 @@ met.process <- function(site, input_met, start_date, end_date, model, con = con, host = host, overwrite = overwrite$met2cf, format.vars = format.vars, - bety = bety) + bety = con) } else { if (! met %in% c("ERA5")) cf.id = input_met$id } @@ -286,9 +281,9 @@ met.process <- function(site, input_met, start_date, end_date, model, #--------------------------------------------------------------------------------------------------# # Change to Site Level - Standardized Met (i.e. ready for conversion to model specific format) if (stage$standardize) { - standardize_result = list() + standardize_result <- list() - for (i in 1:length(cf.id[[1]])) { + for (i in seq_along(cf.id[[1]])) { if (register$scale == "regional") { #### Site extraction @@ -322,15 +317,15 @@ met.process <- function(site, input_met, start_date, end_date, model, } } # End for loop - ready.id = list(input.id = NULL, dbfile.id = NULL) - - for (i in 1:length(standardize_result)) { + ready.id <- list(input.id = NULL, dbfile.id = NULL) + + for (i in seq_along(standardize_result)) { ready.id$input.id <- c(ready.id$input.id, standardize_result[[i]]$input.id) ready.id$dbfile.id <- c(ready.id$dbfile.id, standardize_result[[i]]$dbfile.id) } } else { - ready.id = input_met$id + ready.id <- input_met$id } #--------------------------------------------------------------------------------------------------# @@ -361,14 +356,12 @@ met.process <- function(site, input_met, start_date, end_date, model, register = register, ensemble_name = i) } - - - - model.id = list() - model.file.info = list() - model.file = list() - - for (i in 1:length(met2model.result)) { + + model.id <- list() + model.file.info <- list() + model.file <- list() + + for (i in seq_along(met2model.result)) { model.id[[i]] <- met2model.result[[i]]$model.id model.file.info[[i]] <- PEcAn.DB::db.query(paste0("SELECT * from dbfiles where id = ", model.id[[i]]$dbfile.id), con) model.file[[i]] <- file.path(model.file.info[[i]]$file_path, model.file.info[[i]]$file_name) @@ -381,8 +374,8 @@ met.process <- function(site, input_met, start_date, end_date, model, input_met$id <- list() input_met$path <- list() - - for (i in 1:length(model.id)) { + + for (i in seq_along(model.id)) { input_met$id[[paste0("id", i)]] <- model.id[[i]]$input.id input_met$path[[as.character(paste0("path", i))]] <- model.file[[i]] } @@ -411,11 +404,11 @@ met.process <- function(site, input_met, start_date, end_date, model, ################################################################################################################################# -##' @name db.site.lat.lon -##' @title db.site.lat.lon +##' Look up lat/lon from siteid +##' ##' @export -##' @param site.id -##' @param con +##' @param site.id BeTY ID of site to look up +##' @param con database connection ##' @author Betsy Cowdery db.site.lat.lon <- function(site.id, con) { site <- PEcAn.DB::db.query(paste("SELECT id, ST_X(ST_CENTROID(geometry)) AS lon, ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id =", @@ -434,20 +427,19 @@ db.site.lat.lon <- function(site.id, con) { ################################################################################################################################# -##' @name browndog.met -##' @description Use browndog to get the met data for a specific model -##' @title get met data from browndog +##' Use browndog to get the met data for a specific model +##' ##' @export -##' @param browndog, list with url, username and password to connect to browndog -##' @param source, the source of the met data, currently only NARR an Ameriflux is supported -##' @param site, site information should have id, lat, lon and name (ameriflux id) -##' @param start_date, start date for result -##' @param end_date, end date for result -##' @param model, model to convert the met data to -##' @param dir, folder where results are stored (in subfolder) -##' @param username, used when downloading data from Ameriflux like sites -##' @param con, database connection -## +##' @param browndog list with url, username and password to connect to browndog +##' @param source the source of the met data, currently only NARR an Ameriflux is supported +##' @param site site information should have id, lat, lon and name (ameriflux id) +##' @param start_date start date for result +##' @param end_date end date for result +##' @param model model to convert the met data to +##' @param dir folder where results are stored (in subfolder) +##' @param username used when downloading data from Ameriflux like sites +##' @param con database connection +##' ##' @author Rob Kooper browndog.met <- function(browndog, source, site, start_date, end_date, model, dir, username, con) { folder <- tempfile("BD-", dir) diff --git a/modules/data.atmosphere/R/met.process.stage.R b/modules/data.atmosphere/R/met.process.stage.R index 41b2c756166..e0ca23964a8 100644 --- a/modules/data.atmosphere/R/met.process.stage.R +++ b/modules/data.atmosphere/R/met.process.stage.R @@ -4,6 +4,7 @@ ##' ##' @param input.id ##' @param raw.id +##' @param con database connection ##' ##' @author Elizabeth Cowdery met.process.stage <- function(input.id, raw.id, con) { diff --git a/modules/data.atmosphere/R/met2CF.ALMA.R b/modules/data.atmosphere/R/met2CF.ALMA.R index 97072922c2f..4aa0ceeff8f 100644 --- a/modules/data.atmosphere/R/met2CF.ALMA.R +++ b/modules/data.atmosphere/R/met2CF.ALMA.R @@ -169,169 +169,6 @@ met2CF.PalEONregional <- function(in.path, in.prefix, outfolder, start_date, end return(invisible(results)) } # met2CF.PalEONregional -##' Get meteorology variables from PalEON netCDF files and convert to netCDF CF format -##' -##' @name met2CF.PalEONregional -##' @title met2CF.PalEONregional -##' @export -##' @param in.path location on disk where inputs are stored -##' @param in.prefix prefix of input and output files -##' @param outfolder location on disk where outputs will be stored -##' @param start_date the start date of the data to be downloaded (will only use the year part of the date) -##' @param end_date the end date of the data to be downloaded (will only use the year part of the date) -##' @param overwrite should existing files be overwritten -##' -##' @author Mike Dietze -met2CF.PalEONregional <- function(in.path, in.prefix, outfolder, start_date, end_date, overwrite = FALSE, - verbose = FALSE, ...) { - - # get start/end year code works on whole years only - start_year <- lubridate::year(start_date) - end_year <- lubridate::year(end_date) - - if (!file.exists(outfolder)) { - dir.create(outfolder) - } - - ## check file organization - by.folder <- list.dirs(in.path, recursive = FALSE, full.names = FALSE) - if (length(by.folder) == 0) { - PEcAn.logger::logger.severe("met2CF.PalEON, could not detect input folders", in.path) - } - - rows <- end_year - start_year + 1 - results <- data.frame(file = character(rows), - host = character(rows), - mimetype = character(rows), - formatname = character(rows), - startdate = character(rows), - enddate = character(rows), - dbfile.name = in.prefix, - stringsAsFactors = FALSE) - for (year in start_year:end_year) { - my.prefix <- in.prefix - if (nchar(my.prefix) > 0) { - my.prefix <- paste0(my.prefix, ".") - } - new.file <- file.path(outfolder, sprintf("%s%04d.nc", my.prefix, year)) - - row <- year - start_year + 1 - results$file[row] <- new.file - results$host[row] <- PEcAn.remote::fqdn() - results$startdate[row] <- paste0(year, "-01-01 00:00:00") - results$enddate[row] <- paste0(year, "-12-31 23:59:59") - results$mimetype[row] <- "application/x-netcdf" - results$formatname[row] <- "CF" - - if (file.exists(new.file) && !overwrite) { - PEcAn.logger::logger.debug("File '", new.file, "' already exists, skipping to next file.") - next - } - - ### ASSUMING PALEON ORGANIZATION ONE FILE PER VARIABLE PER MONTH EACH VARIABLE IN A FOLDER WITH IT'S - ### OWN NAME - - met <- list() - for (i in seq_along(by.folder)) { - met[[i]] <- NA - } - names(met) <- by.folder - met[["time"]] <- NA - - for (v in by.folder) { - fnames <- dir(file.path(in.path, v), full.names = TRUE) - for (m in 1:12) { - stub <- paste0(year, "_", formatC(m, width = 2, format = "d", flag = "0")) - sel <- grep(stub, fnames) - if (length(sel) == 0) { - PEcAn.logger::logger.severe("missing file", v, stub) - } - old.file <- fnames[sel] - nc1 <- ncdf4::nc_open(old.file, write = FALSE) - - if (length(met[[v]]) <= 1) { - met[[v]] <- aperm(ncdf4::ncvar_get(nc = nc1, varid = v),c(2,1,3)) ## switch order from lon/lat/time to lat/lon/time - } else { - tmp <- aperm(ncdf4::ncvar_get(nc = nc1, varid = v),c(2,1,3)) ## switch order from lon/lat/time to lat/lon/time - met[[v]] <- abind::abind(met[[v]], tmp) - } - if (v == by.folder[1]) { - if (length(met[["time"]]) <= 1) { - met[["time"]] <- nc1$dim[["time"]]$vals - } else { - tmp <- nc1$dim[["time"]]$vals - met[["time"]] <- abind::abind(met[["time"]], tmp) - } - } - ncdf4::nc_close(nc1) - } ## end loop over months - } ## end loop over variables - - - - # create new coordinate dimensions based on site location lat/lon - nc1 <- ncdf4::nc_open(old.file) - tdim <- nc1$dim[["time"]] - met[["time"]] <- udunits2::ud.convert(met[["time"]],"days","seconds") - tdim$units <- paste0("seconds since ",year,"-01-01 00:00:00") - tdim$vals <- met[["time"]] - tdim$len <- length(tdim$vals) - lat <- ncdf4::ncdim_def(name = "latitude", units = "degrees", vals = nc1$dim[["lat"]]$vals, create_dimvar = TRUE) - lon <- ncdf4::ncdim_def(name = "longitude", units = "degrees", vals = nc1$dim[["lon"]]$vals, create_dimvar = TRUE) - time <- ncdf4::ncdim_def(name = "time", units = tdim$units, vals = tdim$vals, - create_dimvar = TRUE, unlim = TRUE) - dim <- list(lat, lon, time) - cp.global.atts <- ncdf4::ncatt_get(nc = nc1, varid = 0) - ncdf4::nc_close(nc1) - - # Open new file and fill in air_temperature - print(year) - var <- ncdf4::ncvar_def(name = "air_temperature", units = "K", dim = dim, - missval = as.numeric(-9999)) - nc2 <- ncdf4::nc_create(filename = new.file, vars = var, verbose = verbose) - ncdf4::ncvar_put(nc = nc2, varid = "air_temperature", vals = met[["tair"]]) - - # air_pressure - insertPmet(met[["psurf"]], nc2 = nc2, var2 = "air_pressure", units2 = "Pa", dim2 = dim, - verbose = verbose) - - # convert CO2 to mole_fraction_of_carbon_dioxide_in_air - # insertPmet(nc1=nc1, var1='CO2', nc2=nc2, var2='mole_fraction_of_carbon_dioxide_in_air', units2='mole/mole', dim2=dim, conv=function(x) { - # x * 1e6 }, verbose=verbose) - - # specific_humidity - insertPmet(met[["qair"]], nc2 = nc2, var2 = "specific_humidity", units2 = "kg/kg", dim2 = dim, - verbose = verbose) - - # surface_downwelling_shortwave_flux_in_air - insertPmet(met[["swdown"]], nc2 = nc2, var2 = "surface_downwelling_shortwave_flux_in_air", - units2 = "W m-2", dim2 = dim, verbose = verbose) - - # surface_downwelling_longwave_flux_in_air - insertPmet(met[["lwdown"]], nc2 = nc2, var2 = "surface_downwelling_longwave_flux_in_air", - units2 = "W m-2", dim2 = dim, verbose = verbose) - - # wind_speed - insertPmet(met[["wind"]], nc2 = nc2, var2 = "wind_speed", units2 = "m s-1", dim2 = dim, verbose = verbose) - - # precipitation_flux - insertPmet(met[["precipf"]], nc2 = nc2, var2 = "precipitation_flux", units2 = "kg/m^2/s", - dim2 = dim, verbose = verbose) - - # add global attributes from original file - for (j in seq_along(cp.global.atts)) { - ncdf4::ncatt_put(nc = nc2, varid = 0, attname = names(cp.global.atts)[j], attval = cp.global.atts[[j]]) - } - - # done, close file - ncdf4::nc_close(nc2) -# save(results,file="met2CF.PalEON.RData") - } ## end loop over years - - return(invisible(results)) -} # met2CF.PalEONregional - - ##' Get meteorology variables from PalEON netCDF files and convert to netCDF CF format ##' ##' @name met2CF.PalEON diff --git a/modules/data.atmosphere/R/met2CF.ICOS.R b/modules/data.atmosphere/R/met2CF.ICOS.R new file mode 100644 index 00000000000..f3775ad0426 --- /dev/null +++ b/modules/data.atmosphere/R/met2CF.ICOS.R @@ -0,0 +1,53 @@ +#' Convert variables ICOS variables to CF format. +#' +#' Variables present in the output netCDF file: +#' air_temperature, air_temperature, relative_humidity, +#' specific_humidity, water_vapor_saturation_deficit, +#' surface_downwelling_longwave_flux_in_air, +#' surface_downwelling_shortwave_flux_in_air, +#' surface_downwelling_photosynthetic_photon_flux_in_air, precipitation_flux, +#' eastward_wind, northward_wind +#' +#' @param in.path path to the input ICOS product CSV file +#' @param in.prefix name of the input file +#' @param outfolder path to the directory where the output file is stored. If specified directory does not exists, it is created. +#' @param start_date start date of the input file +#' @param end_date end date of the input file +#' @param format format is data frame or list with elements as described below +#' REQUIRED: +#' format$header = number of lines of header +#' format$vars is a data.frame with lists of information for each variable to read, at least airT is required +#' format$vars$input_name = Name in CSV file +#' format$vars$input_units = Units in CSV file +#' format$vars$bety_name = Name in BETY +#' OPTIONAL: +#' format$lat = latitude of site +#' format$lon = longitude of site +#' format$na.strings = list of missing values to convert to NA, such as -9999 +#' format$skip = lines to skip excluding header +#' format$vars$column_number = Column number in CSV file (optional, will use header name first) +#' Columns with NA for bety variable name are dropped. +#' @param overwrite overwrite should existing files be overwritten. Default False. +#' @param ... used when extra arguments are present. +#' @return information about the output file +#' @export +#' + +met2CF.ICOS <- + function(in.path, + in.prefix, + outfolder, + start_date, + end_date, + format, + overwrite = FALSE, ...) { + results <- + PEcAn.data.atmosphere::met2CF.csv(in.path, + in.prefix, + outfolder, + start_date, + end_date, + format, + overwrite = overwrite) + return(results) + } diff --git a/modules/data.atmosphere/R/met2cf.ERA5.R b/modules/data.atmosphere/R/met2cf.ERA5.R index d2ad905933c..150fe2d86fb 100644 --- a/modules/data.atmosphere/R/met2cf.ERA5.R +++ b/modules/data.atmosphere/R/met2cf.ERA5.R @@ -12,7 +12,7 @@ #' -#' @return +#' @return list of dataframes #' @export #' met2CF.ERA5<- function(lat, diff --git a/modules/data.atmosphere/R/met_temporal_downscale.Gaussian_ensemble.R b/modules/data.atmosphere/R/met_temporal_downscale.Gaussian_ensemble.R index 1abb1d5bfdf..1082ffb60e3 100644 --- a/modules/data.atmosphere/R/met_temporal_downscale.Gaussian_ensemble.R +++ b/modules/data.atmosphere/R/met_temporal_downscale.Gaussian_ensemble.R @@ -10,7 +10,7 @@ substrRight <- function(x, n) { ##' @export ##' @param in.path ##' @param in.prefix -##' @param outfolder +##' @param outfolder path to directory in which to store output. Will be created if it does not exist ##' @param input_met - the source dataset that will temporally downscaled by the train_met dataset ##' @param train_met - the observed dataset that will be used to train the modeled dataset in NC format. i.e. Flux Tower dataset ##' (see download.Fluxnet2015 or download.Ameriflux) @@ -22,11 +22,12 @@ substrRight <- function(x, n) { ##' @param n_ens - numeric value with the number of ensembles to run ##' @param w_len - numeric value that is the window length in days ##' @param utc_diff - numeric value in HOURS that is local standard time difference from UTC time. CST is -6 +##' @param ... further arguments, currently ignored ##' @author James Simkins met_temporal_downscale.Gaussian_ensemble <- function(in.path, in.prefix, outfolder, - input_met, train_met, site_id, overwrite = FALSE, verbose = FALSE, + input_met, train_met, overwrite = FALSE, verbose = FALSE, swdn_method = "sine", n_ens = 10, w_len = 20, utc_diff = -6, ... ) { sub_str <- substrRight(input_met, 7) diff --git a/modules/data.atmosphere/R/metgapfill.R b/modules/data.atmosphere/R/metgapfill.R index 756fb823bdb..fb0224d1aa4 100644 --- a/modules/data.atmosphere/R/metgapfill.R +++ b/modules/data.atmosphere/R/metgapfill.R @@ -220,7 +220,7 @@ metgapfill <- function(in.path, in.prefix, outfolder, start_date, end_date, lst Ts1 <- try(ncdf4::ncvar_get(nc = nc, varid = "soil_temperature"), silent = TRUE) if (!is.numeric(Ts1)) { - Lw <- missingarr + Ts1 <- missingarr myvar <- ncdf4::ncvar_def(name = "soil_temperature", units = "K", dim = xytdim) nc <- ncdf4::ncvar_add(nc = nc, v = myvar) ncdf4::ncvar_put(nc, varid = myvar, missingarr) diff --git a/modules/data.atmosphere/R/metutils.R b/modules/data.atmosphere/R/metutils.R index 5c792076732..66f985a788b 100644 --- a/modules/data.atmosphere/R/metutils.R +++ b/modules/data.atmosphere/R/metutils.R @@ -98,18 +98,30 @@ SatVapPres <- function(T) { ##' Calculate RH from temperature and dewpoint ##' -##' Based on equation 12 ( in Lawrence 2005, The Relationship between +##' Based on equation 12 in Lawrence 2005, The Relationship between ##' Relative Humidity and the Dewpoint Temperature in Moist Air -##' A Simple Conversion and Applications.) +##' A Simple Conversion and Applications. BAMS +##' https://doi.org/10.1175/BAMS-86-2-225 +##' R = 461.5 K-1 kg-1 gas constant H2O +##' L enthalpy of vaporization +##' linear dependence on T (p 226, following eq 9) +##' ##' @title get RH -##' @param T temperature -##' @param Td dewpoint -##' @return numeric vector +##' @param T air temperature, Kelvin +##' @param Td dewpoint, Kelvin +##' @return Relative Humidity numeric vector ##' @export ##' @author David LeBauer get.rh <- function(T, Td) { - arg <- -L / (Rw * T * Td) * (T - Td) - return(100 * exp(-L / (Rw * T * Td) * (T - Td))) + if(Td >= T){ + rh <- 100 + } else { + Rw <- 461.5 # gas constant for water vapor, J K-1 kg-1 + L <- 2.501e6 + (T-273.15) * (-2430) + arg <- -L / (Rw * T * Td) * (T - Td) + rh <- 100 * exp(arg) + } + return(rh) } # get.rh ##' Convert raster to lat, lon, var diff --git a/modules/data.atmosphere/R/read.register.R b/modules/data.atmosphere/R/read.register.R index d8af6455965..b7a7db708a0 100644 --- a/modules/data.atmosphere/R/read.register.R +++ b/modules/data.atmosphere/R/read.register.R @@ -8,7 +8,7 @@ read.register <- function(register.xml, con) { register <- XML::xmlToList(XML::xmlParse(register.xml)) - print(as.data.frame(register)) + PEcAn.logger::logger.debug(as.data.frame(register)) # check scale if (is.null(register$scale)) { diff --git a/modules/data.atmosphere/R/split_wind.R b/modules/data.atmosphere/R/split_wind.R index 1aecec66186..608198fa8d0 100644 --- a/modules/data.atmosphere/R/split_wind.R +++ b/modules/data.atmosphere/R/split_wind.R @@ -8,7 +8,7 @@ #' @param verbose logical: should \code{\link[ncdf4:ncdf4-package]{ncdf4}} functions print debugging information as they run? #' @param ... other arguments, currently ignored #' -#' @return +#' @return nothing. TODO: Return data frame summarizing results #' @export #' #' @details Currently modifies the files IN PLACE rather than creating a new copy of the files an a new DB record. diff --git a/modules/data.atmosphere/R/tdm_lm_ensemble_sims.R b/modules/data.atmosphere/R/tdm_lm_ensemble_sims.R index fc9108a8f62..b9ee80e71f6 100644 --- a/modules/data.atmosphere/R/tdm_lm_ensemble_sims.R +++ b/modules/data.atmosphere/R/tdm_lm_ensemble_sims.R @@ -1,6 +1,6 @@ ##' Linear Regression Ensemble Simulation -##' Met downscaling function that predicts ensembles of downscaled meteorology -# ----------------------------------- +##' Met downscaling function that predicts ensembles of downscaled meteorology +# ----------------------------------- # Description # ----------------------------------- ##' @title lm_ensemble_sims @@ -10,22 +10,23 @@ ##' function of the tdm workflow titled predict_subdaily_met(). It uses a linear ##' regression approach by generating the hourly values from the coarse data of ##' the file the user selects to downscale based on the hourly models and betas -##' generated by gen.subdaily.models(). -# ----------------------------------- +##' generated by gen.subdaily.models(). +# ----------------------------------- # Parameters # ----------------------------------- ##' @param dat.mod - dataframe to be predicted at the time step of the training data ##' @param n.ens - number of hourly ensemble members to generate ##' @param path.model - path to where the training model & betas is stored ##' @param direction.filter - Whether the model will be filtered backward or forward in time. options = c("backward", "forward") -##' (PalEON will go backward, anybody interested in the future will go forward) +##' (PalEON will go backward, anybody interested in the future will go forward) ##' @param lags.init - a data frame of initialization parameters to match the data in dat.mod -##' @param dat.train - the training data used to fit the model; needed for night/day in +##' @param dat.train - the training data used to fit the model; needed for night/day in ##' surface_downwelling_shortwave_flux_in_air -##' @param precip.distribution - a list with 2 sub-lists containing the number of observations with precip in the training data per day & +##' @param precip.distribution - a list with 2 sub-lists containing the number of observations with precip in the training data per day & ##' the hour of max rain in the training data. This will be used to help solve the "constant drizzle" problem -##' @param force.sanity - (logical) do we force the data to meet sanity checks? +##' @param force.sanity - (logical) do we force the data to meet sanity checks? ##' @param sanity.tries - how many time should we try to predict a reasonable value before giving up? We don't want to end up in an infinite loop +##' @param sanity.sd - how many standard deviations from the mean should be used to determine sane outliers (default 6) ##' @param seed - (optional) set the seed manually to allow reproducible results ##' @param print.progress - if TRUE will print progress bar ##' @export @@ -34,16 +35,17 @@ # Begin Function #---------------------------------------------------------------------- -lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags.list = NULL, - lags.init = NULL, dat.train, precip.distribution, force.sanity=TRUE, sanity.tries=25, +lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags.list = NULL, + lags.init = NULL, dat.train, precip.distribution, + force.sanity=TRUE, sanity.tries=25, sanity.sd=6, seed=Sys.time(), print.progress=FALSE) { - + # Set our random seed set.seed(seed) - - # Just in case we have a capitalization or singular/plural issue + + # Just in case we have a capitalization or singular/plural issue if(direction.filter %in% toupper( c("backward", "backwards"))) direction.filter="backward" - + # Setting our our time indexes if(direction.filter=="backward"){ days.sim <- max(dat.mod$sim.day):min(dat.mod$sim.day) @@ -52,30 +54,30 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. days.sim <- min(dat.mod$sim.day):max(dat.mod$sim.day) lag.time <- max(dat.mod$hour) } - + # Declare the variables of interest that will be called in the # overarching loop - vars.list <- c("surface_downwelling_shortwave_flux_in_air", "air_temperature", - "precipitation_flux", "surface_downwelling_longwave_flux_in_air", + vars.list <- c("surface_downwelling_shortwave_flux_in_air", "air_temperature", + "precipitation_flux", "surface_downwelling_longwave_flux_in_air", "air_pressure", "specific_humidity", "wind_speed") - + # Data info that will be used to help organize dataframe for # downscaling - dat.info <- c("sim.day", "year", "doy", "hour", "air_temperature_max.day", - "air_temperature_min.day", "precipitation_flux.day", "surface_downwelling_shortwave_flux_in_air.day", - "surface_downwelling_longwave_flux_in_air.day", "air_pressure.day", - "specific_humidity.day", "wind_speed.day", "next.air_temperature_max", - "next.air_temperature_min", "next.precipitation_flux", "next.surface_downwelling_shortwave_flux_in_air", - "next.surface_downwelling_longwave_flux_in_air", "next.air_pressure", + dat.info <- c("sim.day", "year", "doy", "hour", "air_temperature_max.day", + "air_temperature_min.day", "precipitation_flux.day", "surface_downwelling_shortwave_flux_in_air.day", + "surface_downwelling_longwave_flux_in_air.day", "air_pressure.day", + "specific_humidity.day", "wind_speed.day", "next.air_temperature_max", + "next.air_temperature_min", "next.precipitation_flux", "next.surface_downwelling_shortwave_flux_in_air", + "next.surface_downwelling_longwave_flux_in_air", "next.air_pressure", "next.specific_humidity", "next.wind_speed") - + # # Set progress bar if(print.progress==TRUE){ pb.index <- 1 pb <- utils::txtProgressBar(min = 1, max = length(vars.list)*length(days.sim), style = 3) utils::setTxtProgressBar(pb, pb.index) } - + # Figure out if we need to extract the approrpiate if (is.null(lags.list) & is.null(lags.init)) { PEcAn.logger::logger.error("lags.init & lags.list are NULL, this is a required argument") @@ -83,23 +85,23 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. if (is.null(lags.init)) { lags.init <- lags.list[[unique(dat.mod$ens.day)]] } - - + + # Set up the ensemble members in a list so the uncertainty can be # propogated dat.sim <- list() - + # ------ Beginning of Downscaling For Loop - + for (v in vars.list) { # Initalize our ouroutput dat.sim[[v]] <- array(dim=c(nrow(dat.mod), n.ens)) - + # create column propagation list and betas progagation list cols.list <- array(dim=c(length(days.sim), n.ens)) # An array with number of days x number of ensembles rows.beta <- vector(length=n.ens) # A vector that ends up being the length of the number of our days - - # This gives us a + + # This gives us a for (i in seq_len(length(days.sim))) { cols.tem <- sample(1:n.ens, n.ens, replace = TRUE) cols.list[i,] <- cols.tem @@ -110,7 +112,7 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. # first_beta <- assign(paste0("betas.", v, "_1"), first_model) # does below need to be first_beta? n.beta <- first_model$var[[1]]$dim[[1]]$len # Number of rows; should be same for all ncdf4::nc_close(first_model) - + # Create beta list so each ensemble for each variable pulls the same # betas # for (i in seq_len(length(days.sim))) { @@ -121,7 +123,7 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. # fill our dat.sim list dat.sim[[v]] <- data.frame(array(dim = c(nrow(dat.mod), n.ens))) - + # -------------------------------- # Looping through time # -------------------------------- @@ -129,105 +131,105 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. for (i in 1:length(days.sim)) { day.now <- unique(dat.mod[dat.mod$sim.day == days.sim[i], "doy"]) rows.now <- which(dat.mod$sim.day == days.sim[i]) - + # shortwave is different because we only want to model daylight if (v == "surface_downwelling_shortwave_flux_in_air") { # Finding which days have measurable light thresh.swdown <- quantile(dat.train$surface_downwelling_shortwave_flux_in_air[dat.train$surface_downwelling_shortwave_flux_in_air > 0], 0.05) - - - hrs.day <- unique(dat.train$time[dat.train$time$DOY == day.now & - dat.train$surface_downwelling_shortwave_flux_in_air > thresh.swdown, + + + hrs.day <- unique(dat.train$time[dat.train$time$DOY == day.now & + dat.train$surface_downwelling_shortwave_flux_in_air > thresh.swdown, "Hour"]) - + rows.mod <- which(dat.mod$sim.day == days.sim[i] & dat.mod$hour %in% hrs.day) dat.temp <- dat.mod[rows.mod, dat.info] - + # dat.temp <- merge(dat.temp, data.frame(ens=paste0("X", 1:n.ens))) if (i == 1) { sim.lag <- utils::stack(lags.init[[v]]) names(sim.lag) <- c(paste0("lag.", v), "ens") - + } else { sim.lag <- utils::stack(data.frame(array(0,dim = c(1, ncol(dat.sim[[v]]))))) names(sim.lag) <- c(paste0("lag.", v), "ens") } dat.temp <- merge(dat.temp, sim.lag, all.x = TRUE) - + } else if (v == "air_temperature") { dat.temp <- dat.mod[rows.now, dat.info] - + # Set up the lags if (i == 1) { # First time through, so pull from our inital lags sim.lag <- utils::stack(lags.init$air_temperature) names(sim.lag) <- c("lag.air_temperature", "ens") - + sim.lag$lag.air_temperature_min <- utils::stack(lags.init$air_temperature_min)[,1] sim.lag$lag.air_temperature_max <- utils::stack(lags.init$air_temperature_max)[,1] } else { sim.lag <- utils::stack(data.frame(array(dat.sim[["air_temperature"]][dat.mod$sim.day == (days.sim[i-1]) & - dat.mod$hour == lag.time, ], + dat.mod$hour == lag.time, ], dim = c(1, ncol(dat.sim$air_temperature))))) names(sim.lag) <- c("lag.air_temperature", "ens") - sim.lag$lag.air_temperature_min <- utils::stack(apply(dat.sim[["air_temperature"]][dat.mod$sim.day == days.sim[i-1], ], 2, min))[, 1] - sim.lag$lag.air_temperature_max <- utils::stack(apply(dat.sim[["air_temperature"]][dat.mod$sim.day == days.sim[i-1], ], 2, max))[, 1] + sim.lag$lag.air_temperature_min <- utils::stack(apply(data.frame(dat.sim[["air_temperature"]][dat.mod$sim.day == days.sim[i-1], ]), 2, min))[, 1] + sim.lag$lag.air_temperature_max <- utils::stack(apply(data.frame(dat.sim[["air_temperature"]][dat.mod$sim.day == days.sim[i-1], ]), 2, max))[, 1] } dat.temp <- merge(dat.temp, sim.lag, all.x = TRUE) } else if (v == "precipitation_flux") { dat.temp <- dat.mod[rows.now, dat.info] - + dat.temp[,v] <- 99999 dat.temp$rain.prop <- 99999 - + day.now <- unique(dat.temp$doy) - + # Set up the lags This is repeated differently because Precipitation # dat.temp is merged if (i == 1) { sim.lag <- utils::stack(lags.init[[v]]) names(sim.lag) <- c(paste0("lag.", v), "ens") - + } else { sim.lag <- utils::stack(data.frame(array(dat.sim[[v]][dat.mod$sim.day == days.sim[i-1] & - dat.mod$hour == lag.time, ], + dat.mod$hour == lag.time, ], dim = c(1, ncol(dat.sim[[v]]))))) names(sim.lag) <- c(paste0("lag.", v), "ens") } dat.temp <- merge(dat.temp, sim.lag, all.x = TRUE) - + # End Precipitation Flux specifics } else { dat.temp <- dat.mod[rows.now, dat.info] - + if (i == 1) { sim.lag <- utils::stack(lags.init[[v]]) names(sim.lag) <- c(paste0("lag.", v), "ens") - + } else { sim.lag <- utils::stack(data.frame(array(dat.sim[[v]][dat.mod$sim.day == days.sim[i-1] & - dat.mod$hour == lag.time, ], + dat.mod$hour == lag.time, ], dim = c(1, ncol(dat.sim[[v]]))))) names(sim.lag) <- c(paste0("lag.", v), "ens") } dat.temp <- merge(dat.temp, sim.lag, all.x = TRUE) } # End special formatting - + # Create dummy value dat.temp[,v] <- 99999 - + # Creating some necessary dummy variable names vars.sqrt <- c("surface_downwelling_longwave_flux_in_air", "wind_speed") vars.log <- c("specific_humidity") - if (v %in% vars.sqrt) { + if (v %in% vars.sqrt) { dat.temp[,paste0("sqrt(",v,")")] <- sqrt(dat.temp[,v]) - } else if (v %in% vars.log) { - dat.temp[,paste0("log(",v,")")] <- log(dat.temp[,v]) + } else if (v %in% vars.log) { + dat.temp[,paste0("log(",v,")")] <- log(dat.temp[,v]) } # Load the saved model - load(file.path(path.model, v, paste0("model_", v, "_", day.now, + load(file.path(path.model, v, paste0("model_", v, "_", day.now, ".Rdata"))) - + # Pull coefficients (betas) from our saved matrix # for (i in seq_len(length(days.sim))) { @@ -235,45 +237,63 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. # rows.beta[i] <- betas.tem # } # rows.beta <- as.numeric(rows.beta) + + # n.new <- ifelse(n.ens==1, 10, n.ens) # If we're not creating an ensemble, we'll add a mean step to remove chance of odd values n.new <- n.ens cols.redo <- 1:n.new sane.attempt=0 betas_nc <- ncdf4::nc_open(file.path(path.model, v, paste0("betas_", v, "_", day.now, ".nc"))) col.beta <- betas_nc$var[[1]]$dim[[2]]$len # number of coefficients while(n.new>0 & sane.attempt <= sanity.tries){ - betas.tem <- sample(1:(n.beta-n.new), 1, replace = TRUE) - - Rbeta <- as.matrix(ncdf4::ncvar_get(betas_nc, paste(day.now), c(betas.tem,1), c(n.new,col.beta)), ncol = col.beta) - + + if(n.ens==1){ + Rbeta <- matrix(mod.save$coef, ncol=col.beta) + } else { + betas.tem <- sample(1:max((n.beta-n.new), 1), 1, replace = TRUE) + Rbeta <- matrix(ncdf4::ncvar_get(betas_nc, paste(day.now), c(betas.tem,1), c(n.new,col.beta)), ncol = col.beta) + } + + if(ncol(Rbeta)!=col.beta) Rbeta <- t(Rbeta) - + # If we're starting from scratch, set up the prediction matrix if(sane.attempt==0){ dat.pred <- matrix(nrow=nrow(dat.temp), ncol=n.ens) } - - dat.pred[,cols.redo] <- subdaily_pred(newdata = dat.temp, model.predict = mod.save, - Rbeta = Rbeta, resid.err = FALSE, model.resid = NULL, Rbeta.resid = NULL, - n.ens = n.new) - + + # if(n.ens==1){ + # dat.dum <- subdaily_pred(newdata = dat.temp, model.predict = mod.save, + # Rbeta = Rbeta, resid.err = FALSE, model.resid = NULL, Rbeta.resid = NULL, + # n.ens = n.new) + # dat.pred[,1] <- apply(dat.dum, 1, mean) + # } else { + dat.pred[,cols.redo] <- subdaily_pred(newdata = dat.temp, model.predict = mod.save, + Rbeta = Rbeta, resid.err = FALSE, model.resid = NULL, Rbeta.resid = NULL, + n.ens = n.new) + + # } + # Occasionally specific humidty may go serioulsy off the rails if(v=="specific_humidity" & (max(dat.pred)>log(40e-3) | min(dat.pred)log(40e-3)] <- log(40e-3) dat.pred[dat.pred 0) { - tmp <- 1:nrow(dat.pred) # A dummy vector of the - for (j in cols.redo) { + + # if(n.ens == 1) next + cols.check <- cols.redo + if (max(dat.pred[,cols.check]) > 0) { + tmp <- 1:nrow(dat.pred) # A dummy vector of the + for (j in cols.check) { if (min(dat.pred[, j]) >= 0) next # skip if no negative rain to redistribute rows.neg <- which(dat.pred[, j] < 0) - rows.add <- sample(tmp[!tmp %in% rows.neg], length(rows.neg), + rows.add <- sample(tmp[!tmp %in% rows.neg], length(rows.neg), replace = TRUE) - + # Redistribute days with negative rain for (z in 1:length(rows.neg)) { dat.pred[rows.add[z], j] <- dat.pred[rows.add[z], j] - dat.pred[rows.neg[z], j] @@ -282,23 +302,26 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. } # j End loop # Make sure each day sums to 1 - dat.pred[,cols.redo] <- dat.pred[,cols.redo]/rowSums(dat.pred[,cols.redo], na.rm=T) + # dat.pred[,cols.check] <- dat.pred[,cols.check]/colSums(data.frame(dat.pred[,cols.check]), na.rm=T) dat.pred[is.na(dat.pred)] <- 0 } # End case of re-proportioning - + # Convert precip proportions into real units - dat.pred[,cols.redo] <- dat.pred[,cols.redo] * as.vector((dat.temp$precipitation_flux.day))*length(unique(dat.temp$hour)) + # Total Daily precip = precipitaiton_flux.day*24*60*60 + # precip.day <- dat.temp$precipitation_flux.day[1]*nrow(dat.temp) + precip.day <- dat.temp$precipitation_flux.day[1] + dat.pred[,cols.check] <- dat.pred[,cols.check] * precip.day } # End Precip re-propogation - + # ----- # SANITY CHECKS!!! # ----- # Here we'll also take into account the values from the past 2 weeks using a "six-sigma filter" per email with Ankur # -- this is apparently what they do with the flux data - + # vars.sqrt <- c("surface_downwelling_longwave_flux_in_air", "wind_speed") # vars.log <- c("specific_humidity") - + # Determine which ensemble members fail sanity checks #don't forget to check for transformed variables # vars.transform <- c("surface_downwelling_shortwave_flux_in_air", "specific_humidity", "surface_downwelling_longwave_flux_in_air", "wind_speed") @@ -309,12 +332,17 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. } else { rows.filter <- which(dat.mod$sim.day <= days.sim[i] & dat.mod$sim.day >= days.sim[i]-14) } - dat.filter <- utils::stack(dat.sim[[v]][rows.filter,])[,1] - - filter.mean <- mean(dat.filter, na.rm=T) - filter.sd <- sd(dat.filter, na.rm=T) + if(n.ens>1){ + dat.filter <- utils::stack(dat.sim[[v]][rows.filter,])[,1] + } else { + dat.filter <- dat.sim[[v]][rows.filter,] + } + + + filter.mean <- mean(dat.filter, na.rm=T) + filter.sd <- sd(dat.filter, na.rm=T) } else { - + if(v %in% vars.sqrt){ filter.mean <- mean(c(dat.pred^2, utils::stack(dat.sim[[v]])[,1]), na.rm=T) filter.sd <- sd(c(dat.pred^2, utils::stack(dat.sim[[v]])[,1]), na.rm=T) @@ -326,48 +354,48 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. filter.sd <- sd(c(dat.pred, utils::stack(dat.sim[[v]])[,1]), na.rm=T) } } - + if(v %in% c("air_temperature", "air_temperature_maximum", "air_temperature_minimum")){ # max air temp = 70 C; hottest temperature from sattellite; very ridiculous # min air temp = -95 C; colder than coldest natural temperature recorded in Antarctica - + tmax.ens <- max(dat.temp$air_temperature_max.day) tmin.ens <- min(dat.temp$air_temperature_min.day) - - # we'll allow some drift outside of what we have for our max/min, but not too much; + + # we'll allow some drift outside of what we have for our max/min, but not too much; # - right now general rule of thumb of 2 degrees leeway on the prescribed - cols.redo <- which(apply(dat.pred, 2, function(x) min(x) < 273.15-95 | max(x) > 273.15+70 | - # min(x) < tmin.ens-2 | max(x) > tmax.ens+2 | - min(x) < filter.mean-6*filter.sd | max(x) > filter.mean+6*filter.sd + cols.redo <- which(apply(dat.pred, 2, function(x) min(x) < 184 | max(x) > 331 | + # min(x) < tmin.ens-2 | max(x) > tmax.ens+2 | + min(x) < filter.mean-sanity.sd*filter.sd | max(x) > filter.mean+sanity.sd*filter.sd )) } - #"specific_humidity", + #"specific_humidity", if(v == "specific_humidity"){ #LOG!! # Based on google, it looks like values of 30 g/kg can occur in the tropics, so lets go above that # Also, the minimum humidity can't be 0 so lets just make it extremely dry; lets set this for 1 g/Mg - cols.redo <- which(apply(dat.pred, 2, function(x) min(exp(x)) < 1e-6 | max(exp(x)) > 40e-3 | - min(exp(x)) < filter.mean-6*filter.sd | - max(exp(x)) > filter.mean+6*filter.sd + cols.redo <- which(apply(dat.pred, 2, function(x) min(exp(x)) < 1e-6 | max(exp(x)) > 3.2e-2 | + min(exp(x)) < filter.mean-sanity.sd*filter.sd | + max(exp(x)) > filter.mean+sanity.sd*filter.sd ) ) } - #"surface_downwelling_shortwave_flux_in_air", + #"surface_downwelling_shortwave_flux_in_air", if(v == "surface_downwelling_shortwave_flux_in_air"){ # Based on something found from Columbia, average Radiative flux at ATM is 1360 W/m2, so for a daily average it should be less than this # Lets round 1360 and divide that by 2 (because it should be a daily average) and conservatively assume albedo of 20% (average value is more like 30) # Source http://eesc.columbia.edu/courses/ees/climate/lectures/radiation/ dat.pred[dat.pred < 0] <- 0 - cols.redo <- which(apply(dat.pred, 2, function(x) max(x) > 1360 | min(x) < filter.mean-6*filter.sd | - max(x) > filter.mean+6*filter.sd - )) + cols.redo <- which(apply(dat.pred, 2, function(x) max(x) > 1500 | min(x) < filter.mean-sanity.sd*filter.sd | + max(x) > filter.mean+sanity.sd*filter.sd + )) } if(v == "air_pressure"){ # According to wikipedia the highest barometric pressure ever recorded was 1085.7 hPa = 1085.7*100 Pa; Dead sea has average pressure of 1065 hPa # - Lets round up to 1100 hPA # Also according to Wikipedia, the lowest non-tornadic pressure ever measured was 870 hPA - cols.redo <- which(apply(dat.pred, 2, function(x) min(x) < 850*100 | max(x) > 1100*100 | - min(x) < filter.mean-6*filter.sd | - max(x) > filter.mean+6*filter.sd - )) + cols.redo <- which(apply(dat.pred, 2, function(x) min(x) < 45000 | max(x) > 110000 | + min(x) < filter.mean-sanity.sd*filter.sd | + max(x) > filter.mean+sanity.sd*filter.sd + )) } if(v == "surface_downwelling_longwave_flux_in_air"){ # SQRT # A NASA presentation has values topping out ~300 and min ~0: https://ceres.larc.nasa.gov/documents/STM/2003-05/pdf/smith.pdf @@ -375,36 +403,37 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. # Based on what what CRUNCEP did, lets assume these are annual averages, so we can do 50% above it and for the min, in case we run tropics, lets go 130/4 # ED2 sanity checks bound longwave at 40 & 600 cols.redo <- which(apply(dat.pred, 2, function(x) min(x^2) < 40 | max(x^2) > 600 | - min(x^2) < filter.mean-6*filter.sd | - max(x^2) > filter.mean+6*filter.sd - )) - + min(x^2) < filter.mean-sanity.sd*filter.sd | + max(x^2) > filter.mean+sanity.sd*filter.sd + )) + } if(v == "wind_speed"){ # According to wikipedia, the hgihest wind speed ever recorded is a gust of 113 m/s; the maximum 5-mind wind speed is 49 m/s - cols.redo <- which(apply(dat.pred, 2, function(x) max(x^2) > 50 | - min(x^2) < filter.mean-6*filter.sd | - max(x^2) > filter.mean+6*filter.sd - )) + cols.redo <- which(apply(dat.pred, 2, function(x) max(x^2) > 85 | + min(x^2) < filter.mean-sanity.sd*filter.sd | + max(x^2) > filter.mean+sanity.sd*filter.sd + )) } if(v == "precipitation_flux"){ # According to wunderground, ~16" in 1 hr is the max # https://www.wunderground.com/blog/weatherhistorian/what-is-the-most-rain-to-ever-fall-in-one-minute-or-one-hour.html # 16; x25.4 = inches to mm; /(60*60) = hr to sec - cols.redo <- which(apply(dat.pred, 2, function(x) max(x) > 16*25.4/(60*60) - )) + # Updated to ED2 max: 400 mm/hr + cols.redo <- which(apply(dat.pred, 2, function(x) max(x) > 0.1111 + )) } - + n.new = length(cols.redo) if(force.sanity){ sane.attempt = sane.attempt + 1 - } else { + } else { # If we're not forcing sanity, just stop now sane.attempt=sanity.tries + 1 } # ----- } # End while case - + # If we ran out of attempts, but want to foce sanity, do so now if(force.sanity & n.new>0){ # If we're still struggling, but we have at least some workable columns, lets just duplicate those: @@ -417,98 +446,98 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. # Shouldn't be a huge problem, but it's not looking good # min(x) < 273.15-95 | max(x) > 273.15+70 warning(paste("Forcing Sanity:", v)) - if(min(dat.pred) < max(filter.mean-6*filter.sd)){ - qtrim <- max(filter.mean-6*filter.sd) + if(min(dat.pred) < max(filter.mean-sanity.sd*filter.sd)){ + qtrim <- max(filter.mean-sanity.sd*filter.sd) dat.pred[dat.pred < qtrim] <- qtrim } - if(max(dat.pred) > min(1360, filter.mean+6*filter.sd)){ - qtrim <- min(1360, filter.mean+6*filter.sd) + if(max(dat.pred) > min(1360, filter.mean+sanity.sd*filter.sd)){ + qtrim <- min(1360, filter.mean+sanity.sd*filter.sd) dat.pred[dat.pred > qtrim] <- qtrim } - + } else if(v=="air_temperature"){ # Shouldn't be a huge problem, but it's not looking good # min(x) < 273.15-95 | max(x) > 273.15+70 warning(paste("Forcing Sanity:", v)) - if(min(dat.pred) < max(273.15-95, filter.mean-6*filter.sd )){ - qtrim <- max(273.15-95, filter.mean-6*filter.sd) + if(min(dat.pred) < max(273.15-95, filter.mean-sanity.sd*filter.sd )){ + qtrim <- max(273.15-95, filter.mean-sanity.sd*filter.sd) dat.pred[dat.pred < qtrim] <- qtrim } - if(max(dat.pred) > min(273.15+70, filter.mean+6*filter.sd)){ - qtrim <- min(273.15+70, filter.mean+6*filter.sd) + if(max(dat.pred) > min(273.15+70, filter.mean+sanity.sd*filter.sd)){ + qtrim <- min(273.15+70, filter.mean+sanity.sd*filter.sd) dat.pred[dat.pred > qtrim] <- qtrim } - + } else if(v=="air_pressure"){ # A known problem child warning(paste("Forcing Sanity:", v)) - if(min(dat.pred) < max(870*100, filter.mean-6*filter.sd )){ - qtrim <- max(870*100, filter.mean-6*filter.sd) + if(min(dat.pred) < max(870*100, filter.mean-sanity.sd*filter.sd )){ + qtrim <- max(870*100, filter.mean-sanity.sd*filter.sd) dat.pred[dat.pred < qtrim] <- qtrim } - if(max(dat.pred) > min(1100*100, filter.mean+6*filter.sd)){ - qtrim <- min(1100*100, filter.mean+6*filter.sd) + if(max(dat.pred) > min(1100*100, filter.mean+sanity.sd*filter.sd)){ + qtrim <- min(1100*100, filter.mean+sanity.sd*filter.sd) dat.pred[dat.pred > qtrim] <- qtrim } - + } else if(v=="surface_downwelling_longwave_flux_in_air"){ # A known problem child # ED2 sanity checks boudn longwave at 40 & 600 warning(paste("Forcing Sanity:", v)) - if(min(dat.pred^2) < max(40, filter.mean-6*filter.sd )){ - qtrim <- max(40, filter.mean-6*filter.sd) + if(min(dat.pred^2) < max(40, filter.mean-sanity.sd*filter.sd )){ + qtrim <- max(40, filter.mean-sanity.sd*filter.sd) dat.pred[dat.pred^2 < qtrim] <- sqrt(qtrim) } - if(max(dat.pred^2) > min(600, filter.mean+6*filter.sd)){ - qtrim <- min(600, filter.mean+6*filter.sd) + if(max(dat.pred^2) > min(600, filter.mean+sanity.sd*filter.sd)){ + qtrim <- min(600, filter.mean+sanity.sd*filter.sd) dat.pred[dat.pred^2 > qtrim] <- sqrt(qtrim) } - + } else if(v=="specific_humidity") { warning(paste("Forcing Sanity:", v)) - if(min(exp(dat.pred)) < max(1e-6, filter.mean-6*filter.sd )){ - qtrim <- max(1e-6, filter.mean-6*filter.sd) + if(min(exp(dat.pred)) < max(1e-6, filter.mean-sanity.sd*filter.sd )){ + qtrim <- max(1e-6, filter.mean-sanity.sd*filter.sd) dat.pred[exp(dat.pred) < qtrim] <- log(qtrim) } - if(max(exp(dat.pred)) > min(40e-3, filter.mean+6*filter.sd)){ - qtrim <- min(40e-3, filter.mean+6*filter.sd) + if(max(exp(dat.pred)) > min(30e-3, filter.mean+sanity.sd*filter.sd)){ + qtrim <- min(40e-3, filter.mean+sanity.sd*filter.sd) dat.pred[exp(dat.pred) > qtrim] <- log(qtrim) } - + } else if(v=="wind_speed"){ # A known problem child warning(paste("Forcing Sanity:", v)) - # if(min(dat.pred^2) < max(0, filter.mean-6*filter.sd )){ + # if(min(dat.pred^2) < max(0, filter.mean-sanity.sd*filter.sd )){ # qtrim <- max(0, 1) # dat.pred[dat.pred < qtrim] <- qtrim # } - if(max(dat.pred^2) > min(50, filter.mean+6*filter.sd)){ - qtrim <- min(50, filter.mean+6*filter.sd) + if(max(dat.pred^2) > min(50, filter.mean+sanity.sd*filter.sd)){ + qtrim <- min(50, filter.mean+sanity.sd*filter.sd) dat.pred[dat.pred^2 > qtrim] <- sqrt(qtrim) } - + } else { stop(paste("Unable to produce a sane prediction:", v, "- day", day.now, "; problem child =", paste(cols.redo, collapse=" "))) } - + } } # End force sanity - + ncdf4::nc_close(betas_nc) - + #----- Now we do a little quality control per variable # un-transforming our variables - if (v %in% vars.sqrt) { + if (v %in% vars.sqrt) { dat.pred <- dat.pred^2 - } else if (v %in% vars.log) { - dat.pred <- exp(dat.pred) + } else if (v %in% vars.log) { + dat.pred <- exp(dat.pred) } - - # ---------- + + # ---------- # Re-distribute precip so we don't get the constant drizzle problem # -- this could go earlier, but I'm being lazy because I don't want to mess with cols.redo - # ---------- + # ---------- if(v == "precipitation_flux"){ # Pick the number of hours to spread rain across from our observed distribution # in case we don't have a large distribution, use multiple days @@ -519,52 +548,62 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. } else { rain.ind <- (day.now-3):(day.now+3) } - + hrs.rain <- sample(unlist(precip.distribution$hrs.rain[rain.ind]),1) # hr.max <- sample(precip.distribution$hrs.max[[day.now]],1) - + for(j in 1:ncol(dat.pred)){ obs.day <- nrow(dat.pred)/ncol(dat.pred) start.ind <- seq(1, nrow(dat.pred), by=obs.day) for(z in seq_along(start.ind)){ rain.now <- dat.pred[start.ind[z]:(start.ind[z]+obs.day-1),j] hrs.now <- which(rain.now>0) - + if(length(hrs.now)<=hrs.rain) next # If we don't need to redistribute, skip what's next - + # Figure out when it's going to rain based on what normally has the most number of hours hrs.add <- sample(unlist(precip.distribution$hrs.max[rain.ind]), hrs.rain, replace=T) hrs.go <- hrs.now[!hrs.now %in% hrs.add] hrs.wet <- sample(hrs.add, length(hrs.go), replace=T) - + for(dry in seq_along(hrs.go)){ - rain.now[hrs.wet[dry]] <- rain.now[hrs.go[dry]] + rain.now[hrs.wet[dry]] <- rain.now[hrs.wet[dry]] + rain.now[hrs.go[dry]] rain.now[hrs.go[dry]] <- 0 } - + # Put the rain back into place dat.pred[start.ind[z]:(start.ind[z]+obs.day-1),j] <- rain.now } # End row loop } # End column loop } # End hour redistribution - # ---------- - - # ---------- + # ---------- + + # ---------- # Begin propogating values and saving values Shortwave Radiaiton - # ---------- + # ---------- if (v == "surface_downwelling_shortwave_flux_in_air") { # Randomly pick which values to save & propogate - cols.prop <- as.integer(cols.list[i,]) - for (j in 1:ncol(dat.sim[[v]])) { - dat.sim[[v]][rows.mod, j] <- dat.pred[dat.temp$ens == paste0("X", j), cols.prop[j]] + + if(ncol(dat.sim[[v]])>1){ + cols.prop <- as.integer(cols.list[i,]) + for (j in 1:ncol(dat.sim[[v]])) { + dat.sim[[v]][rows.mod, j] <- dat.pred[dat.temp$ens == paste0("X", j), cols.prop[j]] + } + } else { # Only one ensemble member... it's really easy + dat.sim[[v]][rows.mod, 1] <- dat.pred } - + + dat.sim[[v]][rows.now[!rows.now %in% rows.mod], ] <- 0 } else { - cols.prop <- as.integer(cols.list[i,]) - - for (j in 1:ncol(dat.sim[[v]])) { - dat.sim[[v]][rows.now, j] <- dat.pred[dat.temp$ens == paste0("X", j), cols.prop[j]] + + if(ncol(dat.sim[[v]])>1){ + cols.prop <- as.integer(cols.list[i,]) + for (j in 1:ncol(dat.sim[[v]])) { + dat.sim[[v]][rows.now, j] <- dat.pred[dat.temp$ens == paste0("X", j), cols.prop[j]] + } + } else { # Only one ensemble member... it's really easy + dat.sim[[v]][rows.now, 1] <- dat.pred } } rm(mod.save) # Clear out the model to save memory @@ -573,12 +612,12 @@ lm_ensemble_sims <- function(dat.mod, n.ens, path.model, direction.filter, lags. utils::setTxtProgressBar(pb, pb.index) pb.index <- pb.index + 1 } - + rm(dat.temp, dat.pred) } # end day loop # -------------------------------- - - } + + } # End vars.list # ---------- End of downscaling for loop return(dat.sim) } diff --git a/modules/data.atmosphere/R/tdm_model_train.R b/modules/data.atmosphere/R/tdm_model_train.R index ad42210e1bc..685f7880590 100644 --- a/modules/data.atmosphere/R/tdm_model_train.R +++ b/modules/data.atmosphere/R/tdm_model_train.R @@ -65,10 +65,8 @@ model.train <- function(dat.subset, v, n.beta, resids = resids, threshold = NULL # Precip needs to be a bit different. We're going to calculate the # fraction of precip occuring in each hour we're going to estimate the # probability distribution of rain occuring in a given hour - dat.subset$rain.prop <- dat.subset$precipitation_flux/(dat.subset$precipitation_flux.day * - length(unique(dat.subset$hour))) - mod.doy <- lm(rain.prop ~ as.ordered(hour) * precipitation_flux.day - - 1 - as.ordered(hour) - precipitation_flux.day, data = dat.subset) + dat.subset$rain.prop <- dat.subset$precipitation_flux/(dat.subset$precipitation_flux.day) + mod.doy <- lm(rain.prop ~ as.ordered(hour) - 1 , data = dat.subset) } if (v == "air_pressure") { @@ -105,10 +103,15 @@ model.train <- function(dat.subset, v, n.beta, resids = resids, threshold = NULL # ----- Each variable must do this Generate a bunch of random # coefficients that we can pull from without needing to do this step # every day - mod.coef <- coef(mod.doy) - mod.cov <- vcov(mod.doy) - piv <- as.numeric(which(!is.na(mod.coef))) - Rbeta <- MASS::mvrnorm(n = n.beta, mod.coef[piv], mod.cov) + if(n.beta>1){ + mod.coef <- coef(mod.doy) + mod.cov <- vcov(mod.doy) + piv <- as.numeric(which(!is.na(mod.coef))) + Rbeta <- MASS::mvrnorm(n = n.beta, mod.coef[piv], mod.cov[piv,piv]) + } else { + Rbeta <- matrix(coef(mod.doy), nrow=1) + colnames(Rbeta) <- names(coef(mod.doy)) + } list.out <- list(model = mod.doy, betas = Rbeta) @@ -165,12 +168,17 @@ model.train <- function(dat.subset, v, n.beta, resids = resids, threshold = NULL 1, data = dat.subset[, ]) } - res.coef <- coef(resid.model) - res.cov <- vcov(resid.model) - res.piv <- as.numeric(which(!is.na(res.coef))) - - beta.resid <- MASS::mvrnorm(n = n.beta, res.coef[res.piv], - res.cov) + if(n.beta>1){ + res.coef <- coef(resid.model) + res.cov <- vcov(resid.model) + res.piv <- as.numeric(which(!is.na(res.coef))) + + beta.resid <- MASS::mvrnorm(n = n.beta, res.coef[res.piv], res.cov) + } else { + beta.resid <- matrix(coef(resid.model), nrow=1) + colnames(beta.resid) <- names(coef(mod.doy)) + } + list.out[["model.resid"]] <- resid.model list.out[["betas.resid"]] <- beta.resid diff --git a/modules/data.atmosphere/R/tdm_predict_subdaily_met.R b/modules/data.atmosphere/R/tdm_predict_subdaily_met.R index 9f4da154249..58c3d72845e 100644 --- a/modules/data.atmosphere/R/tdm_predict_subdaily_met.R +++ b/modules/data.atmosphere/R/tdm_predict_subdaily_met.R @@ -30,6 +30,7 @@ ##' @param ens.labs - vector containing the labels (suffixes) for each ensemble member; this allows you to add to your ##' ensemble rather than overwriting with a default naming scheme ##' @param resids - logical stating whether to pass on residual data or not +##' @param adjust.pr - adjustment factor fore preciptiation when the extracted values seem off ##' @param force.sanity - (logical) do we force the data to meet sanity checks? ##' @param sanity.tries - how many time should we try to predict a reasonable value before giving up? We don't want to end up in an infinite loop ##' @param overwrite logical: replace output file if it already exists? @@ -55,7 +56,7 @@ #---------------------------------------------------------------------- predict_subdaily_met <- function(outfolder, in.path, in.prefix, path.train, direction.filter="forward", lm.models.base, - yrs.predict=NULL, ens.labs = 1:3, resids = FALSE, force.sanity=TRUE, sanity.tries=25, + yrs.predict=NULL, ens.labs = 1:3, resids = FALSE, adjust.pr=1, force.sanity=TRUE, sanity.tries=25, overwrite = FALSE, verbose = FALSE, seed=format(Sys.time(), "%m%d"), print.progress=FALSE, ...) { if(direction.filter %in% toupper( c("backward", "backwards"))) direction.filter="backward" @@ -72,7 +73,7 @@ predict_subdaily_met <- function(outfolder, in.path, in.prefix, path.train, dire n.ens <- length(ens.labs) # Update in.path with our prefix (seems silly, but helps with parallelization) - in.path <- file.path(in.path, in.prefix) + # in.path <- file.path(in.path, in.prefix) # Extract the lat/lon info from the first of the source files fnow <- dir(in.path, ".nc")[1] @@ -189,6 +190,18 @@ predict_subdaily_met <- function(outfolder, in.path, in.prefix, path.train, dire yrs.train=yr.train, yrs.source=yrs.tdm[y], n.ens=1, seed=201708, pair.mems = FALSE) + # Adjust the preciptiation for the source data if it can't be right (default = 1) + met.out$dat.source$precipitation_flux <- met.out$dat.source$precipitation_flux*adjust.pr + + # Create wind speed variable if it doesn't exist + if(!"wind_speed" %in% names(met.out$dat.train) & "eastward_wind" %in% names(met.out$dat.train)){ + met.out$dat.train$wind_speed <- sqrt(met.out$dat.train$eastward_wind^2 + met.out$dat.train$northward_wind^2) + } + if(!"wind_speed" %in% names(met.out$dat.source) & "eastward_wind" %in% names(met.out$dat.source)){ + met.out$dat.source$wind_speed <- sqrt(met.out$dat.source$eastward_wind^2 + met.out$dat.source$northward_wind^2) + } + + # Package the raw data into the dataframe that will get passed into the function dat.ens <- data.frame(year = met.out$dat.source$time$Year, doy = met.out$dat.source$time$DOY, @@ -203,12 +216,6 @@ predict_subdaily_met <- function(outfolder, in.path, in.prefix, path.train, dire specific_humidity.day = met.out$dat.source$specific_humidity, wind_speed.day = met.out$dat.source$wind_speed) - # Create wind speed variable if it doesn't exist - if(!"wind_speed" %in% names(met.out$dat.source)){ - dat.ens$wind_speed <- sqrt(met.out$dat.source$eastward_wind^2 + met.out$dat.source$northward_wind^2) - } else { - dat.ens$wind_speed <- met.out$dat.source$wind_speed - } # Set up our simulation time variables; it *should* be okay that this resets each year since it's really only doy that matters dat.ens$sim.hr <- trunc(as.numeric(difftime(dat.ens$date, min(dat.ens$date), tz = "GMT", units = "hour")))+1 @@ -249,6 +256,17 @@ predict_subdaily_met <- function(outfolder, in.path, in.prefix, path.train, dire met.nxt <- align.met(train.path=in.path, source.path=in.path, yrs.train=yrs.tdm[y], yrs.source=yrs.tdm[y], n.ens=1, seed=201708, pair.mems = FALSE) } + # Adjust precipitation rate for both "train" and "source" since both are for the data being downscaled + met.nxt$dat.train$precipitation_flux <- met.nxt$dat.train$precipitation_flux*adjust.pr + met.nxt$dat.source$precipitation_flux <- met.nxt$dat.source$precipitation_flux*adjust.pr + + if(!"wind_speed" %in% names(met.nxt$dat.train) & "eastward_wind" %in% names(met.nxt$dat.train)){ + met.nxt$dat.train$wind_speed <- sqrt(met.nxt$dat.train$eastward_wind^2 + met.nxt$dat.train$northward_wind^2) + } + if(!"wind_speed" %in% names(met.nxt$dat.source) & "eastward_wind" %in% names(met.nxt$dat.source)){ + met.nxt$dat.source$wind_speed <- sqrt(met.nxt$dat.source$eastward_wind^2 + met.nxt$dat.source$northward_wind^2) + } + dat.nxt <- data.frame(year = met.nxt$dat.train$time$Year, doy = met.nxt$dat.train$time$DOY-met.lag, next.air_temperature_max = met.nxt$dat.train$air_temperature_maximum, @@ -352,12 +370,16 @@ predict_subdaily_met <- function(outfolder, in.path, in.prefix, path.train, dire } # End j loop for (i in seq_len(n.ens)) { - df <- data.frame(matrix(ncol = length(nc.info$name), nrow = nrow(dat.ens))) - colnames(df) <- nc.info$name + df <- data.frame(matrix(ncol = length(nc.info$CF.name), nrow = nrow(dat.ens))) + colnames(df) <- nc.info$CF.name for (j in nc.info$CF.name) { - ens.sims[[j]][["X1"]] + # ens.sims[[j]][["X1"]] + if(n.ens>1){ e <- paste0("X", i) - df[,j] <- ens.sims[[j]][[e]] + df[,paste(j)] <- ens.sims[[j]][[e]] + } else { + df[,paste(j)] <- ens.sims[[j]] + } } df <- df[, c("air_temperature", "precipitation_flux", "surface_downwelling_shortwave_flux_in_air", diff --git a/modules/data.atmosphere/R/tdm_subdaily_pred.R b/modules/data.atmosphere/R/tdm_subdaily_pred.R index cc9ad91772a..1b02852519c 100644 --- a/modules/data.atmosphere/R/tdm_subdaily_pred.R +++ b/modules/data.atmosphere/R/tdm_subdaily_pred.R @@ -70,7 +70,13 @@ subdaily_pred <- function(newdata, model.predict, Rbeta, resid.err = FALSE, mode err.resid <- Xp.res[, resid.piv] %*% t(Rbeta.resid) } # End residual error - dat.sim <- Xp[, piv] %*% t(Rbeta) + err.resid + if(length(piv)==ncol(Rbeta)){ + dat.sim <- Xp[, piv] %*% t(Rbeta) + err.resid + } else { + # dat.sim <- Xp[,piv] %*% t(Rbeta[,piv]) + err.resid + dat.sim <- Xp[,piv] %*% t(matrix(Rbeta[,piv], nrow=nrow(Rbeta))) + err.resid + } + return(dat.sim) diff --git a/modules/data.atmosphere/README.md b/modules/data.atmosphere/README.md index 0bbc556c844..225b4e9c000 100644 --- a/modules/data.atmosphere/README.md +++ b/modules/data.atmosphere/README.md @@ -11,7 +11,8 @@ Current list of input meteorological formats supported, functions are named `dow * FACE * ALMA * NOAA GEFS -* arbitrary csv files +* arbitrary csv files +* ICOS ## Installation diff --git a/modules/data.atmosphere/data/FLUXNET.sitemap.R b/modules/data.atmosphere/data/FLUXNET.sitemap.R new file mode 100644 index 00000000000..823665ae51a --- /dev/null +++ b/modules/data.atmosphere/data/FLUXNET.sitemap.R @@ -0,0 +1,5 @@ + +FLUXNET.sitemap <- utils::read.csv( + file = "FLUXNET.sitemap.csv", + colClasses = "character", + row.names = 1) diff --git a/modules/data.atmosphere/inst/ERA5/ERA5_db_register.R b/modules/data.atmosphere/inst/ERA5/ERA5_db_register.R index 8f28f528630..cb0aa72c4ed 100644 --- a/modules/data.atmosphere/inst/ERA5/ERA5_db_register.R +++ b/modules/data.atmosphere/inst/ERA5/ERA5_db_register.R @@ -19,4 +19,4 @@ added<-PEcAn.DB::dbfile.input.insert( con, hostname = PEcAn.remote::fqdn(), allow.conflicting.dates = FALSE -) \ No newline at end of file +) diff --git a/modules/data.atmosphere/inst/registration/register.ICOS.xml b/modules/data.atmosphere/inst/registration/register.ICOS.xml new file mode 100644 index 00000000000..2243512fa20 --- /dev/null +++ b/modules/data.atmosphere/inst/registration/register.ICOS.xml @@ -0,0 +1,10 @@ + + + site + + 1000000136 + ICOS_ECOSYSTEM_HH + text/csv + csv + + diff --git a/modules/data.atmosphere/inst/registration/register.MERRA.xml b/modules/data.atmosphere/inst/registration/register.MERRA.xml new file mode 100644 index 00000000000..d5d5638dd64 --- /dev/null +++ b/modules/data.atmosphere/inst/registration/register.MERRA.xml @@ -0,0 +1,10 @@ + + +regional + + 33 + CF Meteorology + application/x-netcdf + nc + + diff --git a/modules/data.atmosphere/inst/registration/register.NOAA_GEFS.xml b/modules/data.atmosphere/inst/registration/register.NOAA_GEFS.xml index a6eccef2ec0..e0123157390 100644 --- a/modules/data.atmosphere/inst/registration/register.NOAA_GEFS.xml +++ b/modules/data.atmosphere/inst/registration/register.NOAA_GEFS.xml @@ -1,7 +1,7 @@ site - 21 + 31 TRUE 33 diff --git a/modules/data.atmosphere/man/align.met.Rd b/modules/data.atmosphere/man/align.met.Rd index cd12add545e..7620095fccc 100644 --- a/modules/data.atmosphere/man/align.met.Rd +++ b/modules/data.atmosphere/man/align.met.Rd @@ -4,9 +4,17 @@ \alias{align.met} \title{align.met} \usage{ -align.met(train.path, source.path, yrs.train = NULL, yrs.source = NULL, - n.ens = NULL, pair.mems = FALSE, mems.train = NULL, - seed = Sys.Date(), print.progress = FALSE) +align.met( + train.path, + source.path, + yrs.train = NULL, + yrs.source = NULL, + n.ens = NULL, + pair.mems = FALSE, + mems.train = NULL, + seed = Sys.Date(), + print.progress = FALSE +) } \arguments{ \item{train.path}{- path to the dataset to be used to downscale the data} @@ -70,7 +78,8 @@ Align meteorology datasets for debiasing an ensemnle member ID that might be used if you are specifying mems.train. } \seealso{ -Other debias - Debias & Align Meteorology Datasets into continuous time series: \code{\link{debias.met.regression}} +Other debias - Debias & Align Meteorology Datasets into continuous time series: +\code{\link{debias.met.regression}()} } \author{ Christy Rollinson diff --git a/modules/data.atmosphere/man/browndog.met.Rd b/modules/data.atmosphere/man/browndog.met.Rd index b28559ee7b2..16f5b224972 100644 --- a/modules/data.atmosphere/man/browndog.met.Rd +++ b/modules/data.atmosphere/man/browndog.met.Rd @@ -2,29 +2,38 @@ % Please edit documentation in R/met.process.R \name{browndog.met} \alias{browndog.met} -\title{get met data from browndog} +\title{Use browndog to get the met data for a specific model} \usage{ -browndog.met(browndog, source, site, start_date, end_date, model, dir, - username, con) +browndog.met( + browndog, + source, + site, + start_date, + end_date, + model, + dir, + username, + con +) } \arguments{ -\item{browndog, }{list with url, username and password to connect to browndog} +\item{browndog}{list with url, username and password to connect to browndog} -\item{source, }{the source of the met data, currently only NARR an Ameriflux is supported} +\item{source}{the source of the met data, currently only NARR an Ameriflux is supported} -\item{site, }{site information should have id, lat, lon and name (ameriflux id)} +\item{site}{site information should have id, lat, lon and name (ameriflux id)} -\item{start_date, }{start date for result} +\item{start_date}{start date for result} -\item{end_date, }{end date for result} +\item{end_date}{end date for result} -\item{model, }{model to convert the met data to} +\item{model}{model to convert the met data to} -\item{dir, }{folder where results are stored (in subfolder)} +\item{dir}{folder where results are stored (in subfolder)} -\item{username, }{used when downloading data from Ameriflux like sites} +\item{username}{used when downloading data from Ameriflux like sites} -\item{con, }{database connection} +\item{con}{database connection} } \description{ Use browndog to get the met data for a specific model diff --git a/modules/data.atmosphere/man/build_cf_variables_table_url.Rd b/modules/data.atmosphere/man/build_cf_variables_table_url.Rd index 035de41a3c6..39be280fe05 100644 --- a/modules/data.atmosphere/man/build_cf_variables_table_url.Rd +++ b/modules/data.atmosphere/man/build_cf_variables_table_url.Rd @@ -4,8 +4,11 @@ \alias{build_cf_variables_table_url} \title{Construct a URL to a specific version of the CF variables table XML} \usage{ -build_cf_variables_table_url(version, - url_format_string = "http://cfconventions.org/Data/cf-standard-names/\%d/src/src-cf-standard-name-table.xml") +build_cf_variables_table_url( + version, + url_format_string = paste0("http://cfconventions.org/", + "Data/cf-standard-names/\%d/src/", "src-cf-standard-name-table.xml") +) } \arguments{ \item{version}{CF variables table version number (integer/numeric)} diff --git a/modules/data.atmosphere/man/check_met_input_file.Rd b/modules/data.atmosphere/man/check_met_input_file.Rd index fa8ff6b6a3c..dce4db0c1d0 100644 --- a/modules/data.atmosphere/man/check_met_input_file.Rd +++ b/modules/data.atmosphere/man/check_met_input_file.Rd @@ -4,9 +4,13 @@ \alias{check_met_input_file} \title{Check a meteorology data file for compliance with the PEcAn standard} \usage{ -check_met_input_file(metfile, variable_table = pecan_standard_met_table, - required_vars = variable_table \%>\% dplyr::filter(is_required) \%>\% - dplyr::pull(cf_standard_name), warn_unknown = TRUE) +check_met_input_file( + metfile, + variable_table = pecan_standard_met_table, + required_vars = variable_table \%>\% dplyr::filter(.data$is_required) \%>\% + dplyr::pull(.data$cf_standard_name), + warn_unknown = TRUE +) } \arguments{ \item{metfile}{Path of met file to check, as a scalar character.} diff --git a/modules/data.atmosphere/man/col2ncvar.Rd b/modules/data.atmosphere/man/col2ncvar.Rd index ec2738697cf..481bc75acf6 100644 --- a/modules/data.atmosphere/man/col2ncvar.Rd +++ b/modules/data.atmosphere/man/col2ncvar.Rd @@ -9,7 +9,7 @@ col2ncvar(variable, dims) \arguments{ \item{variable}{CF variable name} -\item{dims}{List of NetCDF dimension objects (passed to +\item{dims}{List of NetCDF dimension objects (passed to `ncdf4::ncvar_def(..., dim)`)} } \value{ diff --git a/modules/data.atmosphere/man/db.site.lat.lon.Rd b/modules/data.atmosphere/man/db.site.lat.lon.Rd index 46aa66c45fd..9a2cfed78f9 100644 --- a/modules/data.atmosphere/man/db.site.lat.lon.Rd +++ b/modules/data.atmosphere/man/db.site.lat.lon.Rd @@ -2,12 +2,17 @@ % Please edit documentation in R/met.process.R \name{db.site.lat.lon} \alias{db.site.lat.lon} -\title{db.site.lat.lon} +\title{Look up lat/lon from siteid} \usage{ db.site.lat.lon(site.id, con) } +\arguments{ +\item{site.id}{BeTY ID of site to look up} + +\item{con}{database connection} +} \description{ -db.site.lat.lon +Look up lat/lon from siteid } \author{ Betsy Cowdery diff --git a/modules/data.atmosphere/man/debias.met.regression.Rd b/modules/data.atmosphere/man/debias.met.regression.Rd index 2d1d43b2eaa..ab18a97cbcd 100644 --- a/modules/data.atmosphere/man/debias.met.regression.Rd +++ b/modules/data.atmosphere/man/debias.met.regression.Rd @@ -4,13 +4,33 @@ \alias{debias.met.regression} \title{debias.met.regression} \usage{ -debias.met.regression(train.data, source.data, n.ens, vars.debias = NULL, - CRUNCEP = FALSE, pair.anoms = TRUE, pair.ens = FALSE, - uncert.prop = "mean", resids = FALSE, seed = Sys.Date(), outfolder, - yrs.save = NULL, ens.name, ens.mems = NULL, force.sanity = TRUE, - sanity.tries = 25, lat.in, lon.in, save.diagnostics = TRUE, - path.diagnostics = NULL, parallel = FALSE, n.cores = NULL, - overwrite = TRUE, verbose = FALSE) +debias.met.regression( + train.data, + source.data, + n.ens, + vars.debias = NULL, + CRUNCEP = FALSE, + pair.anoms = TRUE, + pair.ens = FALSE, + uncert.prop = "mean", + resids = FALSE, + seed = Sys.Date(), + outfolder, + yrs.save = NULL, + ens.name, + ens.mems = NULL, + force.sanity = TRUE, + sanity.tries = 25, + sanity.sd = 8, + lat.in, + lon.in, + save.diagnostics = TRUE, + path.diagnostics = NULL, + parallel = FALSE, + n.cores = NULL, + overwrite = TRUE, + verbose = FALSE +) } \arguments{ \item{train.data}{- training data coming out of align.met} @@ -21,15 +41,15 @@ debias.met.regression(train.data, source.data, n.ens, vars.debias = NULL, \item{vars.debias}{- which met variables should be debiased? if NULL, all variables in train.data} -\item{CRUNCEP}{- flag for if the dataset being downscaled is CRUNCEP; if TRUE, special cases triggered for +\item{CRUNCEP}{- flag for if the dataset being downscaled is CRUNCEP; if TRUE, special cases triggered for met variables that have been naively gapfilled for certain time periods} \item{pair.anoms}{- logical stating whether anomalies from the same year should be matched or not} -\item{pair.ens}{- logical stating whether ensembles from train and source data need to be paired together +\item{pair.ens}{- logical stating whether ensembles from train and source data need to be paired together (for uncertainty propogation)} -\item{uncert.prop}{- method for error propogation if only 1 ensemble member; options=c(random, mean); *Not Implemented yet} +\item{uncert.prop}{- method for error propogation for child ensemble members 1 ensemble member; options=c(random, mean); randomly strongly encouraged if n.ens>1} \item{resids}{- logical stating whether to pass on residual data or not *Not implemented yet} @@ -41,13 +61,15 @@ met variables that have been naively gapfilled for certain time periods} \item{ens.name}{- what is the name that should be attached to the debiased ensemble} -\item{ens.mems}{- what labels/numbers to attach to the ensemble members so we can gradually build bigger ensembles +\item{ens.mems}{- what labels/numbers to attach to the ensemble members so we can gradually build bigger ensembles without having to do do giant runs at once; if NULL will be numbered 1:n.ens} \item{force.sanity}{- (logical) do we force the data to meet sanity checks?} \item{sanity.tries}{- how many time should we try to predict a reasonable value before giving up? We don't want to end up in an infinite loop} +\item{sanity.sd}{- how many standard deviations from the mean should be used to determine sane outliers (default 8)} + \item{lat.in}{- latitude of site} \item{lon.in}{- longitude of site} @@ -66,8 +88,8 @@ without having to do do giant runs at once; if NULL will be numbered 1:n.ens} functions print debugging information as they run?} } \description{ -This script debiases one dataset (e.g. GCM, re-analysis product) given another higher - resolution product or empirical observations. It assumes input are in annual CF standard +This script debiases one dataset (e.g. GCM, re-analysis product) given another higher + resolution product or empirical observations. It assumes input are in annual CF standard files that are generate from the pecan extract or download funcitons. } \details{ @@ -75,7 +97,8 @@ Debias Meteorology using Multiple Linear Regression Statistically debias met datasets and generate ensembles based on the observed uncertainty } \seealso{ -Other debias - Debias & Align Meteorology Datasets into continuous time series: \code{\link{align.met}} +Other debias - Debias & Align Meteorology Datasets into continuous time series: +\code{\link{align.met}()} } \author{ Christy Rollinson diff --git a/modules/data.atmosphere/man/debias_met.Rd b/modules/data.atmosphere/man/debias_met.Rd index 5a55c51eb74..289f48ae67d 100644 --- a/modules/data.atmosphere/man/debias_met.Rd +++ b/modules/data.atmosphere/man/debias_met.Rd @@ -5,19 +5,33 @@ \alias{debias.met} \title{debias_met} \usage{ -debias.met(outfolder, input_met, train_met, site_id, - de_method = "linear", overwrite = FALSE, verbose = FALSE, ...) +debias.met( + outfolder, + input_met, + train_met, + site_id, + de_method = "linear", + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ +\item{outfolder}{location where output is stored} + \item{input_met}{- the source_met dataset that will be altered by the training dataset in NC format.} \item{train_met}{- the observed dataset that will be used to train the modeled dataset in NC format} +\item{site_id}{BETY site id} + \item{de_method}{- select which debias method you would like to use, options are 'normal', 'linear regression'} \item{overwrite}{logical: replace output file if it already exists? Currently ignored.} -\item{verbose}{logical: should \code{\link[ncdf4:ncdf4-package]{ncdf4}} +\item{verbose}{logical: should \code{\link[ncdf4:ncdf4-package]{ncdf4}}} + +\item{...}{other inputs functions print debugging information as they run?} } \description{ diff --git a/modules/data.atmosphere/man/download.Ameriflux.Rd b/modules/data.atmosphere/man/download.Ameriflux.Rd index 8c9505436c8..4bb914bcaf1 100644 --- a/modules/data.atmosphere/man/download.Ameriflux.Rd +++ b/modules/data.atmosphere/man/download.Ameriflux.Rd @@ -4,8 +4,15 @@ \alias{download.Ameriflux} \title{download.Ameriflux} \usage{ -download.Ameriflux(sitename, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +download.Ameriflux( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{sitename}{the FLUXNET ID of the site to be downloaded, used as file name prefix. diff --git a/modules/data.atmosphere/man/download.AmerifluxLBL.Rd b/modules/data.atmosphere/man/download.AmerifluxLBL.Rd index 95156f4dbb5..a6d4494e6fa 100644 --- a/modules/data.atmosphere/man/download.AmerifluxLBL.Rd +++ b/modules/data.atmosphere/man/download.AmerifluxLBL.Rd @@ -4,9 +4,17 @@ \alias{download.AmerifluxLBL} \title{Download Ameriflux LBL CSV files} \usage{ -download.AmerifluxLBL(sitename, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, username = "pecan", method, - ...) +download.AmerifluxLBL( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + username = "pecan", + method, + ... +) } \arguments{ \item{sitename}{the Ameriflux ID of the site to be downloaded, used as file name prefix. diff --git a/modules/data.atmosphere/man/download.CRUNCEP.Rd b/modules/data.atmosphere/man/download.CRUNCEP.Rd index 1bdcc6cca3d..c941fba8026 100644 --- a/modules/data.atmosphere/man/download.CRUNCEP.Rd +++ b/modules/data.atmosphere/man/download.CRUNCEP.Rd @@ -4,9 +4,19 @@ \alias{download.CRUNCEP} \title{Download CRUNCEP data} \usage{ -download.CRUNCEP(outfolder, start_date, end_date, site_id, lat.in, lon.in, - overwrite = FALSE, verbose = FALSE, maxErrors = 10, sleep = 2, - method = "opendap", ...) +download.CRUNCEP( + outfolder, + start_date, + end_date, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + maxErrors = 10, + sleep = 2, + method = "ncss", + ... +) } \arguments{ \item{outfolder}{Directory where results should be written} @@ -14,8 +24,6 @@ download.CRUNCEP(outfolder, start_date, end_date, site_id, lat.in, lon.in, \item{start_date, end_date}{Range of years to retrieve. Format is YYYY-MM-DD, but only the year portion is used and the resulting files always contain a full year of data.} -\item{site_id}{numeric. Currently ignored} - \item{lat.in}{site latitude in decimal degrees} \item{lon.in}{site longitude in decimal degrees} diff --git a/modules/data.atmosphere/man/download.ERA5.old.Rd b/modules/data.atmosphere/man/download.ERA5.old.Rd index c1390a43fa0..d065a061cec 100644 --- a/modules/data.atmosphere/man/download.ERA5.old.Rd +++ b/modules/data.atmosphere/man/download.ERA5.old.Rd @@ -4,9 +4,17 @@ \alias{download.ERA5.old} \title{Download ERA 5 data} \usage{ -download.ERA5.old(outfolder, start_date, end_date, lat.in, lon.in, - product_types = "all", overwrite = FALSE, reticulate_python = NULL, - ...) +download.ERA5.old( + outfolder, + start_date, + end_date, + lat.in, + lon.in, + product_types = "all", + overwrite = FALSE, + reticulate_python = NULL, + ... +) } \arguments{ \item{outfolder}{Directory where results should be written} diff --git a/modules/data.atmosphere/man/download.FACE.Rd b/modules/data.atmosphere/man/download.FACE.Rd index 95314e14b58..2c6b6d583e4 100644 --- a/modules/data.atmosphere/man/download.FACE.Rd +++ b/modules/data.atmosphere/man/download.FACE.Rd @@ -4,12 +4,31 @@ \alias{download.FACE} \title{download.FACE} \usage{ -download.FACE(sitename, outfolder, start_date, end_date, - overwrite = FALSE, method, ...) +download.FACE( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + method, + ... +) } \arguments{ +\item{sitename}{sitename} + +\item{outfolder}{location where output is stored} + +\item{start_date}{desired start date YYYY-MM-DD} + +\item{end_date}{desired end date YYYY-MM-DD} + +\item{overwrite}{overwrite existing files? Default is FALSE} + \item{method}{Optional. Passed to download.file() function. Use this to set custom programs such as ncftp to use when downloading files from FTP sites} + +\item{...}{other inputs} } \description{ Download Raw FACE data from the internet diff --git a/modules/data.atmosphere/man/download.Fluxnet2015.Rd b/modules/data.atmosphere/man/download.Fluxnet2015.Rd index 6a3e73897c3..3b249de1c7b 100644 --- a/modules/data.atmosphere/man/download.Fluxnet2015.Rd +++ b/modules/data.atmosphere/man/download.Fluxnet2015.Rd @@ -4,8 +4,16 @@ \alias{download.Fluxnet2015} \title{download.Fluxnet2015} \usage{ -download.Fluxnet2015(sitename, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, username = "pecan", ...) +download.Fluxnet2015( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + username = "pecan", + ... +) } \arguments{ \item{sitename}{the FLUXNET ID of the site to be downloaded, used as file name prefix. diff --git a/modules/data.atmosphere/man/download.FluxnetLaThuile.Rd b/modules/data.atmosphere/man/download.FluxnetLaThuile.Rd index bca47562646..d403f5ea0a2 100644 --- a/modules/data.atmosphere/man/download.FluxnetLaThuile.Rd +++ b/modules/data.atmosphere/man/download.FluxnetLaThuile.Rd @@ -4,8 +4,16 @@ \alias{download.FluxnetLaThuile} \title{download.FluxnetLaThuile} \usage{ -download.FluxnetLaThuile(sitename, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, username = "pecan", ...) +download.FluxnetLaThuile( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + username = "pecan", + ... +) } \arguments{ \item{sitename}{the FLUXNET ID of the site to be downloaded, used as file name prefix. diff --git a/modules/data.atmosphere/man/download.GFDL.Rd b/modules/data.atmosphere/man/download.GFDL.Rd index 1571b8cce64..c1e5368e525 100644 --- a/modules/data.atmosphere/man/download.GFDL.Rd +++ b/modules/data.atmosphere/man/download.GFDL.Rd @@ -4,9 +4,19 @@ \alias{download.GFDL} \title{Download GFDL CMIP5 outputs for a single grid point using OPeNDAP and convert to CF} \usage{ -download.GFDL(outfolder, start_date, end_date, lat.in, lon.in, - overwrite = FALSE, verbose = FALSE, model = "CM3", - scenario = "rcp45", ensemble_member = "r1i1p1", ...) +download.GFDL( + outfolder, + start_date, + end_date, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + model = "CM3", + scenario = "rcp45", + ensemble_member = "r1i1p1", + ... +) } \arguments{ \item{outfolder}{Directory for storing output} diff --git a/modules/data.atmosphere/man/download.GLDAS.Rd b/modules/data.atmosphere/man/download.GLDAS.Rd index 243ed301215..e33ff56b2a1 100644 --- a/modules/data.atmosphere/man/download.GLDAS.Rd +++ b/modules/data.atmosphere/man/download.GLDAS.Rd @@ -4,11 +4,36 @@ \alias{download.GLDAS} \title{Download GLDAS data} \usage{ -download.GLDAS(outfolder, start_date, end_date, site_id, lat.in, lon.in, - overwrite = FALSE, verbose = FALSE, ...) +download.GLDAS( + outfolder, + start_date, + end_date, + site_id, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ -\item{lon.in}{} +\item{outfolder}{location where output is stored} + +\item{start_date}{desired start date} + +\item{end_date}{desired end date} + +\item{site_id}{desired site id} + +\item{lat.in}{latitude of site} + +\item{lon.in}{longistude of site} + +\item{overwrite}{overwrite existing files? Default is FALSE} + +\item{verbose}{Default is FALSE, used as input for ncdf4::ncvar_def} + +\item{...}{other inputs} } \description{ Download and convert single grid point GLDAS to CF single grid point from hydro1.sci.gsfc.nasa.gov using OPENDAP interface diff --git a/modules/data.atmosphere/man/download.Geostreams.Rd b/modules/data.atmosphere/man/download.Geostreams.Rd index a8abd76a302..26c839e2528 100644 --- a/modules/data.atmosphere/man/download.Geostreams.Rd +++ b/modules/data.atmosphere/man/download.Geostreams.Rd @@ -4,9 +4,17 @@ \alias{download.Geostreams} \title{Download Geostreams data from Clowder API} \usage{ -download.Geostreams(outfolder, sitename, start_date, end_date, +download.Geostreams( + outfolder, + sitename, + start_date, + end_date, url = "https://terraref.ncsa.illinois.edu/clowder/api/geostreams", - key = NULL, user = NULL, pass = NULL, ...) + key = NULL, + user = NULL, + pass = NULL, + ... +) } \arguments{ \item{outfolder}{directory in which to save json result. Will be created if necessary} diff --git a/modules/data.atmosphere/man/download.ICOS.Rd b/modules/data.atmosphere/man/download.ICOS.Rd new file mode 100644 index 00000000000..09ea66b81a4 --- /dev/null +++ b/modules/data.atmosphere/man/download.ICOS.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download.ICOS.R +\name{download.ICOS} +\alias{download.ICOS} +\title{Download ICOS Ecosystem data products} +\usage{ +download.ICOS( + sitename, + outfolder, + start_date, + end_date, + product, + overwrite = FALSE, + ... +) +} +\arguments{ +\item{sitename}{ICOS id of the site. Example - "BE-Bra"} + +\item{outfolder}{path to the directory where the output file is stored. If specified directory does not exists, it is created.} + +\item{start_date}{start date of the data request in the form YYYY-MM-DD} + +\item{end_date}{end date area of the data request in the form YYYY-MM-DD} + +\item{product}{ICOS product to be downloaded. Currently supported options: "Drought2018", "ETC"} + +\item{overwrite}{should existing files be overwritten. Default False.} + +\item{...}{used when extra arguments are present.} +} +\value{ +information about the output file +} +\description{ +Currently available products: +Drought-2018 ecosystem eddy covariance flux product https://www.icos-cp.eu/data-products/YVR0-4898 +ICOS Final Fully Quality Controlled Observational Data (Level 2) https://www.icos-cp.eu/data-products/ecosystem-release +} +\examples{ +\dontrun{ +download.ICOS("FI-Sii", "/home/carya/pecan", "2016-01-01", "2018-01-01", product="Drought2018") +} +} +\author{ +Ayush Prasad +} diff --git a/modules/data.atmosphere/man/download.MACA.Rd b/modules/data.atmosphere/man/download.MACA.Rd index af79da3e75e..3dfb425267f 100644 --- a/modules/data.atmosphere/man/download.MACA.Rd +++ b/modules/data.atmosphere/man/download.MACA.Rd @@ -4,21 +4,45 @@ \alias{download.MACA} \title{download.MACA} \usage{ -download.MACA(outfolder, start_date, end_date, site_id, lat.in, lon.in, - model = "IPSL-CM5A-LR", scenario = "rcp85", - ensemble_member = "r1i1p1", overwrite = FALSE, verbose = FALSE, - ...) +download.MACA( + outfolder, + start_date, + end_date, + site_id, + lat.in, + lon.in, + model = "IPSL-CM5A-LR", + scenario = "rcp85", + ensemble_member = "r1i1p1", + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ +\item{outfolder}{location where output is stored} + \item{start_date}{, of the format "YEAR-01-01 00:00:00"} \item{end_date}{, of the format "YEAR-12-31 23:59:59"} +\item{site_id}{BETY site id} + +\item{lat.in}{latitude of site} + +\item{lon.in}{longitude of site} + \item{model}{, select which MACA model to run (options are BNU-ESM, CNRM-CM5, CSIRO-Mk3-6-0, bcc-csm1-1, bcc-csm1-1-m, CanESM2, GFDL-ESM2M, GFDL-ESM2G, HadGEM2-CC365, HadGEM2-ES365, inmcm4, MIROC5, MIROC-ESM, MIROC-ESM-CHEM, MRI-CGCM3, CCSM4, IPSL-CM5A-LR, IPSL-CM5A-MR, IPSL-CM5B-LR, NorESM1-M)} \item{scenario}{, select which scenario to run (options are rcp45, rcp85)} \item{ensemble_member}{, r1i1p1 is the only ensemble member available for this dataset, CCSM4 uses r6i1p1 instead} + +\item{overwrite}{overwrite existing files? Default is FALSE} + +\item{verbose}{Default is FALSE, used as input in ncdf4::ncvar_def} + +\item{...}{other inputs} } \description{ Download MACA CMIP5 outputs for a single grid point using OPeNDAP and convert to CF diff --git a/modules/data.atmosphere/man/download.MERRA.Rd b/modules/data.atmosphere/man/download.MERRA.Rd new file mode 100644 index 00000000000..9f550ce0d6e --- /dev/null +++ b/modules/data.atmosphere/man/download.MERRA.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download.MERRA.R +\name{download.MERRA} +\alias{download.MERRA} +\title{Download MERRA data} +\usage{ +download.MERRA( + outfolder, + start_date, + end_date, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + ... +) +} +\arguments{ +\item{outfolder}{Directory where results should be written} + +\item{start_date}{Range of years to retrieve. Format is YYYY-MM-DD, +but only the year portion is used and the resulting files always contain a full year of data.} + +\item{end_date}{Range of years to retrieve. Format is YYYY-MM-DD, +but only the year portion is used and the resulting files always contain a full year of data.} + +\item{lat.in}{site latitude in decimal degrees} + +\item{lon.in}{site longitude in decimal degrees} + +\item{overwrite}{logical. Download a fresh version even if a local file with the same name already exists?} + +\item{verbose}{logical. Passed on to \code{\link[ncdf4]{ncvar_def}} and \code{\link[ncdf4]{nc_create}} +to control printing of debug info} + +\item{...}{Not used -- silently soak up extra arguments from `convert.input`, etc.} +} +\value{ +`data.frame` of meteorology data metadata +} +\description{ +Download MERRA data +} +\author{ +Alexey Shiklomanov +} diff --git a/modules/data.atmosphere/man/download.MsTMIP_NARR.Rd b/modules/data.atmosphere/man/download.MsTMIP_NARR.Rd index a8362e01340..03867540801 100644 --- a/modules/data.atmosphere/man/download.MsTMIP_NARR.Rd +++ b/modules/data.atmosphere/man/download.MsTMIP_NARR.Rd @@ -4,17 +4,36 @@ \alias{download.MsTMIP_NARR} \title{download.MsTMIP_NARR} \usage{ -download.MsTMIP_NARR(outfolder, start_date, end_date, site_id, lat.in, - lon.in, overwrite = FALSE, verbose = FALSE, ...) +download.MsTMIP_NARR( + outfolder, + start_date, + end_date, + site_id, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ +\item{outfolder}{location where output is stored} + \item{start_date}{YYYY-MM-DD} \item{end_date}{YYYY-MM-DD} -\item{lat}{decimal degrees [-90, 90]} +\item{site_id}{BETY site id} + +\item{lat.in}{latitude of site} + +\item{lon.in}{longitude of site} + +\item{overwrite}{overwrite existing files? Default is FALSE} + +\item{verbose}{Default is FALSE, used in ncdf4::ncvar_def} -\item{lon}{decimal degrees [-180, 180]} +\item{...}{Other inputs} } \description{ Download and conver to CF NARR single grid point from MSTIMIP server using OPENDAP interface diff --git a/modules/data.atmosphere/man/download.NARR.Rd b/modules/data.atmosphere/man/download.NARR.Rd index b6394a8330a..baa71aec13f 100644 --- a/modules/data.atmosphere/man/download.NARR.Rd +++ b/modules/data.atmosphere/man/download.NARR.Rd @@ -4,15 +4,30 @@ \alias{download.NARR} \title{Download NARR files} \usage{ -download.NARR(outfolder, start_date, end_date, overwrite = FALSE, - verbose = FALSE, method, ...) +download.NARR( + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + method, + ... +) } \arguments{ +\item{outfolder}{location where output is stored} + +\item{start_date}{desired start date YYYY-MM-DD} + +\item{end_date}{desired end date YYYY-MM-DD} + \item{overwrite}{Overwrite existing files? Default=FALSE} \item{verbose}{Turn on verbose output? Default=FALSE} -\item{method}{Method of file retrieval. Can set this using the options(download.ftp.method=[method]) in your Rprofile. +\item{method}{Method of file retrieval. Can set this using the options(download.ftp.method=[method]) in your Rprofile.} + +\item{...}{other inputs example options(download.ftp.method="ncftpget")} } \description{ diff --git a/modules/data.atmosphere/man/download.NARR_site.Rd b/modules/data.atmosphere/man/download.NARR_site.Rd index 3c158c4191e..d310c6a2060 100644 --- a/modules/data.atmosphere/man/download.NARR_site.Rd +++ b/modules/data.atmosphere/man/download.NARR_site.Rd @@ -4,10 +4,19 @@ \alias{download.NARR_site} \title{Download NARR time series for a single site} \usage{ -download.NARR_site(outfolder, start_date, end_date, lat.in, lon.in, - overwrite = FALSE, verbose = FALSE, progress = TRUE, - parallel = TRUE, ncores = if (parallel) parallel::detectCores() else - NULL, ...) +download.NARR_site( + outfolder, + start_date, + end_date, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + progress = TRUE, + parallel = TRUE, + ncores = if (parallel) parallel::detectCores() else NULL, + ... +) } \arguments{ \item{outfolder}{Target directory for storing output} @@ -26,7 +35,7 @@ download.NARR_site(outfolder, start_date, end_date, lat.in, lon.in, \item{parallel}{Download in parallel? Default = TRUE} -\item{ncores}{Number of cores for parallel download. Default is +\item{ncores}{Number of cores for parallel download. Default is `parallel::detectCores()`} } \description{ diff --git a/modules/data.atmosphere/man/download.NEONmet.Rd b/modules/data.atmosphere/man/download.NEONmet.Rd index 743dfe563cc..7f6d63d153d 100644 --- a/modules/data.atmosphere/man/download.NEONmet.Rd +++ b/modules/data.atmosphere/man/download.NEONmet.Rd @@ -4,8 +4,15 @@ \alias{download.NEONmet} \title{Download NEON Site Met CSV files} \usage{ -download.NEONmet(sitename, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +download.NEONmet( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{sitename}{the NEON ID of the site to be downloaded, used as file name prefix. diff --git a/modules/data.atmosphere/man/download.NLDAS.Rd b/modules/data.atmosphere/man/download.NLDAS.Rd index 2a386ef3a8c..80684fdcad1 100644 --- a/modules/data.atmosphere/man/download.NLDAS.Rd +++ b/modules/data.atmosphere/man/download.NLDAS.Rd @@ -4,8 +4,36 @@ \alias{download.NLDAS} \title{Download NLDAS met data} \usage{ -download.NLDAS(outfolder, start_date, end_date, site_id, lat.in, lon.in, - overwrite = FALSE, verbose = FALSE, ...) +download.NLDAS( + outfolder, + start_date, + end_date, + site_id, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + ... +) +} +\arguments{ +\item{outfolder}{location of output} + +\item{start_date}{desired start date YYYY-MM-DD} + +\item{end_date}{desired end date YYYY-MM-DD} + +\item{site_id}{site id (BETY)} + +\item{lat.in}{latitude of site} + +\item{lon.in}{longitude of site} + +\item{overwrite}{overwrite existing files? Default is FALSE} + +\item{verbose}{Turn on verbose output? Default=FALSE} + +\item{...}{Other inputs} } \description{ Download and convert single grid point NLDAS to CF single grid point from hydro1.sci.gsfc.nasa.gov using OPENDAP interface diff --git a/modules/data.atmosphere/man/download.NOAA_GEFS.Rd b/modules/data.atmosphere/man/download.NOAA_GEFS.Rd index 31c2f861778..b5c6fe86266 100644 --- a/modules/data.atmosphere/man/download.NOAA_GEFS.Rd +++ b/modules/data.atmosphere/man/download.NOAA_GEFS.Rd @@ -4,27 +4,42 @@ \alias{download.NOAA_GEFS} \title{Download NOAA GEFS Weather Data} \usage{ -download.NOAA_GEFS(outfolder, lat.in, lon.in, sitename, - start_date = Sys.time(), end_date = (as.POSIXct(start_date, tz = - "UTC") + lubridate::days(16)), overwrite = FALSE, verbose = FALSE, - ...) +download.NOAA_GEFS( + site_id, + sitename = NULL, + username = "pecan", + lat.in, + lon.in, + outfolder, + start_date = Sys.Date(), + end_date = start_date + lubridate::days(16), + downscale = TRUE, + overwrite = FALSE, + ... +) } \arguments{ -\item{outfolder}{Directory where results should be written} +\item{site_id}{The unique ID given to each site. This is used as part of the file name.} -\item{sitename}{The unique ID given to each site. This is used as part of the file name.} +\item{sitename}{Site name} -\item{start_date, }{end_date Range of dates/times to be downloaded (default assumed time of day is 0:00, midnight)} +\item{username}{username from pecan workflow} -\item{overwrite}{logical. Download a fresh version even if a local file with the same name already exists?} +\item{lat.in}{site latitude in decimal degrees} -\item{verbose}{logical. Print additional debug information. Passed on to functions in the netcdf4 package to provide debugging info.} +\item{lon.in}{site longitude in decimal degrees} + +\item{outfolder}{Directory where results should be written} -\item{...}{Other arguments, currently ignored} +\item{start_date, }{Range of dates/times to be downloaded (default assumed to be time that function is run)} -\item{lat}{site latitude in decimal degrees} +\item{end_date, }{end date for range of dates to be downloaded (default 16 days from start_date)} + +\item{downscale}{logical, assumed True. Indicated whether data should be downscaled to hourly} + +\item{overwrite}{logical. Download a fresh version even if a local file with the same name already exists?} -\item{lon}{site longitude in decimal degrees} +\item{...}{Additional optional parameters} } \value{ A list of data frames is returned containing information about the data file that can be used to locate it later. Each @@ -35,14 +50,15 @@ Download NOAA GEFS Weather Data } \section{Information on Units}{ -Information on NOAA weather units can be found below. Note that the temperature is measured in degrees C, but is converted at the station and downlaoded -in Kelvin. +Information on NOAA weather units can be found below. Note that the temperature is measured in degrees C, +but is converted at the station and downlaoded in Kelvin. } \section{NOAA_GEFS General Information}{ -This function downloads NOAA GEFS weather data. GEFS is an ensemble of 21 different weather forecast models. A 16 day forecast is avaliable -every 6 hours. Each forecast includes information on a total of 8 variables. These are transformed from the NOAA standard to the internal PEcAn +This function downloads NOAA GEFS weather data. GEFS is an ensemble of 21 different weather forecast models. +A 16 day forecast is avaliable every 6 hours. Each forecast includes information on a total of 8 variables. +These are transformed from the NOAA standard to the internal PEcAn standard. } @@ -63,7 +79,10 @@ June 6th, 2018 at 6:00 a.m. to June 24th, 2018 at 6:00 a.m. \examples{ \dontrun{ - download.NOAA_GEFS(outfolder="~/Working/results", lat.in= 45.805925, lon.in = -90.07961, sitename="US-WCr") + download.NOAA_GEFS(outfolder="~/Working/results", + lat.in= 45.805925, + lon.in = -90.07961, + site_id = 676) } } @@ -71,5 +90,5 @@ June 6th, 2018 at 6:00 a.m. to June 24th, 2018 at 6:00 a.m. https://www.ncdc.noaa.gov/crn/measurements.html } \author{ -Luke Dramko +Quinn Thomas, modified by K Zarada } diff --git a/modules/data.atmosphere/man/download.NOAA_GEFS_downscale.Rd b/modules/data.atmosphere/man/download.NOAA_GEFS_downscale.Rd deleted file mode 100644 index 31bf08c0b7e..00000000000 --- a/modules/data.atmosphere/man/download.NOAA_GEFS_downscale.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/download.NOAA_GEFS_downscale.R -\name{download.NOAA_GEFS_downscale} -\alias{download.NOAA_GEFS_downscale} -\title{Downscale NOAA GEFS Weather Data} -\usage{ -download.NOAA_GEFS_downscale(outfolder, lat.in, lon.in, sitename, - start_date = Sys.time(), end_date = (as.POSIXct(start_date, tz = - "UTC") + lubridate::days(16)), overwrite = FALSE, verbose = FALSE, - ...) -} -\arguments{ -\item{outfolder}{Directory where results should be written} - -\item{sitename}{The unique ID given to each site. This is used as part of the file name.} - -\item{start_date, }{end_date Range of dates/times to be downloaded (default assumed time of day is 0:00, midnight)} - -\item{overwrite}{logical. Download a fresh version even if a local file with the same name already exists?} - -\item{verbose}{logical. Print additional debug information. Passed on to functions in the netcdf4 package to provide debugging info.} - -\item{...}{Other arguments, currently ignored} - -\item{lat}{site latitude in decimal degrees} - -\item{lon}{site longitude in decimal degrees} -} -\value{ -A list of data frames is returned containing information about the data file that can be used to locate it later. Each -data frame contains information about one file. -} -\description{ -Downscale NOAA GEFS Weather Data -} -\section{Information on Units}{ - -Information on NOAA weather units can be found below. Note that the temperature is measured in degrees C, but is converted at the station and downlaoded -in Kelvin. -} - -\section{NOAA_GEFS General Information}{ - -This function downloads NOAA GEFS weather data. GEFS is an ensemble of 21 different weather forecast models. A 16 day forecast is avaliable -every 6 hours. Each forecast includes information on a total of 8 variables. These are transformed from the NOAA standard to the internal PEcAn -standard. -} - -\section{Data Avaliability}{ - -NOAA GEFS weather data is avaliable on a rolling 12 day basis; dates provided in "start_date" must be within this range. The end date can be any point after -that, but if the end date is beyond 16 days, only 16 days worth of forecast are recorded. Times are rounded down to the previous 6 hour forecast. NOAA -GEFS weather data isn't always posted immediately, and to compensate, this function adjusts requests made in the last two hours -back two hours (approximately the amount of time it takes to post the data) to make sure the most current forecast is used. -} - -\section{Data Save Format}{ - -Data is saved in the netcdf format to the specified directory. File names reflect the precision of the data to the given range of days. -NOAA.GEFS.willow creek.3.2018-06-08T06:00.2018-06-24T06:00.nc specifies the forecast, using ensemble nubmer 3 at willow creek on -June 6th, 2018 at 6:00 a.m. to June 24th, 2018 at 6:00 a.m. -} - -\examples{ -\dontrun{ - download.NOAA_GEFS(outfolder="~/Working/results", lat.in= 45.805925, lon.in = -90.07961, sitename="US-WCr") -} - -} -\references{ -https://www.ncdc.noaa.gov/crn/measurements.html -} -\author{ -Katie Zarada - modified code from Luke Dramko and Laura Puckett -} diff --git a/modules/data.atmosphere/man/download.PalEON.Rd b/modules/data.atmosphere/man/download.PalEON.Rd index 55e27b5cea1..969771e593d 100644 --- a/modules/data.atmosphere/man/download.PalEON.Rd +++ b/modules/data.atmosphere/man/download.PalEON.Rd @@ -4,11 +4,27 @@ \alias{download.PalEON} \title{download.PalEON} \usage{ -download.PalEON(sitename, outfolder, start_date, end_date, - overwrite = FALSE, ...) +download.PalEON( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + ... +) } \arguments{ -\item{end_date}{} +\item{sitename}{sitename} + +\item{outfolder}{desired output location} + +\item{start_date}{desired start date YYYY-MM-DD} + +\item{end_date}{desired end date YYYY-MM-DD} + +\item{overwrite}{overwrite existing files? Default is FALSE} + +\item{...}{Other inputs} } \description{ Download PalEON files diff --git a/modules/data.atmosphere/man/download.PalEON_ENS.Rd b/modules/data.atmosphere/man/download.PalEON_ENS.Rd index d268e4654a7..915a2e33aa5 100644 --- a/modules/data.atmosphere/man/download.PalEON_ENS.Rd +++ b/modules/data.atmosphere/man/download.PalEON_ENS.Rd @@ -4,11 +4,27 @@ \alias{download.PalEON_ENS} \title{Download PalEON met ensemble files} \usage{ -download.PalEON_ENS(sitename, outfolder, start_date, end_date, - overwrite = FALSE, ...) +download.PalEON_ENS( + sitename, + outfolder, + start_date, + end_date, + overwrite = FALSE, + ... +) } \arguments{ -\item{end_date}{} +\item{sitename}{sitename} + +\item{outfolder}{desired output folder} + +\item{start_date}{desired start date YYYY-MM-DD} + +\item{end_date}{desired end date YYYY-MM-DD} + +\item{overwrite}{overwrite existing files? Default is FALSE} + +\item{...}{Other inputs} } \description{ Download PalEON met ensemble files diff --git a/modules/data.atmosphere/man/download.US_Syv.Rd b/modules/data.atmosphere/man/download.US_Syv.Rd deleted file mode 100644 index 9b80b15bbd2..00000000000 --- a/modules/data.atmosphere/man/download.US_Syv.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/download.US_Syv.R -\name{download.US_Syv} -\alias{download.US_Syv} -\title{download.US-Syv} -\usage{ -download.US_Syv(start_date, end_date, timestep = 1) -} -\arguments{ -\item{start_date}{Start date/time data should be downloaded for} - -\item{end_date}{End date/time data should be downloaded for} - -\item{timestep}{How often to take data points from the file. Must be a multiple of 0.5} -} -\description{ -download.US-Syv -} -\section{General Description}{ - -Obtains data from Ankur Desai's Sylvannia flux tower, and selects certain variables (NEE and LE) to return -Data is retruned at the given timestep in the given range. - -This data includes information on a number of flux variables. - -The timestep parameter is measured in hours, but is then converted to half hours because the data's timestep -is every half hour. -} - -\author{ -Luke Dramko and K Zarada -} diff --git a/modules/data.atmosphere/man/download.raw.met.module.Rd b/modules/data.atmosphere/man/download.raw.met.module.Rd new file mode 100644 index 00000000000..6ead5a0aeb1 --- /dev/null +++ b/modules/data.atmosphere/man/download.raw.met.module.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download.raw.met.module.R +\name{download.raw.met.module} +\alias{download.raw.met.module} +\alias{.download.raw.met.module} +\title{download.raw.met.module} +\usage{ +.download.raw.met.module( + dir, + met, + register, + machine, + start_date, + end_date, + str_ns, + con, + input_met, + site.id, + lat.in, + lon.in, + host, + site, + username, + overwrite = FALSE, + dbparms, + Ens.Flag = FALSE +) +} +\arguments{ +\item{dir}{directory to write outputs to} + +\item{met}{source included in input_met} + +\item{register}{register.xml, provided by met.process} + +\item{machine}{machine associated with hostname, provided by met.process} + +\item{start_date}{the start date of the data to be downloaded (will only use the year part of the date)} + +\item{end_date}{the end date of the data to be downloaded (will only use the year part of the date)} + +\item{str_ns}{substitute for site_id if not provided, provided by met.process} + +\item{con}{database connection based on dbparms in met.process} + +\item{input_met}{Which data source to process} + +\item{site.id}{site id} + +\item{lat.in}{site latitude, provided by met.process} + +\item{lon.in}{site longitude, provided by met.process} + +\item{host}{host info from settings file} + +\item{site}{site info from settings file} + +\item{username}{database username} + +\item{overwrite}{whether to force download.raw.met.module to proceed} + +\item{dbparms}{database settings from settings file} + +\item{Ens.Flag}{default set to FALSE} +} +\value{ +A list of data frames is returned containing information about the data file that can be used to locate it later. Each +data frame contains information about one file. +} +\description{ +download.raw.met.module +} diff --git a/modules/data.atmosphere/man/downscale_ShortWave_to_half_hrly.Rd b/modules/data.atmosphere/man/downscale_ShortWave_to_half_hrly.Rd new file mode 100644 index 00000000000..55b8e6de323 --- /dev/null +++ b/modules/data.atmosphere/man/downscale_ShortWave_to_half_hrly.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/half_hour_downscale.R +\name{downscale_ShortWave_to_half_hrly} +\alias{downscale_ShortWave_to_half_hrly} +\title{Downscale shortwave to half hourly} +\usage{ +downscale_ShortWave_to_half_hrly(df, lat, lon, hr = 0.5) +} +\arguments{ +\item{df}{data frame of variables} + +\item{lat}{lat of site} + +\item{lon}{long of site} + +\item{hr}{hour to downscale to- default is 1} +} +\value{ +A dataframe of downscaled state variables + +ShortWave.ds +} +\description{ +Downscale shortwave to half hourly +} +\author{ +Laura Puckett +} diff --git a/modules/data.atmosphere/man/downscale_ShortWave_to_hrly.Rd b/modules/data.atmosphere/man/downscale_ShortWave_to_hrly.Rd index f86df0b3d35..f2da62dcd32 100644 --- a/modules/data.atmosphere/man/downscale_ShortWave_to_hrly.Rd +++ b/modules/data.atmosphere/man/downscale_ShortWave_to_hrly.Rd @@ -1,27 +1,24 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/downscale_ShortWave_to_hrly.R +% Please edit documentation in R/downscaling_helper_functions.R \name{downscale_ShortWave_to_hrly} \alias{downscale_ShortWave_to_hrly} \title{Downscale shortwave to hourly} \usage{ -downscale_ShortWave_to_hrly(debiased, time0, time_end, lat, lon, - output_tz = "UTC") +downscale_ShortWave_to_hrly(df, lat, lon, hr = 1) } \arguments{ -\item{debiased, }{data frame of variables} - -\item{time0, }{first timestep} - -\item{time_end, }{last time step} +\item{df, }{data frame of variables} \item{lat, }{lat of site} \item{lon, }{long of site} -\item{output_tz, }{output timezone} +\item{hr, }{hour to downscale to- default is 1} } \value{ A dataframe of downscaled state variables + +ShortWave.ds } \description{ Downscale shortwave to hourly diff --git a/modules/data.atmosphere/man/downscale_repeat_6hr_to_half_hrly.Rd b/modules/data.atmosphere/man/downscale_repeat_6hr_to_half_hrly.Rd new file mode 100644 index 00000000000..b391679862f --- /dev/null +++ b/modules/data.atmosphere/man/downscale_repeat_6hr_to_half_hrly.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/half_hour_downscale.R +\name{downscale_repeat_6hr_to_half_hrly} +\alias{downscale_repeat_6hr_to_half_hrly} +\title{Downscale repeat to half hourly} +\usage{ +downscale_repeat_6hr_to_half_hrly(df, varName, hr = 0.5) +} +\arguments{ +\item{df}{dataframe of data to be downscaled (Longwave)} + +\item{varName}{variable names to be downscaled} + +\item{hr}{hour to downscale to- default is 0.5} +} +\value{ +A dataframe of downscaled data +} +\description{ +Downscale repeat to half hourly +} +\author{ +Laura Puckett +} diff --git a/modules/data.atmosphere/man/downscale_repeat_6hr_to_hrly.Rd b/modules/data.atmosphere/man/downscale_repeat_6hr_to_hrly.Rd index 523d92ba4da..47b6f87dc1f 100644 --- a/modules/data.atmosphere/man/downscale_repeat_6hr_to_hrly.Rd +++ b/modules/data.atmosphere/man/downscale_repeat_6hr_to_hrly.Rd @@ -1,13 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/downscale_repeat_6hr_to_hrly.R +% Please edit documentation in R/downscaling_helper_functions.R \name{downscale_repeat_6hr_to_hrly} \alias{downscale_repeat_6hr_to_hrly} \title{Downscale repeat to hourly} \usage{ -downscale_repeat_6hr_to_hrly(data.6hr) +downscale_repeat_6hr_to_hrly(df, varName, hr = 1) } \arguments{ -\item{data.6hr, }{dataframe of data to be downscaled (Longwave)} +\item{df, }{dataframe of data to be downscaled (Longwave)} + +\item{varName, }{variable names to be downscaled} + +\item{hr, }{hour to downscale to- default is 1} } \value{ A dataframe of downscaled data diff --git a/modules/data.atmosphere/man/downscale_solar_geom.Rd b/modules/data.atmosphere/man/downscale_solar_geom.Rd new file mode 100644 index 00000000000..25a823899cc --- /dev/null +++ b/modules/data.atmosphere/man/downscale_solar_geom.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/downscaling_helper_functions.R +\name{downscale_solar_geom} +\alias{downscale_solar_geom} +\title{Calculate potential shortwave radiation} +\usage{ +downscale_solar_geom(doy, lon, lat) +} +\arguments{ +\item{doy, }{day of year in decimal} + +\item{lon, }{longitude} + +\item{lat, }{latitude} +} +\value{ +vector of potential shortwave radiation for each doy +} +\description{ +Calculate potential shortwave radiation +} +\author{ +Quinn Thomas +} diff --git a/modules/data.atmosphere/man/downscale_solar_geom_halfhour.Rd b/modules/data.atmosphere/man/downscale_solar_geom_halfhour.Rd new file mode 100644 index 00000000000..bb190f90ac3 --- /dev/null +++ b/modules/data.atmosphere/man/downscale_solar_geom_halfhour.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/half_hour_downscale.R +\name{downscale_solar_geom_halfhour} +\alias{downscale_solar_geom_halfhour} +\title{Calculate potential shortwave radiation} +\usage{ +downscale_solar_geom_halfhour(doy, lon, lat) +} +\arguments{ +\item{doy, }{day of year in decimal} + +\item{lon, }{longitude} + +\item{lat, }{latitude} +} +\value{ +vector of potential shortwave radiation for each doy +} +\description{ +Calculate potential shortwave radiation +} +\author{ +Quinn Thomas +} diff --git a/modules/data.atmosphere/man/downscale_spline_to_half_hrly.Rd b/modules/data.atmosphere/man/downscale_spline_to_half_hrly.Rd new file mode 100644 index 00000000000..f10c7ac7cbe --- /dev/null +++ b/modules/data.atmosphere/man/downscale_spline_to_half_hrly.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/half_hour_downscale.R +\name{downscale_spline_to_half_hrly} +\alias{downscale_spline_to_half_hrly} +\title{Downscale spline to half hourly} +\usage{ +downscale_spline_to_half_hrly(df, VarNames, hr = 0.5) +} +\arguments{ +\item{df}{dataframe of data to be downscales} + +\item{VarNames}{variable names to be downscaled} + +\item{hr}{hour to downscale to- default is 0.5} +} +\value{ +A dataframe of half hourly downscaled state variables +} +\description{ +Downscale spline to half hourly +} +\author{ +Laura Puckett +} diff --git a/modules/data.atmosphere/man/downscale_spline_to_hourly.Rd b/modules/data.atmosphere/man/downscale_spline_to_hourly.Rd deleted file mode 100644 index dd57682b1de..00000000000 --- a/modules/data.atmosphere/man/downscale_spline_to_hourly.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/downscale_spline_to_hourly.R -\name{downscale_spline_to_hourly} -\alias{downscale_spline_to_hourly} -\title{Downscale spline to hourly} -\usage{ -downscale_spline_to_hourly(df, VarNamesStates) -} -\arguments{ -\item{df, }{dataframe of data to be downscales} - -\item{VarNamesStates, }{names of vars that are state variables} -} -\value{ -A dataframe of downscaled state variables -} -\description{ -Downscale spline to hourly -} -\author{ -Laura Puckett -} diff --git a/modules/data.atmosphere/man/downscale_spline_to_hrly.Rd b/modules/data.atmosphere/man/downscale_spline_to_hrly.Rd new file mode 100644 index 00000000000..58bac009000 --- /dev/null +++ b/modules/data.atmosphere/man/downscale_spline_to_hrly.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/downscaling_helper_functions.R +\name{downscale_spline_to_hrly} +\alias{downscale_spline_to_hrly} +\title{Downscale spline to hourly} +\usage{ +downscale_spline_to_hrly(df, VarNames, hr = 1) +} +\arguments{ +\item{df, }{dataframe of data to be downscales} + +\item{VarNames, }{variable names to be downscaled} + +\item{hr, }{hour to downscale to- default is 1} +} +\value{ +A dataframe of downscaled state variables +} +\description{ +Downscale spline to hourly +} +\author{ +Laura Puckett +} diff --git a/modules/data.atmosphere/man/extract.local.CMIP5.Rd b/modules/data.atmosphere/man/extract.local.CMIP5.Rd index f0323cce02f..fec601e2925 100644 --- a/modules/data.atmosphere/man/extract.local.CMIP5.Rd +++ b/modules/data.atmosphere/man/extract.local.CMIP5.Rd @@ -2,12 +2,25 @@ % Please edit documentation in R/extract_local_CMIP5.R \name{extract.local.CMIP5} \alias{extract.local.CMIP5} -\title{extract.local.CMIP5} +\title{Extract NLDAS from local download +Extract NLDAS meteorology for a point from a local download of the full grid} \usage{ -extract.local.CMIP5(outfolder, in.path, start_date, end_date, site_id, - lat.in, lon.in, model, scenario, ensemble_member = "r1i1p1", - date.origin = NULL, no.leap = NULL, overwrite = FALSE, - verbose = FALSE, ...) +extract.local.CMIP5( + outfolder, + in.path, + start_date, + end_date, + lat.in, + lon.in, + model, + scenario, + ensemble_member = "r1i1p1", + date.origin = NULL, + adjust.pr = 1, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{outfolder}{- directory where output files will be stored} @@ -18,8 +31,6 @@ extract.local.CMIP5(outfolder, in.path, start_date, end_date, site_id, \item{end_date}{- last day for which you want to extract met (yyyy-mm-dd)} -\item{site_id}{name to associate with extracted files} - \item{lat.in}{site latitude in decimal degrees} \item{lon.in}{site longitude in decimal degrees} @@ -34,9 +45,7 @@ extract.local.CMIP5(outfolder, in.path, start_date, end_date, site_id, If NULL defaults to 1850 for historical simulations (except MPI-ESM-P) and 850 for p1000 simulations (plus MPI-ESM-P historical). Format: YYYY-MM-DD} -\item{no.leap}{(optional, logical) if you know your GCM of interest is missing leap year, you can specify it here. -otherwise the code will automatically determine if leap year is missing and if it should be -added in.} +\item{adjust.pr}{- adjustment factor fore preciptiation when the extracted values seem off} \item{overwrite}{logical. Download a fresh version even if a local file with the same name already exists?} @@ -51,10 +60,6 @@ This function extracts CMIP5 data from grids that have been downloaded and store give a pseudo-daily record (and can get dealt with in the downscaling workflow). These files are ready to be used in the general PEcAn workflow or fed into the downscaling workflow. } -\details{ -Extract NLDAS from local download -Extract NLDAS meteorology for a poimt from a local download of the full grid -} \author{ -Christy Rollinson, +Christy Rollinson } diff --git a/modules/data.atmosphere/man/extract.local.NLDAS.Rd b/modules/data.atmosphere/man/extract.local.NLDAS.Rd index c0a0dae92a3..e98ba47e292 100644 --- a/modules/data.atmosphere/man/extract.local.NLDAS.Rd +++ b/modules/data.atmosphere/man/extract.local.NLDAS.Rd @@ -2,10 +2,20 @@ % Please edit documentation in R/extract_local_NLDAS.R \name{extract.local.NLDAS} \alias{extract.local.NLDAS} -\title{extract.local.NLDAS} +\title{Extract NLDAS from local download +Extract NLDAS meteorology for a point from a local download of the full grid} \usage{ -extract.local.NLDAS(outfolder, in.path, start_date, end_date, site_id, - lat.in, lon.in, overwrite = FALSE, verbose = FALSE, ...) +extract.local.NLDAS( + outfolder, + in.path, + start_date, + end_date, + lat.in, + lon.in, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{outfolder}{- directory where output files will be stored} @@ -16,8 +26,6 @@ extract.local.NLDAS(outfolder, in.path, start_date, end_date, site_id, \item{end_date}{- last day for which you want to extract met (yyyy-mm-dd)} -\item{site_id}{name to associate with extracted files} - \item{lat.in}{site latitude in decimal degrees} \item{lon.in}{site longitude in decimal degrees} @@ -36,10 +44,6 @@ This function extracts NLDAS data from grids that have been downloaded and store These files are ready to be used in the general PEcAn workflow or fed into the downscalign workflow. } -\details{ -Extract NLDAS from local download -Extract NLDAS meteorology for a poimt from a local download of the full grid -} \author{ -Christy Rollinson, +Christy Rollinson } diff --git a/modules/data.atmosphere/man/extract.nc.ERA5.Rd b/modules/data.atmosphere/man/extract.nc.ERA5.Rd index 750c5a28034..a5c6ce66081 100644 --- a/modules/data.atmosphere/man/extract.nc.ERA5.Rd +++ b/modules/data.atmosphere/man/extract.nc.ERA5.Rd @@ -4,8 +4,19 @@ \alias{extract.nc.ERA5} \title{ERA5_extract} \usage{ -extract.nc.ERA5(slat, slon, in.path, start_date, end_date, outfolder, - in.prefix, newsite, vars = NULL, overwrite = FALSE, ...) +extract.nc.ERA5( + slat, + slon, + in.path, + start_date, + end_date, + outfolder, + in.prefix, + newsite, + vars = NULL, + overwrite = FALSE, + ... +) } \arguments{ \item{slat}{latitude} diff --git a/modules/data.atmosphere/man/extract.nc.Rd b/modules/data.atmosphere/man/extract.nc.Rd index 27863bbc13d..8fe057801f0 100644 --- a/modules/data.atmosphere/man/extract.nc.Rd +++ b/modules/data.atmosphere/man/extract.nc.Rd @@ -4,8 +4,18 @@ \alias{extract.nc} \title{extract.nc} \usage{ -extract.nc(in.path, in.prefix, outfolder, start_date, end_date, slat, slon, - overwrite = FALSE, verbose = FALSE, ...) +extract.nc( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + slat, + slon, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{location on disk where inputs are stored} diff --git a/modules/data.atmosphere/man/gen.subdaily.models.Rd b/modules/data.atmosphere/man/gen.subdaily.models.Rd index bfd9872de36..872183e9514 100644 --- a/modules/data.atmosphere/man/gen.subdaily.models.Rd +++ b/modules/data.atmosphere/man/gen.subdaily.models.Rd @@ -4,11 +4,22 @@ \alias{gen.subdaily.models} \title{gen.subdaily.models} \usage{ -gen.subdaily.models(outfolder, path.train, yrs.train, - direction.filter = "forward", in.prefix, n.beta, day.window, - seed = Sys.time(), resids = FALSE, parallel = FALSE, - n.cores = NULL, overwrite = TRUE, verbose = FALSE, - print.progress = FALSE) +gen.subdaily.models( + outfolder, + path.train, + yrs.train, + direction.filter = "forward", + in.prefix, + n.beta, + day.window, + seed = Sys.time(), + resids = FALSE, + parallel = FALSE, + n.cores = NULL, + overwrite = TRUE, + verbose = FALSE, + print.progress = FALSE +) } \arguments{ \item{outfolder}{- directory where models will be stored *** storage required varies by size of training dataset, but prepare for >10 GB} @@ -58,12 +69,15 @@ Generate Subdaily Models Create statistical models to predict subdaily meteorology } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{lm_ensemble_sims}}, - \code{\link{model.train}}, \code{\link{nc.merge}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.betas}}, \code{\link{save.model}}, - \code{\link{subdaily_pred}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{lm_ensemble_sims}()}, +\code{\link{model.train}()}, +\code{\link{nc.merge}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.betas}()}, +\code{\link{save.model}()}, +\code{\link{subdaily_pred}()}, +\code{\link{temporal.downscale.functions}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/generate_narr_url.Rd b/modules/data.atmosphere/man/generate_narr_url.Rd index 40980a60db3..5fb6e1b844a 100644 --- a/modules/data.atmosphere/man/generate_narr_url.Rd +++ b/modules/data.atmosphere/man/generate_narr_url.Rd @@ -9,11 +9,11 @@ generate_narr_url(dates, flx) \arguments{ \item{dates}{Vector of dates for which to generate URL} -\item{flx}{(Logical) If `TRUE`, format for `flx` variables. Otherwise, +\item{flx}{(Logical) If `TRUE`, format for `flx` variables. Otherwise, format for `sfc` variables. See [narr_flx_vars].} } \description{ -Figures out file names for the given dates, based on NARR's convoluted and +Figures out file names for the given dates, based on NARR's convoluted and inconsistent naming scheme. } \author{ diff --git a/modules/data.atmosphere/man/get.ncvector.Rd b/modules/data.atmosphere/man/get.ncvector.Rd index e98e9f2690f..85404da6b3e 100644 --- a/modules/data.atmosphere/man/get.ncvector.Rd +++ b/modules/data.atmosphere/man/get.ncvector.Rd @@ -4,8 +4,7 @@ \alias{get.ncvector} \title{Get time series vector from netCDF file} \usage{ -get.ncvector(var, lati = lati, loni = loni, run.dates = run.dates, - met.nc) +get.ncvector(var, lati = lati, loni = loni, run.dates = run.dates, met.nc) } \arguments{ \item{met.nc}{netcdf file with CF variable names} diff --git a/modules/data.atmosphere/man/get.rh.Rd b/modules/data.atmosphere/man/get.rh.Rd index d6bb66fd10f..34056a27891 100644 --- a/modules/data.atmosphere/man/get.rh.Rd +++ b/modules/data.atmosphere/man/get.rh.Rd @@ -7,20 +7,24 @@ get.rh(T, Td) } \arguments{ -\item{T}{temperature} +\item{T}{air temperature, Kelvin} -\item{Td}{dewpoint} +\item{Td}{dewpoint, Kelvin} } \value{ -numeric vector +Relative Humidity numeric vector } \description{ Calculate RH from temperature and dewpoint } \details{ -Based on equation 12 ( in Lawrence 2005, The Relationship between +Based on equation 12 in Lawrence 2005, The Relationship between Relative Humidity and the Dewpoint Temperature in Moist Air -A Simple Conversion and Applications.) +A Simple Conversion and Applications. BAMS +https://doi.org/10.1175/BAMS-86-2-225 +R = 461.5 K-1 kg-1 gas constant H2O +L enthalpy of vaporization +linear dependence on T (p 226, following eq 9) } \author{ David LeBauer diff --git a/modules/data.atmosphere/man/get_NARR_thredds.Rd b/modules/data.atmosphere/man/get_NARR_thredds.Rd index 58926317ad6..58896d47f1a 100644 --- a/modules/data.atmosphere/man/get_NARR_thredds.Rd +++ b/modules/data.atmosphere/man/get_NARR_thredds.Rd @@ -4,8 +4,16 @@ \alias{get_NARR_thredds} \title{Retrieve NARR data using thredds} \usage{ -get_NARR_thredds(start_date, end_date, lat.in, lon.in, progress = TRUE, - drop_outside = TRUE, parallel = TRUE, ncores = 1) +get_NARR_thredds( + start_date, + end_date, + lat.in, + lon.in, + progress = TRUE, + drop_outside = TRUE, + parallel = TRUE, + ncores = 1 +) } \arguments{ \item{start_date}{Start date for meteorology} @@ -19,12 +27,12 @@ get_NARR_thredds(start_date, end_date, lat.in, lon.in, progress = TRUE, \item{progress}{Whether or not to show a progress bar (default = `TRUE`). Requires the `progress` package to be installed.} -\item{drop_outside}{Whether or not to drop dates outside of `start_date` to +\item{drop_outside}{Whether or not to drop dates outside of `start_date` to `end_date` range (default = `TRUE`).} \item{parallel}{Download in parallel? Default = TRUE} -\item{ncores}{Number of cores for parallel download. Default is +\item{ncores}{Number of cores for parallel download. Default is `parallel::detectCores()`} } \value{ diff --git a/modules/data.atmosphere/man/get_narr_url.Rd b/modules/data.atmosphere/man/get_narr_url.Rd index 218e835c031..bc80fc4c05c 100644 --- a/modules/data.atmosphere/man/get_narr_url.Rd +++ b/modules/data.atmosphere/man/get_narr_url.Rd @@ -11,7 +11,7 @@ get_narr_url(url, xy, flx, pb = NULL) \item{xy}{Vector length 2 containing NARR coordinates} -\item{flx}{(Logical) If `TRUE`, format for `flx` variables. Otherwise, +\item{flx}{(Logical) If `TRUE`, format for `flx` variables. Otherwise, format for `sfc` variables. See [narr_flx_vars].} \item{pb}{Progress bar R6 object (default = `NULL`)} diff --git a/modules/data.atmosphere/man/half_hour_downscale.Rd b/modules/data.atmosphere/man/half_hour_downscale.Rd new file mode 100644 index 00000000000..58cfcc6d76d --- /dev/null +++ b/modules/data.atmosphere/man/half_hour_downscale.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/half_hour_downscale.R +\name{half_hour_downscale} +\alias{half_hour_downscale} +\alias{temporal_downscale_half_hour} +\title{half_hour_downscale} +\usage{ +temporal_downscale_half_hour( + input_file, + output_file, + overwrite = TRUE, + hr = 0.5 +) +} +\arguments{ +\item{input_file}{location of NOAAGEFS_1hr files} + +\item{output_file}{location where to store half_hour files} + +\item{overwrite}{whether to force hamf_hour_downscale to proceed} + +\item{hr}{set half hour} +} +\value{ +A list of data frames is returned containing information about the data file that can be used to locate it later. Each +data frame contains information about one file. +} +\description{ +half_hour_downscale +} diff --git a/modules/data.atmosphere/man/latlon2lcc.Rd b/modules/data.atmosphere/man/latlon2lcc.Rd index cbd47e269d9..7db1f0ae231 100644 --- a/modules/data.atmosphere/man/latlon2lcc.Rd +++ b/modules/data.atmosphere/man/latlon2lcc.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/download.NARR_site.R \name{latlon2lcc} \alias{latlon2lcc} -\title{Convert latitude and longitude to x-y coordinates (in km) in Lambert +\title{Convert latitude and longitude to x-y coordinates (in km) in Lambert conformal conic projection (used by NARR)} \usage{ latlon2lcc(lat.in, lon.in) @@ -13,11 +13,11 @@ latlon2lcc(lat.in, lon.in) \item{lon.in}{Longitude coordinate} } \value{ -`sp::SpatialPoints` object containing transformed x and y +`sp::SpatialPoints` object containing transformed x and y coordinates, in km, which should match NARR coordinates } \description{ -Convert latitude and longitude to x-y coordinates (in km) in Lambert +Convert latitude and longitude to x-y coordinates (in km) in Lambert conformal conic projection (used by NARR) } \author{ diff --git a/modules/data.atmosphere/man/latlon2narr.Rd b/modules/data.atmosphere/man/latlon2narr.Rd index 3f99b2c53ed..e9895bb0fa7 100644 --- a/modules/data.atmosphere/man/latlon2narr.Rd +++ b/modules/data.atmosphere/man/latlon2narr.Rd @@ -14,7 +14,7 @@ latlon2narr(nc, lat.in, lon.in) \item{lon.in}{Longitude coordinate} } \value{ -Vector length 2 containing NARR `x` and `y` indices, which can be +Vector length 2 containing NARR `x` and `y` indices, which can be used in `ncdf4::ncvar_get` `start` argument. } \description{ diff --git a/modules/data.atmosphere/man/lightME.Rd b/modules/data.atmosphere/man/lightME.Rd index 43bf8c53d03..8564a82d8ec 100644 --- a/modules/data.atmosphere/man/lightME.Rd +++ b/modules/data.atmosphere/man/lightME.Rd @@ -4,8 +4,7 @@ \alias{lightME} \title{Simulates the light macro environment} \usage{ -lightME(lat = 40, DOY = 190, t.d = 12, t.sn = 12, atm.P = 1e+05, - alpha = 0.85) +lightME(lat = 40, DOY = 190, t.d = 12, t.sn = 12, atm.P = 1e+05, alpha = 0.85) } \arguments{ \item{lat}{the latitude, default is 40 (Urbana, IL, U.S.).} diff --git a/modules/data.atmosphere/man/lm_ensemble_sims.Rd b/modules/data.atmosphere/man/lm_ensemble_sims.Rd index 8b4ae1bac0b..72fc86a8fe6 100644 --- a/modules/data.atmosphere/man/lm_ensemble_sims.Rd +++ b/modules/data.atmosphere/man/lm_ensemble_sims.Rd @@ -4,10 +4,21 @@ \alias{lm_ensemble_sims} \title{lm_ensemble_sims} \usage{ -lm_ensemble_sims(dat.mod, n.ens, path.model, direction.filter, - lags.list = NULL, lags.init = NULL, dat.train, precip.distribution, - force.sanity = TRUE, sanity.tries = 25, seed = Sys.time(), - print.progress = FALSE) +lm_ensemble_sims( + dat.mod, + n.ens, + path.model, + direction.filter, + lags.list = NULL, + lags.init = NULL, + dat.train, + precip.distribution, + force.sanity = TRUE, + sanity.tries = 25, + sanity.sd = 6, + seed = Sys.time(), + print.progress = FALSE +) } \arguments{ \item{dat.mod}{- dataframe to be predicted at the time step of the training data} @@ -21,16 +32,18 @@ lm_ensemble_sims(dat.mod, n.ens, path.model, direction.filter, \item{lags.init}{- a data frame of initialization parameters to match the data in dat.mod} -\item{dat.train}{- the training data used to fit the model; needed for night/day in +\item{dat.train}{- the training data used to fit the model; needed for night/day in surface_downwelling_shortwave_flux_in_air} -\item{precip.distribution}{- a list with 2 sub-lists containing the number of observations with precip in the training data per day & +\item{precip.distribution}{- a list with 2 sub-lists containing the number of observations with precip in the training data per day & the hour of max rain in the training data. This will be used to help solve the "constant drizzle" problem} \item{force.sanity}{- (logical) do we force the data to meet sanity checks?} \item{sanity.tries}{- how many time should we try to predict a reasonable value before giving up? We don't want to end up in an infinite loop} +\item{sanity.sd}{- how many standard deviations from the mean should be used to determine sane outliers (default 6)} + \item{seed}{- (optional) set the seed manually to allow reproducible results} \item{print.progress}{- if TRUE will print progress bar} @@ -47,12 +60,15 @@ Linear Regression Ensemble Simulation Met downscaling function that predicts ensembles of downscaled meteorology } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{model.train}}, \code{\link{nc.merge}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.betas}}, \code{\link{save.model}}, - \code{\link{subdaily_pred}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{model.train}()}, +\code{\link{nc.merge}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.betas}()}, +\code{\link{save.model}()}, +\code{\link{subdaily_pred}()}, +\code{\link{temporal.downscale.functions}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/merge_met_variable.Rd b/modules/data.atmosphere/man/merge_met_variable.Rd index 343cfdd023f..c310eb7689b 100644 --- a/modules/data.atmosphere/man/merge_met_variable.Rd +++ b/modules/data.atmosphere/man/merge_met_variable.Rd @@ -4,8 +4,16 @@ \alias{merge_met_variable} \title{Merge a new met variable from an external file (e.g. CO2) into existing met files} \usage{ -merge_met_variable(in.path, in.prefix, start_date, end_date, merge.file, - overwrite = FALSE, verbose = FALSE, ...) +merge_met_variable( + in.path, + in.prefix, + start_date, + end_date, + merge.file, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{path to original data} @@ -25,6 +33,9 @@ print debugging information as they run?} \item{...}{} } +\value{ +Currently nothing. TODO: Return a data frame summarizing the merged files. +} \description{ Merge a new met variable from an external file (e.g. CO2) into existing met files } diff --git a/modules/data.atmosphere/man/met.process.Rd b/modules/data.atmosphere/man/met.process.Rd index 09b5da424df..7aee712c518 100644 --- a/modules/data.atmosphere/man/met.process.Rd +++ b/modules/data.atmosphere/man/met.process.Rd @@ -4,9 +4,19 @@ \alias{met.process} \title{met.process} \usage{ -met.process(site, input_met, start_date, end_date, model, - host = "localhost", dbparms, dir, browndog = NULL, spin = NULL, - overwrite = FALSE) +met.process( + site, + input_met, + start_date, + end_date, + model, + host = "localhost", + dbparms, + dir, + browndog = NULL, + spin = NULL, + overwrite = FALSE +) } \arguments{ \item{site}{Site info from settings file} @@ -29,6 +39,7 @@ met.process(site, input_met, start_date, end_date, model, \item{overwrite}{Whether to force met.process to proceed. + `overwrite` may be a list with individual components corresponding to `download`, `met2cf`, `standardize`, and `met2model`. If it is instead a simple boolean, the default behavior for `overwrite=FALSE` is to overwrite nothing, as you might expect. diff --git a/modules/data.atmosphere/man/met.process.stage.Rd b/modules/data.atmosphere/man/met.process.stage.Rd index fe3eaa0122a..cf056773ff7 100644 --- a/modules/data.atmosphere/man/met.process.stage.Rd +++ b/modules/data.atmosphere/man/met.process.stage.Rd @@ -7,7 +7,7 @@ met.process.stage(input.id, raw.id, con) } \arguments{ -\item{raw.id}{} +\item{con}{database connection} } \description{ met.process.stage diff --git a/modules/data.atmosphere/man/met2CF.ALMA.Rd b/modules/data.atmosphere/man/met2CF.ALMA.Rd index f539d62e0ed..fde57db76b3 100644 --- a/modules/data.atmosphere/man/met2CF.ALMA.Rd +++ b/modules/data.atmosphere/man/met2CF.ALMA.Rd @@ -4,8 +4,15 @@ \alias{met2CF.ALMA} \title{met2CF.ALMA} \usage{ -met2CF.ALMA(in.path, in.prefix, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE) +met2CF.ALMA( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE +) } \arguments{ \item{in.path}{location on disk where inputs are stored} diff --git a/modules/data.atmosphere/man/met2CF.Ameriflux.Rd b/modules/data.atmosphere/man/met2CF.Ameriflux.Rd index ef1ea3b6ce4..0e054519cef 100644 --- a/modules/data.atmosphere/man/met2CF.Ameriflux.Rd +++ b/modules/data.atmosphere/man/met2CF.Ameriflux.Rd @@ -4,8 +4,16 @@ \alias{met2CF.Ameriflux} \title{met2CF.Ameriflux} \usage{ -met2CF.Ameriflux(in.path, in.prefix, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +met2CF.Ameriflux( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{location on disk where inputs are stored} diff --git a/modules/data.atmosphere/man/met2CF.AmerifluxLBL.Rd b/modules/data.atmosphere/man/met2CF.AmerifluxLBL.Rd index 740fb7c8111..b37b4c2478f 100644 --- a/modules/data.atmosphere/man/met2CF.AmerifluxLBL.Rd +++ b/modules/data.atmosphere/man/met2CF.AmerifluxLBL.Rd @@ -4,8 +4,17 @@ \alias{met2CF.AmerifluxLBL} \title{met2CF.AmerifluxLBL} \usage{ -met2CF.AmerifluxLBL(in.path, in.prefix, outfolder, start_date, end_date, - format, overwrite = FALSE, verbose = FALSE, ...) +met2CF.AmerifluxLBL( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + format, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{location on disk where inputs are stored} diff --git a/modules/data.atmosphere/man/met2CF.ERA5.Rd b/modules/data.atmosphere/man/met2CF.ERA5.Rd index 37a12bea296..afaf311117b 100644 --- a/modules/data.atmosphere/man/met2CF.ERA5.Rd +++ b/modules/data.atmosphere/man/met2CF.ERA5.Rd @@ -4,8 +4,17 @@ \alias{met2CF.ERA5} \title{met2cf.ERA5} \usage{ -met2CF.ERA5(lat, long, start_date, end_date, sitename, outfolder, out.xts, - overwrite = FALSE, verbose = TRUE) +met2CF.ERA5( + lat, + long, + start_date, + end_date, + sitename, + outfolder, + out.xts, + overwrite = FALSE, + verbose = TRUE +) } \arguments{ \item{lat}{latitude} @@ -26,6 +35,9 @@ met2CF.ERA5(lat, long, start_date, end_date, sitename, outfolder, out.xts, \item{verbose}{Logical flag defining if ouput of function be extra verbose.} } +\value{ +list of dataframes +} \description{ met2cf.ERA5 } diff --git a/modules/data.atmosphere/man/met2CF.FACE.Rd b/modules/data.atmosphere/man/met2CF.FACE.Rd index 9b2a1a075f6..25631e1a23f 100644 --- a/modules/data.atmosphere/man/met2CF.FACE.Rd +++ b/modules/data.atmosphere/man/met2CF.FACE.Rd @@ -4,8 +4,17 @@ \alias{met2CF.FACE} \title{convert FACE files to CF files} \usage{ -met2CF.FACE(in.path, in.prefix, outfolder, start_date, end_date, input.id, - site, format, ...) +met2CF.FACE( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + input.id, + site, + format, + ... +) } \description{ convert FACE files to CF files diff --git a/modules/data.atmosphere/man/met2CF.Geostreams.Rd b/modules/data.atmosphere/man/met2CF.Geostreams.Rd index 00748e2e324..c5a4f3f4496 100644 --- a/modules/data.atmosphere/man/met2CF.Geostreams.Rd +++ b/modules/data.atmosphere/man/met2CF.Geostreams.Rd @@ -4,8 +4,16 @@ \alias{met2CF.Geostreams} \title{Convert geostreams JSON to CF met file} \usage{ -met2CF.Geostreams(in.path, in.prefix, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +met2CF.Geostreams( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{directory containing Geostreams JSON file(s) to be converted} diff --git a/modules/data.atmosphere/man/met2CF.ICOS.Rd b/modules/data.atmosphere/man/met2CF.ICOS.Rd new file mode 100644 index 00000000000..417cd2cd630 --- /dev/null +++ b/modules/data.atmosphere/man/met2CF.ICOS.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/met2CF.ICOS.R +\name{met2CF.ICOS} +\alias{met2CF.ICOS} +\title{Convert variables ICOS variables to CF format.} +\usage{ +met2CF.ICOS( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + format, + overwrite = FALSE, + ... +) +} +\arguments{ +\item{in.path}{path to the input ICOS product CSV file} + +\item{in.prefix}{name of the input file} + +\item{outfolder}{path to the directory where the output file is stored. If specified directory does not exists, it is created.} + +\item{start_date}{start date of the input file} + +\item{end_date}{end date of the input file} + +\item{format}{format is data frame or list with elements as described below + REQUIRED: + format$header = number of lines of header + format$vars is a data.frame with lists of information for each variable to read, at least airT is required + format$vars$input_name = Name in CSV file + format$vars$input_units = Units in CSV file + format$vars$bety_name = Name in BETY + OPTIONAL: + format$lat = latitude of site + format$lon = longitude of site + format$na.strings = list of missing values to convert to NA, such as -9999 + format$skip = lines to skip excluding header + format$vars$column_number = Column number in CSV file (optional, will use header name first) +Columns with NA for bety variable name are dropped.} + +\item{overwrite}{overwrite should existing files be overwritten. Default False.} + +\item{...}{used when extra arguments are present.} +} +\value{ +information about the output file +} +\description{ +Variables present in the output netCDF file: +air_temperature, air_temperature, relative_humidity, +specific_humidity, water_vapor_saturation_deficit, +surface_downwelling_longwave_flux_in_air, +surface_downwelling_shortwave_flux_in_air, +surface_downwelling_photosynthetic_photon_flux_in_air, precipitation_flux, +eastward_wind, northward_wind +} diff --git a/modules/data.atmosphere/man/met2CF.NARR.Rd b/modules/data.atmosphere/man/met2CF.NARR.Rd index f25f3c25495..b851e533d59 100644 --- a/modules/data.atmosphere/man/met2CF.NARR.Rd +++ b/modules/data.atmosphere/man/met2CF.NARR.Rd @@ -4,8 +4,16 @@ \alias{met2CF.NARR} \title{met2CF.NARR} \usage{ -met2CF.NARR(in.path, in.prefix, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +met2CF.NARR( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{start_date}{the start date of the data to be downloaded (will only use the year part of the date)} diff --git a/modules/data.atmosphere/man/met2CF.PalEON.Rd b/modules/data.atmosphere/man/met2CF.PalEON.Rd index d8d55827954..6879078c28a 100644 --- a/modules/data.atmosphere/man/met2CF.PalEON.Rd +++ b/modules/data.atmosphere/man/met2CF.PalEON.Rd @@ -4,8 +4,18 @@ \alias{met2CF.PalEON} \title{met2CF.PalEON} \usage{ -met2CF.PalEON(in.path, in.prefix, outfolder, start_date, end_date, lat, - lon, overwrite = FALSE, verbose = FALSE, ...) +met2CF.PalEON( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + lat, + lon, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{location on disk where inputs are stored} diff --git a/modules/data.atmosphere/man/met2CF.PalEONregional.Rd b/modules/data.atmosphere/man/met2CF.PalEONregional.Rd index 19ddb63d1fd..946032482ba 100644 --- a/modules/data.atmosphere/man/met2CF.PalEONregional.Rd +++ b/modules/data.atmosphere/man/met2CF.PalEONregional.Rd @@ -4,11 +4,16 @@ \alias{met2CF.PalEONregional} \title{met2CF.PalEONregional} \usage{ -met2CF.PalEONregional(in.path, in.prefix, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) - -met2CF.PalEONregional(in.path, in.prefix, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +met2CF.PalEONregional( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{location on disk where inputs are stored} @@ -21,27 +26,11 @@ met2CF.PalEONregional(in.path, in.prefix, outfolder, start_date, end_date, \item{end_date}{the end date of the data to be downloaded (will only use the year part of the date)} -\item{overwrite}{should existing files be overwritten} - -\item{in.path}{location on disk where inputs are stored} - -\item{in.prefix}{prefix of input and output files} - -\item{outfolder}{location on disk where outputs will be stored} - -\item{start_date}{the start date of the data to be downloaded (will only use the year part of the date)} - -\item{end_date}{the end date of the data to be downloaded (will only use the year part of the date)} - \item{overwrite}{should existing files be overwritten} } \description{ -Get meteorology variables from PalEON netCDF files and convert to netCDF CF format - Get meteorology variables from PalEON netCDF files and convert to netCDF CF format } \author{ -Mike Dietze - Mike Dietze } diff --git a/modules/data.atmosphere/man/met2CF.csv.Rd b/modules/data.atmosphere/man/met2CF.csv.Rd index 8149b63e65f..77bf41d5165 100644 --- a/modules/data.atmosphere/man/met2CF.csv.Rd +++ b/modules/data.atmosphere/man/met2CF.csv.Rd @@ -4,9 +4,19 @@ \alias{met2CF.csv} \title{met2CF.csv} \usage{ -met2CF.csv(in.path, in.prefix, outfolder, start_date, end_date, format, - lat = NULL, lon = NULL, nc_verbose = FALSE, overwrite = FALSE, - ...) +met2CF.csv( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + format, + lat = NULL, + lon = NULL, + nc_verbose = FALSE, + overwrite = FALSE, + ... +) } \arguments{ \item{format}{data frame or list with elements as described below diff --git a/modules/data.atmosphere/man/met_temporal_downscale.Gaussian_ensemble.Rd b/modules/data.atmosphere/man/met_temporal_downscale.Gaussian_ensemble.Rd index 96d22450da8..a67e6f2a5f2 100644 --- a/modules/data.atmosphere/man/met_temporal_downscale.Gaussian_ensemble.Rd +++ b/modules/data.atmosphere/man/met_temporal_downscale.Gaussian_ensemble.Rd @@ -4,15 +4,28 @@ \alias{met_temporal_downscale.Gaussian_ensemble} \title{met_temporal_downscale.Gaussian_ensemble} \usage{ -met_temporal_downscale.Gaussian_ensemble(in.path, in.prefix, outfolder, - input_met, train_met, site_id, overwrite = FALSE, verbose = FALSE, - swdn_method = "sine", n_ens = 10, w_len = 20, utc_diff = -6, ...) +met_temporal_downscale.Gaussian_ensemble( + in.path, + in.prefix, + outfolder, + input_met, + train_met, + overwrite = FALSE, + verbose = FALSE, + swdn_method = "sine", + n_ens = 10, + w_len = 20, + utc_diff = -6, + ... +) } \arguments{ \item{in.path}{} \item{in.prefix}{} +\item{outfolder}{path to directory in which to store output. Will be created if it does not exist} + \item{input_met}{- the source dataset that will temporally downscaled by the train_met dataset} \item{train_met}{- the observed dataset that will be used to train the modeled dataset in NC format. i.e. Flux Tower dataset @@ -30,6 +43,8 @@ print debugging information as they run?} \item{w_len}{- numeric value that is the window length in days} \item{utc_diff}{- numeric value in HOURS that is local standard time difference from UTC time. CST is -6} + +\item{...}{further arguments, currently ignored} } \description{ met_temporal_downscale.Gaussian_ensemble takes source data and a training dataset from the same site and temporally diff --git a/modules/data.atmosphere/man/metgapfill.NOAA_GEFS.Rd b/modules/data.atmosphere/man/metgapfill.NOAA_GEFS.Rd index a6d126cbb9c..196a6394990 100644 --- a/modules/data.atmosphere/man/metgapfill.NOAA_GEFS.Rd +++ b/modules/data.atmosphere/man/metgapfill.NOAA_GEFS.Rd @@ -4,8 +4,16 @@ \alias{metgapfill.NOAA_GEFS} \title{Gapfill NOAA_GEFS weather data} \usage{ -metgapfill.NOAA_GEFS(in.prefix, in.path, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +metgapfill.NOAA_GEFS( + in.prefix, + in.path, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.prefix}{the met file name} diff --git a/modules/data.atmosphere/man/metgapfill.Rd b/modules/data.atmosphere/man/metgapfill.Rd index a8d258ff30d..e5a7d37a385 100644 --- a/modules/data.atmosphere/man/metgapfill.Rd +++ b/modules/data.atmosphere/man/metgapfill.Rd @@ -8,8 +8,17 @@ Currently Future version: Choose which variables to gap fill Future version will first downscale and fill with NARR, then REddyProc} \usage{ -metgapfill(in.path, in.prefix, outfolder, start_date, end_date, lst = 0, - overwrite = FALSE, verbose = FALSE, ...) +metgapfill( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + lst = 0, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{location on disk where inputs are stord} diff --git a/modules/data.atmosphere/man/model.train.Rd b/modules/data.atmosphere/man/model.train.Rd index ab173e23221..eea0a3fec51 100644 --- a/modules/data.atmosphere/man/model.train.Rd +++ b/modules/data.atmosphere/man/model.train.Rd @@ -4,8 +4,7 @@ \alias{model.train} \title{model.train} \usage{ -model.train(dat.subset, v, n.beta, resids = resids, threshold = NULL, - ...) +model.train(dat.subset, v, n.beta, resids = resids, threshold = NULL, ...) } \arguments{ \item{dat.subset}{data.frame containing lags, next, and downscale period data} @@ -28,12 +27,15 @@ TDM Model Train Linear regression calculations for specific met variables } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{lm_ensemble_sims}}, \code{\link{nc.merge}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.betas}}, \code{\link{save.model}}, - \code{\link{subdaily_pred}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{lm_ensemble_sims}()}, +\code{\link{nc.merge}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.betas}()}, +\code{\link{save.model}()}, +\code{\link{subdaily_pred}()}, +\code{\link{temporal.downscale.functions}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/nc.merge.Rd b/modules/data.atmosphere/man/nc.merge.Rd index 03c0c320205..75329f45c33 100644 --- a/modules/data.atmosphere/man/nc.merge.Rd +++ b/modules/data.atmosphere/man/nc.merge.Rd @@ -4,8 +4,17 @@ \alias{nc.merge} \title{nc.merge} \usage{ -nc.merge(outfolder, in.path, in.prefix, start_date, end_date, - upscale = FALSE, overwrite = FALSE, verbose = FALSE, ...) +nc.merge( + outfolder, + in.path, + in.prefix, + start_date, + end_date, + upscale = FALSE, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{outfolder}{- directory where output will be stored} @@ -36,13 +45,15 @@ nc.merge Parses multiple netCDF files into one central document for temporal downscaling procedure } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{lm_ensemble_sims}}, - \code{\link{model.train}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.betas}}, \code{\link{save.model}}, - \code{\link{subdaily_pred}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{lm_ensemble_sims}()}, +\code{\link{model.train}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.betas}()}, +\code{\link{save.model}()}, +\code{\link{subdaily_pred}()}, +\code{\link{temporal.downscale.functions}()} } \author{ James Simkins, Christy Rollinson diff --git a/modules/data.atmosphere/man/noaa_grid_download.Rd b/modules/data.atmosphere/man/noaa_grid_download.Rd new file mode 100644 index 00000000000..8d48f18e485 --- /dev/null +++ b/modules/data.atmosphere/man/noaa_grid_download.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/GEFS_helper_functions.R +\name{noaa_grid_download} +\alias{noaa_grid_download} +\title{Download gridded forecast in the box bounded by the latitude and longitude list} +\usage{ +noaa_grid_download( + lat_list, + lon_list, + forecast_time, + forecast_date, + model_name_raw, + output_directory, + end_hr +) +} +\arguments{ +\item{lat_list}{lat for site} + +\item{lon_list}{long for site} + +\item{forecast_time}{start hour of forecast} + +\item{forecast_date}{date for forecast} + +\item{model_name_raw}{model name for directory creation} + +\item{output_directory}{output directory} + +\item{end_hr}{end hr to determine how many hours to download} +} +\value{ +NA +} +\description{ +Download gridded forecast in the box bounded by the latitude and longitude list +} diff --git a/modules/data.atmosphere/man/permute.nc.Rd b/modules/data.atmosphere/man/permute.nc.Rd index 75c2dcb4689..eeafd16fb10 100644 --- a/modules/data.atmosphere/man/permute.nc.Rd +++ b/modules/data.atmosphere/man/permute.nc.Rd @@ -4,8 +4,16 @@ \alias{permute.nc} \title{permute.nc} \usage{ -permute.nc(in.path, in.prefix, outfolder, start_date, end_date, - overwrite = FALSE, verbose = FALSE, ...) +permute.nc( + in.path, + in.prefix, + outfolder, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{location on disk where inputs are stored} diff --git a/modules/data.atmosphere/man/predict_subdaily_met.Rd b/modules/data.atmosphere/man/predict_subdaily_met.Rd index 4fe464ccb6c..3d4898e3e6f 100644 --- a/modules/data.atmosphere/man/predict_subdaily_met.Rd +++ b/modules/data.atmosphere/man/predict_subdaily_met.Rd @@ -4,11 +4,25 @@ \alias{predict_subdaily_met} \title{predict_subdaily_met} \usage{ -predict_subdaily_met(outfolder, in.path, in.prefix, path.train, - direction.filter = "forward", lm.models.base, yrs.predict = NULL, - ens.labs = 1:3, resids = FALSE, force.sanity = TRUE, - sanity.tries = 25, overwrite = FALSE, verbose = FALSE, - seed = format(Sys.time(), "\%m\%d"), print.progress = FALSE, ...) +predict_subdaily_met( + outfolder, + in.path, + in.prefix, + path.train, + direction.filter = "forward", + lm.models.base, + yrs.predict = NULL, + ens.labs = 1:3, + resids = FALSE, + adjust.pr = 1, + force.sanity = TRUE, + sanity.tries = 25, + overwrite = FALSE, + verbose = FALSE, + seed = format(Sys.time(), "\%m\%d"), + print.progress = FALSE, + ... +) } \arguments{ \item{outfolder}{- directory where output file will be stored} @@ -33,6 +47,8 @@ ensemble rather than overwriting with a default naming scheme} \item{resids}{- logical stating whether to pass on residual data or not} +\item{adjust.pr}{- adjustment factor fore preciptiation when the extracted values seem off} + \item{force.sanity}{- (logical) do we force the data to meet sanity checks?} \item{sanity.tries}{- how many time should we try to predict a reasonable value before giving up? We don't want to end up in an infinite loop} @@ -73,12 +89,15 @@ cores.max = 12 n.ens = 3} } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{lm_ensemble_sims}}, - \code{\link{model.train}}, \code{\link{nc.merge}}, - \code{\link{save.betas}}, \code{\link{save.model}}, - \code{\link{subdaily_pred}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{lm_ensemble_sims}()}, +\code{\link{model.train}()}, +\code{\link{nc.merge}()}, +\code{\link{save.betas}()}, +\code{\link{save.model}()}, +\code{\link{subdaily_pred}()}, +\code{\link{temporal.downscale.functions}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/prepare_narr_year.Rd b/modules/data.atmosphere/man/prepare_narr_year.Rd index 237bec25fc9..181eaf0e9f8 100644 --- a/modules/data.atmosphere/man/prepare_narr_year.Rd +++ b/modules/data.atmosphere/man/prepare_narr_year.Rd @@ -15,10 +15,10 @@ prepare_narr_year(dat, file, lat_nc, lon_nc, verbose = FALSE) \item{lon_nc}{`ncdim` object for longitude} -\item{verbose}{} +\item{verbose}{logical: ask`ncdf4` functions to be very chatty while they work?} } \value{ -List of NetCDF variables in data. Creates NetCDF file containing +List of NetCDF variables in data. Creates NetCDF file containing data as a side effect } \description{ diff --git a/modules/data.atmosphere/man/process_gridded_noaa_download.Rd b/modules/data.atmosphere/man/process_gridded_noaa_download.Rd new file mode 100644 index 00000000000..ca4a99fe23c --- /dev/null +++ b/modules/data.atmosphere/man/process_gridded_noaa_download.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/GEFS_helper_functions.R +\name{process_gridded_noaa_download} +\alias{process_gridded_noaa_download} +\title{Extract and temporally downscale points from downloaded grid files} +\usage{ +process_gridded_noaa_download( + lat_list, + lon_list, + site_id, + downscale, + overwrite, + forecast_date, + forecast_time, + model_name, + model_name_ds, + model_name_raw, + output_directory +) +} +\arguments{ +\item{lat_list}{lat for site} + +\item{lon_list}{lon for site} + +\item{site_id}{Unique site_id for file creation} + +\item{downscale}{Logical. Default is TRUE. Downscales from 6hr to hourly} + +\item{overwrite}{Logical. Default is FALSE. Should exisiting files be overwritten} + +\item{forecast_date}{Date for download} + +\item{forecast_time}{Time (0,6,12,18) for start of download} + +\item{model_name}{Name of model for file name} + +\item{model_name_ds}{Name of downscale file name} + +\item{model_name_raw}{Name of raw file name} + +\item{output_directory}{Output directory} +} +\value{ +List +} +\description{ +Extract and temporally downscale points from downloaded grid files +} diff --git a/modules/data.atmosphere/man/read_narr_var.Rd b/modules/data.atmosphere/man/read_narr_var.Rd index 59e0c16002a..7307aa7028f 100644 --- a/modules/data.atmosphere/man/read_narr_var.Rd +++ b/modules/data.atmosphere/man/read_narr_var.Rd @@ -15,7 +15,7 @@ read_narr_var(nc, xy, variable, unit, flx, pb = NULL) \item{unit}{Output unit of variable to retrieve} -\item{flx}{(Logical) If `TRUE`, format for `flx` variables. Otherwise, +\item{flx}{(Logical) If `TRUE`, format for `flx` variables. Otherwise, format for `sfc` variables. See [narr_flx_vars].} \item{pb}{Progress bar R6 object (default = `NULL`)} diff --git a/modules/data.atmosphere/man/save.betas.Rd b/modules/data.atmosphere/man/save.betas.Rd index 0a8e50bbdd1..93f8d0a2d50 100644 --- a/modules/data.atmosphere/man/save.betas.Rd +++ b/modules/data.atmosphere/man/save.betas.Rd @@ -22,12 +22,15 @@ TDM Save Betas Saves betas that are calculated during gen.subdaily.models() } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{lm_ensemble_sims}}, - \code{\link{model.train}}, \code{\link{nc.merge}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.model}}, \code{\link{subdaily_pred}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{lm_ensemble_sims}()}, +\code{\link{model.train}()}, +\code{\link{nc.merge}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.model}()}, +\code{\link{subdaily_pred}()}, +\code{\link{temporal.downscale.functions}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/save.model.Rd b/modules/data.atmosphere/man/save.model.Rd index 87008e0e97e..362f50df83e 100644 --- a/modules/data.atmosphere/man/save.model.Rd +++ b/modules/data.atmosphere/man/save.model.Rd @@ -22,12 +22,15 @@ TDM Save Models Saves models that are created during gen.subdaily.models() } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{lm_ensemble_sims}}, - \code{\link{model.train}}, \code{\link{nc.merge}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.betas}}, \code{\link{subdaily_pred}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{lm_ensemble_sims}()}, +\code{\link{model.train}()}, +\code{\link{nc.merge}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.betas}()}, +\code{\link{subdaily_pred}()}, +\code{\link{temporal.downscale.functions}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/spin.met.Rd b/modules/data.atmosphere/man/spin.met.Rd index b85997a356e..4e2afa9a7e5 100644 --- a/modules/data.atmosphere/man/spin.met.Rd +++ b/modules/data.atmosphere/man/spin.met.Rd @@ -4,9 +4,17 @@ \alias{spin.met} \title{Spin-up meteorology} \usage{ -spin.met(in.path, in.prefix, start_date, end_date, nyear = 1000, - nsample = 50, resample = TRUE, run_start_date = start_date, - overwrite = TRUE) +spin.met( + in.path, + in.prefix, + start_date, + end_date, + nyear = 1000, + nsample = 50, + resample = TRUE, + run_start_date = start_date, + overwrite = TRUE +) } \arguments{ \item{in.path}{met input folder path} diff --git a/modules/data.atmosphere/man/split_wind.Rd b/modules/data.atmosphere/man/split_wind.Rd index 9155c63e568..21482185528 100644 --- a/modules/data.atmosphere/man/split_wind.Rd +++ b/modules/data.atmosphere/man/split_wind.Rd @@ -4,8 +4,15 @@ \alias{split_wind} \title{Split wind_speed into eastward_wind and northward_wind} \usage{ -split_wind(in.path, in.prefix, start_date, end_date, overwrite = FALSE, - verbose = FALSE, ...) +split_wind( + in.path, + in.prefix, + start_date, + end_date, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{in.path}{path to original data} @@ -22,6 +29,9 @@ split_wind(in.path, in.prefix, start_date, end_date, overwrite = FALSE, \item{...}{other arguments, currently ignored} } +\value{ +nothing. TODO: Return data frame summarizing results +} \description{ Split wind_speed into eastward_wind and northward_wind } diff --git a/modules/data.atmosphere/man/subdaily_pred.Rd b/modules/data.atmosphere/man/subdaily_pred.Rd index 28e7c6fec40..56fc41958ae 100644 --- a/modules/data.atmosphere/man/subdaily_pred.Rd +++ b/modules/data.atmosphere/man/subdaily_pred.Rd @@ -4,8 +4,15 @@ \alias{subdaily_pred} \title{subdaily_pred} \usage{ -subdaily_pred(newdata, model.predict, Rbeta, resid.err = FALSE, - model.resid = NULL, Rbeta.resid = NULL, n.ens) +subdaily_pred( + newdata, + model.predict, + Rbeta, + resid.err = FALSE, + model.resid = NULL, + Rbeta.resid = NULL, + n.ens +) } \arguments{ \item{newdata}{dataframe with data to be downscaled} @@ -33,12 +40,15 @@ Subdaily Prediction Pulls information from linear regression models to predict subdaily meteorology } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{lm_ensemble_sims}}, - \code{\link{model.train}}, \code{\link{nc.merge}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.betas}}, \code{\link{save.model}}, - \code{\link{temporal.downscale.functions}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{lm_ensemble_sims}()}, +\code{\link{model.train}()}, +\code{\link{nc.merge}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.betas}()}, +\code{\link{save.model}()}, +\code{\link{temporal.downscale.functions}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/temporal.downscale.functions.Rd b/modules/data.atmosphere/man/temporal.downscale.functions.Rd index e22868fefa1..77e86d6c3a7 100644 --- a/modules/data.atmosphere/man/temporal.downscale.functions.Rd +++ b/modules/data.atmosphere/man/temporal.downscale.functions.Rd @@ -4,10 +4,18 @@ \alias{temporal.downscale.functions} \title{temporal_downscale_functions} \usage{ -temporal.downscale.functions(dat.train, n.beta, day.window, - resids = FALSE, parallel = FALSE, n.cores = NULL, - seed = format(Sys.time(), "\%m\%d"), outfolder, - print.progress = FALSE, ...) +temporal.downscale.functions( + dat.train, + n.beta, + day.window, + resids = FALSE, + parallel = FALSE, + n.cores = NULL, + seed = format(Sys.time(), "\%m\%d"), + outfolder, + print.progress = FALSE, + ... +) } \arguments{ \item{dat.train}{- training data generated by tdm_nc2dat.train.R} @@ -45,12 +53,15 @@ Temporal Downscale Functions Met variable functions that are called in gen.subdaily.models and predict.subdaily.workflow } \seealso{ -Other tdm - Temporally Downscale Meteorology: \code{\link{gen.subdaily.models}}, - \code{\link{lm_ensemble_sims}}, - \code{\link{model.train}}, \code{\link{nc.merge}}, - \code{\link{predict_subdaily_met}}, - \code{\link{save.betas}}, \code{\link{save.model}}, - \code{\link{subdaily_pred}} +Other tdm - Temporally Downscale Meteorology: +\code{\link{gen.subdaily.models}()}, +\code{\link{lm_ensemble_sims}()}, +\code{\link{model.train}()}, +\code{\link{nc.merge}()}, +\code{\link{predict_subdaily_met}()}, +\code{\link{save.betas}()}, +\code{\link{save.model}()}, +\code{\link{subdaily_pred}()} } \author{ Christy Rollinson, James Simkins diff --git a/modules/data.atmosphere/man/temporal_downscale.Rd b/modules/data.atmosphere/man/temporal_downscale.Rd new file mode 100644 index 00000000000..00ed7050b05 --- /dev/null +++ b/modules/data.atmosphere/man/temporal_downscale.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/GEFS_helper_functions.R +\name{temporal_downscale} +\alias{temporal_downscale} +\title{Downscale NOAA GEFS from 6hr to 1hr} +\usage{ +temporal_downscale(input_file, output_file, overwrite = TRUE, hr = 1) +} +\arguments{ +\item{input_file, }{full path to 6hr file} + +\item{output_file, }{full path to 1hr file that will be generated} + +\item{overwrite, }{logical stating to overwrite any existing output_file} + +\item{hr}{time step in hours of temporal downscaling (default = 1)} +} +\value{ +None +} +\description{ +Downscale NOAA GEFS from 6hr to 1hr +} +\author{ +Quinn Thomas +} diff --git a/modules/data.atmosphere/man/upscale_met.Rd b/modules/data.atmosphere/man/upscale_met.Rd index 15b445e7a1b..0b89d999190 100644 --- a/modules/data.atmosphere/man/upscale_met.Rd +++ b/modules/data.atmosphere/man/upscale_met.Rd @@ -4,8 +4,14 @@ \alias{upscale_met} \title{upscale_met} \usage{ -upscale_met(outfolder, input_met, resolution = 1/24, overwrite = FALSE, - verbose = FALSE, ...) +upscale_met( + outfolder, + input_met, + resolution = 1/24, + overwrite = FALSE, + verbose = FALSE, + ... +) } \arguments{ \item{outfolder}{path to directory where output should be saved diff --git a/modules/data.atmosphere/man/write_noaa_gefs_netcdf.Rd b/modules/data.atmosphere/man/write_noaa_gefs_netcdf.Rd new file mode 100644 index 00000000000..dd8c10ca76e --- /dev/null +++ b/modules/data.atmosphere/man/write_noaa_gefs_netcdf.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/GEFS_helper_functions.R +\name{write_noaa_gefs_netcdf} +\alias{write_noaa_gefs_netcdf} +\title{Write NOAA GEFS netCDF} +\usage{ +write_noaa_gefs_netcdf( + df, + ens = NA, + lat, + lon, + cf_units, + output_file, + overwrite +) +} +\arguments{ +\item{df}{data frame of meterological variables to be written to netcdf. Columns +must start with time with the following columns in the order of `cf_units`} + +\item{ens}{ensemble index used for subsetting df} + +\item{lat}{latitude in degree north} + +\item{lon}{longitude in degree east} + +\item{cf_units}{vector of variable names in order they appear in df} + +\item{output_file}{name, with full path, of the netcdf file that is generated} + +\item{overwrite}{logical to overwrite existing netcdf file} +} +\value{ +NA +} +\description{ +Write NOAA GEFS netCDF +} +\author{ +Quinn Thomas +} diff --git a/modules/data.atmosphere/tests/Rcheck_reference.log b/modules/data.atmosphere/tests/Rcheck_reference.log new file mode 100644 index 00000000000..87a244351d5 --- /dev/null +++ b/modules/data.atmosphere/tests/Rcheck_reference.log @@ -0,0 +1,441 @@ +* using log directory ‘/tmp/Rtmp02RC5y/PEcAn.data.atmosphere.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.data.atmosphere/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.data.atmosphere’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... NOTE +Imports includes 37 non-default packages. +Importing from so many packages makes the package vulnerable to any of +them becoming unavailable. Move as many as possible to Suggests and +use conditionally. +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.data.atmosphere’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... OK +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... WARNING +Found the following file with non-ASCII characters: + download.PalEON.R +Portable packages must use only ASCII characters in their R code, +except perhaps in comments. +Use \uxxxx escapes for other characters. +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'library' or 'require' calls not declared from: + ‘MASS’ ‘mgcv’ +'library' or 'require' calls in package code: + ‘MASS’ ‘mgcv’ + Please use :: or requireNamespace() instead. + See section 'Suggested packages' in the 'Writing R Extensions' manual. +Package in Depends field not imported from: ‘methods’ + These packages need to be imported from (in the NAMESPACE file) + for when this namespace is loaded but not attached. +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +cfmet.downscale.daily: no visible binding for global variable ‘doy’ +cfmet.downscale.daily: no visible binding for global variable ‘I.dir’ +cfmet.downscale.daily: no visible binding for global variable ‘I.diff’ +cfmet.downscale.daily: no visible binding for global variable ‘Itot’ +cfmet.downscale.daily: no visible binding for global variable ‘year’ +cfmet.downscale.daily: no visible binding for global variable + ‘surface_downwelling_shortwave_flux_in_air’ +cfmet.downscale.daily: no visible binding for global variable ‘tmin’ +cfmet.downscale.daily: no visible binding for global variable ‘tmax’ +cfmet.downscale.daily: no visible binding for global variable + ‘relative_humidity’ +cfmet.downscale.daily: no visible binding for global variable + ‘air_pressure’ +cfmet.downscale.daily: no visible binding for global variable + ‘air_temperature’ +cfmet.downscale.daily: no visible binding for global variable ‘qmin’ +cfmet.downscale.daily: no visible binding for global variable ‘qmax’ +cfmet.downscale.daily: no visible binding for global variable + ‘pressure’ +cfmet.downscale.daily: no visible binding for global variable ‘rhmin’ +cfmet.downscale.daily: no visible binding for global variable ‘rhmax’ +cfmet.downscale.subdaily: no visible binding for global variable ‘year’ +cfmet.downscale.subdaily: no visible binding for global variable + ‘month’ +cfmet.downscale.subdaily: no visible binding for global variable ‘day’ +cfmet.downscale.subdaily: no visible binding for global variable ‘hour’ +check_unit: no visible binding for global variable ‘cf_standard_name’ +debias.met.regression: no visible global function definition for ‘sd’ +debias.met.regression: no visible global function definition for + ‘aggregate’ +debias.met.regression: no visible global function definition for + ‘predict’ +debias.met.regression: no visible global function definition for + ‘resid’ +debias.met.regression: no visible global function definition for ‘lm’ +debias.met.regression: no visible global function definition for ‘coef’ +debias.met.regression: no visible global function definition for ‘vcov’ +debias.met.regression: no visible global function definition for + ‘terms’ +debias.met.regression: no visible global function definition for + ‘model.frame’ +debias.met.regression: no visible global function definition for + ‘model.matrix’ +debias.met.regression : : no visible global function + definition for ‘sd’ +debias.met.regression: no visible global function definition for + ‘rnorm’ +debias.met.regression: no visible global function definition for + ‘quantile’ +debias.met.regression: no visible binding for global variable + ‘quantile’ +debias.met.regression: no visible binding for global variable ‘Date’ +debias.met.regression: no visible binding for global variable ‘lwr’ +debias.met.regression: no visible binding for global variable ‘upr’ +debias.met.regression: no visible binding for global variable ‘obs’ +debias.met.regression: no visible binding for global variable ‘values’ +debias.met.regression: no visible binding for global variable ‘Year’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘timestamp’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘NOAA.member’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘surface_downwelling_longwave_flux_in_air’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘surface_downwelling_shortwave_flux_in_air’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘specific_humidity’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘air_temperature’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘precipitation_flux’ +download.NOAA_GEFS_downscale: no visible binding for global variable + ‘wind_speed’ +download.US_Syv: no visible global function definition for ‘read.csv’ +download.US_Wlef: no visible global function definition for + ‘read.table’ +downscale_repeat_6hr_to_hrly: no visible binding for global variable + ‘timestamp’ +downscale_ShortWave_to_hrly : downscale_solar_geom: no visible global + function definition for ‘median’ +downscale_ShortWave_to_hrly: no visible binding for global variable + ‘timestamp’ +downscale_ShortWave_to_hrly: no visible binding for global variable + ‘NOAA.member’ +downscale_spline_to_hourly : interpolate: no visible global function + definition for ‘splinefun’ +downscale_spline_to_hourly: no visible binding for global variable ‘.’ +downscale_spline_to_hourly: no visible binding for global variable + ‘NOAA.member’ +downscale_spline_to_hourly: no visible binding for global variable + ‘dscale.member’ +downscale_spline_to_hourly: no visible global function definition for + ‘:=’ +extract.local.CMIP5: no visible binding for global variable ‘GCM’ +extract.nc.ERA5 : : no visible global function definition + for ‘setNames’ +extract.nc.ERA5: no visible global function definition for ‘setNames’ +extract.nc.ERA5 : : no visible binding for global variable + ‘.’ +get_NARR_thredds: no visible binding for global variable ‘latitude’ +get_NARR_thredds: no visible binding for global variable ‘longitude’ +get_narr_url: no visible binding for global variable ‘NARR_name’ +get.cruncep: no visible binding for global variable ‘Lat’ +get.cruncep: no visible binding for global variable ‘lati’ +get.cruncep: no visible global function definition for + ‘cruncep_dt2weather’ +get.rh: no visible binding for global variable ‘L’ +get.rh: no visible binding for global variable ‘Rw’ +get.weather: no visible global function definition for + ‘cruncep_dt2weather’ +is.land: no visible binding for global variable ‘met.nc’ +lm_ensemble_sims: no visible global function definition for ‘quantile’ +lm_ensemble_sims: no visible binding for global variable ‘mod.save’ +lm_ensemble_sims: no visible global function definition for ‘sd’ +load.cfmet: no visible binding for global variable ‘index’ +load.cfmet: no visible binding for global variable ‘mstmip_vars’ +met_temporal_downscale.Gaussian_ensemble: no visible global function + definition for ‘sd’ +met_temporal_downscale.Gaussian_ensemble: no visible global function + definition for ‘rnorm’ +met_temporal_downscale.Gaussian_ensemble: no visible binding for global + variable ‘temp_max’ +met_temporal_downscale.Gaussian_ensemble: no visible binding for global + variable ‘temp_min’ +met.process: no visible global function definition for ‘get.id’ +met.process: no visible binding for global variable ‘site_id’ +met.process: no visible binding for global variable ‘format_id’ +met.process: no visible binding for global variable ‘name’ +met.process: no visible binding for global variable ‘machine_id’ +met2CF.FACE: no visible binding for global variable ‘x’ +metgapfill: possible error in + round(as.POSIXlt(udunits2::ud.convert(time, tunit$value, + paste("seconds since", origin)), origin = origin, tz = "UTC"), units + = "mins"): unused argument (units = "mins") +metgapfill.NOAA_GEFS: no visible global function definition for + ‘na.omit’ +metgapfill.NOAA_GEFS: no visible global function definition for ‘lm’ +metgapfill.NOAA_GEFS: no visible global function definition for + ‘predict’ +model.train: no visible global function definition for ‘lm’ +model.train: no visible global function definition for ‘coef’ +model.train: no visible global function definition for ‘vcov’ +model.train: no visible global function definition for ‘resid’ +subdaily_pred: no visible global function definition for ‘model.matrix’ +Undefined global functions or variables: + := . .attrs aggregate air_pressure air_temperature avg.rpot + canonical_units CF_name cf_standard_name coef cruncep_dt2weather data + Date day days description dhours doy dscale.member flx format_id GCM + get.id hour I.diff I.dir index is_required Itot L Lat lati latitude + lm longitude lwr machine_id median met.nc mod.save model.frame + model.matrix month mstmip_vars na.omit name NARR_name NOAA.member obs + precipitation_flux predict pressure qmax qmin quantile read.csv + read.table relative_humidity resid rhmax rhmin rnorm rpot Rw sd + setNames site_id specific_humidity splinefun startdate + surface_downwelling_longwave_flux_in_air + surface_downwelling_shortwave_flux_in_air temp_max temp_min terms + test_passed test_raw timestamp tmax tmin upr values vcov wind_speed x + year Year +Consider adding + importFrom("datasets", "pressure") + importFrom("stats", "aggregate", "coef", "lm", "median", "model.frame", + "model.matrix", "na.omit", "predict", "quantile", "resid", + "rnorm", "sd", "setNames", "splinefun", "terms", "vcov") + importFrom("utils", "data", "read.csv", "read.table", "timestamp") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... NOTE + +Rd file 'download.NOAA_GEFS.Rd': + \examples lines wider than 100 characters: + download.NOAA_GEFS(outfolder="~/Working/results", lat.in= 45.805925, lon.in = -90.07961, sitename="US-WCr") + +Rd file 'download.NOAA_GEFS_downscale.Rd': + \examples lines wider than 100 characters: + download.NOAA_GEFS(outfolder="~/Working/results", lat.in= 45.805925, lon.in = -90.07961, sitename="US-WCr") + +These lines will be truncated in the PDF manual. +* checking Rd cross-references ... WARNING +Missing link or links in documentation object 'extract.nc.ERA5.Rd': + ‘https://confluence.ecmwf.int/display/CKB/ERA5+data+documentation#ERA5datadocumentation-Spatialgrid’ + +See section 'Cross-references' in the 'Writing R Extensions' manual. + +* checking for missing documentation entries ... WARNING +Undocumented data sets: + ‘cruncep_landmask’ ‘FLUXNET.sitemap’ ‘cruncep’ ‘ebifarm’ ‘narr’ + ‘narr3h’ ‘landmask’ ‘Lat’ ‘Lon’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'cfmet.downscale.time' + ‘lat’ ‘...’ + +Undocumented arguments in documentation object 'closest_xy' + ‘slat’ ‘slon’ ‘infolder’ ‘infile’ + +Undocumented arguments in documentation object 'daygroup' + ‘date’ ‘flx’ + +Undocumented arguments in documentation object 'debias_met' + ‘outfolder’ ‘site_id’ ‘...’ + +Undocumented arguments in documentation object 'download.Ameriflux' + ‘...’ + +Undocumented arguments in documentation object 'download.AmerifluxLBL' + ‘...’ + +Undocumented arguments in documentation object 'download.FACE' + ‘sitename’ ‘outfolder’ ‘start_date’ ‘end_date’ ‘overwrite’ ‘...’ + +Undocumented arguments in documentation object 'download.Fluxnet2015' + ‘username’ ‘...’ + +Undocumented arguments in documentation object 'download.FluxnetLaThuile' + ‘...’ + +Undocumented arguments in documentation object 'download.GFDL' + ‘...’ + +Undocumented arguments in documentation object 'download.GLDAS' + ‘outfolder’ ‘start_date’ ‘end_date’ ‘site_id’ ‘lat.in’ ‘overwrite’ + ‘verbose’ ‘...’ + +Undocumented arguments in documentation object 'download.MACA' + ‘outfolder’ ‘site_id’ ‘lat.in’ ‘lon.in’ ‘overwrite’ ‘verbose’ ‘...’ + +Undocumented arguments in documentation object 'download.MsTMIP_NARR' + ‘outfolder’ ‘site_id’ ‘lat.in’ ‘lon.in’ ‘overwrite’ ‘verbose’ ‘...’ + +Undocumented arguments in documentation object 'download.NARR' + ‘outfolder’ ‘start_date’ ‘end_date’ ‘...’ + +Undocumented arguments in documentation object 'download.NARR_site' + ‘progress’ ‘...’ + +Undocumented arguments in documentation object 'download.NEONmet' + ‘...’ + +Undocumented arguments in documentation object 'download.NLDAS' + ‘outfolder’ ‘start_date’ ‘end_date’ ‘site_id’ ‘lat.in’ ‘lon.in’ + ‘overwrite’ ‘verbose’ ‘...’ + +Undocumented arguments in documentation object 'download.NOAA_GEFS' + ‘lat.in’ ‘lon.in’ ‘end_date’ + +Undocumented arguments in documentation object 'download.NOAA_GEFS_downscale' + ‘lat.in’ ‘lon.in’ ‘end_date’ + +Undocumented arguments in documentation object 'download.PalEON' + ‘sitename’ ‘outfolder’ ‘start_date’ ‘overwrite’ ‘...’ + +Undocumented arguments in documentation object 'download.PalEON_ENS' + ‘sitename’ ‘outfolder’ ‘start_date’ ‘overwrite’ ‘...’ + +Undocumented arguments in documentation object 'extract.nc.ERA5' + ‘...’ + +Undocumented arguments in documentation object 'extract.nc' + ‘...’ + +Undocumented arguments in documentation object 'get.ncvector' + ‘var’ ‘lati’ ‘loni’ ‘run.dates’ + +Undocumented arguments in documentation object 'lm_ensemble_sims' + ‘lags.list’ + +Undocumented arguments in documentation object 'met.process' + ‘browndog’ + +Undocumented arguments in documentation object 'met.process.stage' + ‘input.id’ ‘raw.id’ + +Undocumented arguments in documentation object 'met2CF.ALMA' + ‘verbose’ + +Undocumented arguments in documentation object 'met2CF.Ameriflux' + ‘...’ + +Undocumented arguments in documentation object 'met2CF.AmerifluxLBL' + ‘...’ + +Undocumented arguments in documentation object 'met2CF.FACE' + ‘in.path’ ‘in.prefix’ ‘outfolder’ ‘start_date’ ‘end_date’ ‘input.id’ + ‘site’ ‘format’ ‘...’ + +Undocumented arguments in documentation object 'met2CF.NARR' + ‘in.path’ ‘in.prefix’ ‘outfolder’ ‘...’ + +Undocumented arguments in documentation object 'met2CF.PalEON' + ‘lat’ ‘lon’ ‘verbose’ ‘...’ + +Undocumented arguments in documentation object 'met2CF.PalEONregional' + ‘verbose’ ‘...’ +Duplicated \argument entries in documentation object 'met2CF.PalEONregional': + ‘in.path’ ‘in.prefix’ ‘outfolder’ ‘start_date’ ‘end_date’ ‘overwrite’ + +Undocumented arguments in documentation object 'met2CF.csv' + ‘in.path’ ‘in.prefix’ ‘outfolder’ ‘start_date’ ‘end_date’ ‘lat’ ‘lon’ + ‘overwrite’ ‘...’ + +Undocumented arguments in documentation object 'met_temporal_downscale.Gaussian_ensemble' + ‘outfolder’ ‘site_id’ ‘...’ + +Undocumented arguments in documentation object 'metgapfill.NOAA_GEFS' + ‘...’ + +Undocumented arguments in documentation object 'metgapfill' + ‘...’ + +Undocumented arguments in documentation object 'model.train' + ‘v’ ‘...’ + +Undocumented arguments in documentation object 'nc.merge' + ‘...’ + +Undocumented arguments in documentation object 'permute.nc' + ‘...’ + +Undocumented arguments in documentation object 'predict_subdaily_met' + ‘...’ + +Undocumented arguments in documentation object 'site.lst' + ‘site.id’ ‘con’ + +Undocumented arguments in documentation object 'site_from_tag' + ‘sitename’ ‘tag’ + +Undocumented arguments in documentation object 'temporal.downscale.functions' + ‘...’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'download.GLDAS': + ‘lon.in’ + +Argument items with no description in Rd object 'download.PalEON': + ‘end_date’ + +Argument items with no description in Rd object 'download.PalEON_ENS': + ‘end_date’ + +Argument items with no description in Rd object 'gen.subdaily.models': + ‘in.prefix’ + +Argument items with no description in Rd object 'merge_met_variable': + ‘start_date’ ‘end_date’ ‘...’ + +Argument items with no description in Rd object 'met.process.stage': + ‘raw.id’ + +Argument items with no description in Rd object 'met_temporal_downscale.Gaussian_ensemble': + ‘in.path’ ‘in.prefix’ + +Argument items with no description in Rd object 'split_wind': + ‘start_date’ ‘end_date’ + +* checking for unstated dependencies in examples ... OK +* checking contents of ‘data’ directory ... OK +* checking data for non-ASCII characters ... OK +* checking data for ASCII and uncompressed saves ... WARNING + + Note: significantly better compression could be obtained + by using R CMD build --resave-data + old_size new_size compress + cruncep_landmask.RData 39Kb 9Kb xz + narr_cruncep_ebifarm.RData 790Kb 595Kb xz +* checking files in ‘vignettes’ ... WARNING +Files in the 'vignettes' directory but no files in 'inst/doc': + ‘ameriflux_demo.Rmd’, ‘cfmet_downscaling.Rmd’, + ‘compare_narr_cruncep_met.Rmd’, ‘tdm_downscaling.Rmd’ +Package has no Sweave vignette sources and no VignetteBuilder field. +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 8 WARNINGs, 2 NOTEs diff --git a/modules/data.atmosphere/tests/testthat/helper.R b/modules/data.atmosphere/tests/testthat/helper.R index 3a014c85f35..deba7cbdd0c 100644 --- a/modules/data.atmosphere/tests/testthat/helper.R +++ b/modules/data.atmosphere/tests/testthat/helper.R @@ -9,7 +9,6 @@ #' @param ... other arguments passed on to \code{\link[testthat]{expect_match}} #' @examples #' expect_log(PEcAn.logger::logger.debug("test"), "DEBUG.*test") -#' expect_log(PEcAn.utils::get.model.output(), "update your workflow") #' expect_log(cat("Hello", file = stderr()), "Hello") #' # Only messages on stderr are recognized #' expect_failure(expect_log("Hello", "Hello")) diff --git a/modules/data.atmosphere/tests/testthat/test.cf-downscaling.R b/modules/data.atmosphere/tests/testthat/test.cf-downscaling.R index 1dd969d34c0..2d3d34be2f7 100644 --- a/modules/data.atmosphere/tests/testthat/test.cf-downscaling.R +++ b/modules/data.atmosphere/tests/testthat/test.cf-downscaling.R @@ -1,7 +1,7 @@ context("downscaling") daily.nc <- ncdf4::nc_open("data/urbana_daily_test.nc") -on.exit(ncdf4::nc_close(daily.nc)) +on.exit(ncdf4::nc_close(daily.nc), add = TRUE) daily.cf <- load.cfmet(met.nc = daily.nc, lat = 39.75, lon = -87.25, start.date = "1951-01-02", end.date = "1951-05-31") diff --git a/modules/data.atmosphere/tests/testthat/test.download.CRUNCEP.R b/modules/data.atmosphere/tests/testthat/test.download.CRUNCEP.R index 7af4374e214..4e5e1dd456c 100644 --- a/modules/data.atmosphere/tests/testthat/test.download.CRUNCEP.R +++ b/modules/data.atmosphere/tests/testthat/test.download.CRUNCEP.R @@ -6,14 +6,13 @@ teardown(unlink(tmpdir, recursive = TRUE)) test_that("download works and returns a valid CF file", { # download is slow and was causing lots of Travis timeouts - skip_on_travis() + skip_on_ci() PEcAn.logger::logger.setLevel("WARN") result <- download.CRUNCEP(outfolder = tmpdir, start_date = "2000-01-01", end_date = "2000-12-31", - site_id = 753, lat.in = 40, lon.in = -88) cf <- ncdf4::nc_open(result$file) @@ -28,7 +27,6 @@ test_that("download works and returns a valid CF file", { outfolder = tmpdir, start_date = "2000-01-01", end_date = "2000-12-31", - site_id = 753, lat.in = 40, lon.in = -88, overwrite = FALSE), diff --git a/modules/data.atmosphere/tests/testthat/test.download.GFDLR.R b/modules/data.atmosphere/tests/testthat/test.download.GFDLR.R index 9ccce6172ad..320e9ffb058 100644 --- a/modules/data.atmosphere/tests/testthat/test.download.GFDLR.R +++ b/modules/data.atmosphere/tests/testthat/test.download.GFDLR.R @@ -5,7 +5,7 @@ dir.create(tmpdir, showWarnings = FALSE) teardown(unlink(tmpdir, recursive = TRUE)) test_that("GFDL server is reachable", { - skip_on_travis() + skip_on_ci() test_url <- paste0("http://nomads.gfdl.noaa.gov:9192/opendap/", "CMIP5/output1/NOAA-GFDL/GFDL-CM3/rcp45/3hr/", @@ -23,7 +23,7 @@ test_that("GFDL server is reachable", { test_that("download works and returns a valid CF file", { # Download is too slow for Travis -- please run locally before committing! - skip_on_travis() + skip_on_ci() PEcAn.logger::logger.setLevel("WARN") diff --git a/modules/data.atmosphere/tests/testthat/test.download.ICOS.R b/modules/data.atmosphere/tests/testthat/test.download.ICOS.R new file mode 100644 index 00000000000..945d59117f4 --- /dev/null +++ b/modules/data.atmosphere/tests/testthat/test.download.ICOS.R @@ -0,0 +1,25 @@ +context("Download ICOS data products") + +outfolder <- tempdir() +setup(dir.create(outfolder, showWarnings = FALSE, recursive = TRUE)) +teardown(unlink(outfolder, recursive = TRUE)) + +test_that("ICOS Drought 2018 download works", { + start_date <- "2016-01-01" + end_date <- "2017-01-01" + sitename <- "FI-Sii" + res <- httr::GET("https://meta.icos-cp.eu/objects/a8OW2wWfAYqZrj31S8viVLUS") + expect_equal(200, res$status_code) + dat <- download.ICOS(sitename, outfolder, start_date, end_date, "Drought2018", overwrite = TRUE) + expect_true(file.exists(dat$file)) +}) + +test_that("ICOS ETC download works", { + start_date <- "2019-01-01" + end_date <- "2020-01-01" + sitename <- "FI-Sii" + res <- httr::GET("https://meta.icos-cp.eu/objects/NEt3tFUV47QdjvJ-rgKgaiTE") + expect_equal(200, res$status_code) + dat <- download.ICOS(sitename, outfolder, start_date, end_date, "ETC", overwrite = TRUE) + expect_true(file.exists(dat$file)) +}) \ No newline at end of file diff --git a/modules/data.atmosphere/tests/testthat/test.download.MERRA.R b/modules/data.atmosphere/tests/testthat/test.download.MERRA.R new file mode 100644 index 00000000000..0c264231b91 --- /dev/null +++ b/modules/data.atmosphere/tests/testthat/test.download.MERRA.R @@ -0,0 +1,26 @@ +context("Download MERRA") + +outdir <- tempdir() +setup(dir.create(outdir, showWarnings = FALSE, recursive = TRUE)) +teardown(unlink(outdir, recursive = TRUE)) + +test_that("MERRA download works", { + start_date <- "2009-06-01" + end_date <- "2009-06-04" + dat <- download.MERRA(outdir, start_date, end_date, + lat.in = 45.3, lon.in = -85.3, overwrite = TRUE) + expect_true(file.exists(dat$file[[1]])) + nc <- ncdf4::nc_open(dat$file[[1]]) + on.exit(ncdf4::nc_close(nc), add = TRUE) + expect_timeseq <- seq(lubridate::as_datetime(start_date), + lubridate::as_datetime(paste(end_date, "23:59:59")), + by = "1 hour", tz = "UTC") + time <- lubridate::as_datetime("2009-01-01") + + as.difftime(ncdf4::ncvar_get(nc, "time"), units = "days") + expect_equal(time, expect_timeseq) + temp_k <- ncdf4::ncvar_get(nc, "air_temperature") + # June temperatures here should always be greater than 0 degC + expect_true(all(temp_k > 273.15)) + # ...and temperatures anywhere should be less than 60 degC + expect_true(all(temp_k < 323.15)) +}) diff --git a/modules/data.atmosphere/tests/testthat/test.download.NARR.R b/modules/data.atmosphere/tests/testthat/test.download.NARR.R index 956353efcb0..f8e488d4cf7 100644 --- a/modules/data.atmosphere/tests/testthat/test.download.NARR.R +++ b/modules/data.atmosphere/tests/testthat/test.download.NARR.R @@ -19,7 +19,7 @@ ncdf4::nc_close(test_nc) test_that("NARR download works as expected", { # Download is too slow for travis # Please run locally to test! - skip_on_travis() + skip_on_ci() r <- download.NARR_site(outfolder, start_date, end_date, lat.in, lon.in, progress = TRUE, parallel = TRUE, ncores = 2) diff --git a/modules/data.atmosphere/tests/testthat/test.load.cfmet.R b/modules/data.atmosphere/tests/testthat/test.load.cfmet.R index 3caf4d53f3f..42281fcb903 100644 --- a/modules/data.atmosphere/tests/testthat/test.load.cfmet.R +++ b/modules/data.atmosphere/tests/testthat/test.load.cfmet.R @@ -6,11 +6,11 @@ daily_file <- "data/urbana_daily_test.nc" subdaily_file <- "data/urbana_subdaily_test.nc" daily.nc <- ncdf4::nc_open(daily_file) -on.exit(ncdf4::nc_close(daily.nc)) +on.exit(ncdf4::nc_close(daily.nc), add = TRUE) daily.cf <- load.cfmet(met.nc = daily.nc, lat = 39.75, lon = -87.25, start.date = "1951-01-02", end.date = "1951-05-31") subdaily.nc <- ncdf4::nc_open(subdaily_file) -on.exit(ncdf4::nc_close(subdaily.nc), add=TRUE) +on.exit(ncdf4::nc_close(subdaily.nc), add = TRUE) test_that("data extracted from test pecan-cf met files is valid",{ expect_is(daily.cf, "data.frame") diff --git a/modules/data.atmosphere/tests/testthat/test.metutils.R b/modules/data.atmosphere/tests/testthat/test.metutils.R index a2758dc0911..2e56e57e8db 100644 --- a/modules/data.atmosphere/tests/testthat/test.metutils.R +++ b/modules/data.atmosphere/tests/testthat/test.metutils.R @@ -8,5 +8,27 @@ test_that("sw2par, par2ppfd, sw2ppfd are consistent ",{ }) test_that("qair2rh is consistent",{ -# qair2rh(qair = 1, temp = 10, press = 1013.25) + expect_equal(qair2rh(qair = 1, temp = 10, press = 1013.25), 1) }) + +test_that("get.rh RH from dewpoint",{ + # air temp fixed at 15C + getrhtest <- function(T_Test, Td_test){ + testrh <- get.rh(T = 273.15 + T_Test, + Td = 273.15 + Td_test) + return(testrh) + } + # air T = dewpoint + expect_equal(getrhtest(15, 15), 100) + # air T < dewpoint + expect_equal(getrhtest(15, 20), 100) + # air T > dewpoint + # compared to values at NOAA calculator + # https://www.wpc.ncep.noaa.gov/html/dewrh.shtml + expect_equal(getrhtest(15, 12.5), 85.02, tolerance = 0.2) + expect_equal(getrhtest(15, 4.6), 49.8, tolerance = 0.2) + expect_equal(getrhtest(15, 0), 35.88, tolerance = 0.2) + expect_equal(getrhtest(25, 10), 38.82, tolerance = 0.2) + expect_equal(getrhtest(0, -5), 69, tolerance = 0.2) +}) + diff --git a/modules/data.hydrology/DESCRIPTION b/modules/data.hydrology/DESCRIPTION index 17541bec204..8c39115f71b 100644 --- a/modules/data.hydrology/DESCRIPTION +++ b/modules/data.hydrology/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAn.data.hydrology Type: Package Title: PEcAn functions used for ecological forecasts and reanalysis -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("David","LeBauer"), person("Xiaohui", "Feng"), @@ -22,10 +22,10 @@ Imports: PEcAn.utils Suggests: testthat (>= 1.0.2) -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Collate: Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/data.hydrology/tests/Rcheck_reference.log b/modules/data.hydrology/tests/Rcheck_reference.log new file mode 100644 index 00000000000..42ca33e067f --- /dev/null +++ b/modules/data.hydrology/tests/Rcheck_reference.log @@ -0,0 +1,40 @@ +* using log directory ‘/tmp/RtmpirGbcf/PEcAn.data.hydrology.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.data.hydrology/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.data.hydrology’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.data.hydrology’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking examples ... NONE +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 1 NOTE diff --git a/modules/data.land/DESCRIPTION b/modules/data.land/DESCRIPTION index 0cc9d7a9bb4..03062638ecb 100644 --- a/modules/data.land/DESCRIPTION +++ b/modules/data.land/DESCRIPTION @@ -1,51 +1,61 @@ Package: PEcAn.data.land Type: Package Title: PEcAn functions used for ecological forecasts and reanalysis -Version: 1.7.1 -Date: 2019-09-05 -Authors@R: c(person("Mike","Dietze"), - person("David","LeBauer"), - person("Xiaohui", "Feng"), - person("Dan"," Wang"), - person("Carl", "Davidson"), - person("Rob","Kooper"), - person("Alexey", "Shiklomanov")) -Author: David LeBauer, Mike Dietze, Xiaohui Feng, Dan Wang, - Carl Davidson, Rob Kooper, Alexey Shiklomanov -Maintainer: Mike Dietze , David LeBauer +Version: 1.7.2 +Date: 2021-10-04 +Authors@R: c(person("Mike","Dietze",email="dietze@bu.edu",role="cre"), + person("David","LeBauer",role="aut"), + person("Xiaohui", "Feng",role="ctb"), + person("Dan"," Wang",role="ctb"), + person("Carl", "Davidson",role="ctb"), + person("Rob","Kooper",role="ctb"), + person("Alexey", "Shiklomanov",role="ctb")) Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific workflow management tool that is designed to simplify the management of model parameterization, execution, and analysis. The goal of PECAn is to streamline the interaction between data and models, and to improve the efficacy of scientific investigation. -Depends: - datapack, - dataone, - PEcAn.DB, - PEcAn.utils, - redland, - sirt, - sf Imports: + coda, + datapack, dplyr, + dplR, + fs, + lubridate, magrittr, + maptools, + mvtnorm, ncdf4 (>= 1.15), + neonUtilities, + PEcAn.benchmark, + PEcAn.data.atmosphere, + PEcAn.DB, PEcAn.logger, PEcAn.remote, + PEcAn.settings, + PEcAn.utils, + PEcAn.visualization, purrr, + rjags, rlang, - sp, + RCurl, + RPostgreSQL, sf, - XML (>= 3.98-1.4) + sirt, + sp, + stringr, + traits, + udunits2, + XML (>= 3.98-1.4) Suggests: - fields, - PEcAn.settings, + dataone, + redland, + raster, rgdal, - RPostgreSQL, - testthat (>= 1.0.2), -License: FreeBSD + file LICENSE + testthat (>= 1.0.2) +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/data.land/NAMESPACE b/modules/data.land/NAMESPACE index 439d00a934b..10802961cfb 100644 --- a/modules/data.land/NAMESPACE +++ b/modules/data.land/NAMESPACE @@ -46,7 +46,7 @@ export(soil.units) export(soil2netcdf) export(soil_params) export(soil_process) -export(subset.layer) +export(subset_layer) export(to.Tag) export(to.TreeCode) export(write_ic) diff --git a/modules/data.land/R/IC_BADM_Utilities.R b/modules/data.land/R/IC_BADM_Utilities.R index 600b7f18107..a5a64627f9c 100644 --- a/modules/data.land/R/IC_BADM_Utilities.R +++ b/modules/data.land/R/IC_BADM_Utilities.R @@ -258,7 +258,7 @@ BADM_IC_process <- function(settings, dir, overwrite=TRUE){ ens=.x)) out.ense <- out.ense %>% - setNames(rep("path", length(out.ense))) + stats::setNames(rep("path", length(out.ense))) return(out.ense) } @@ -298,10 +298,10 @@ EPA_ecoregion_finder <- function(Lat, Lon){ ) %>% sf::st_transform("+proj=longlat +datum=WGS84") - sp::proj4string(U.S.SB.sp) <- sp::proj4string(as_Spatial(L1)) + sp::proj4string(U.S.SB.sp) <- sp::proj4string(sf::as_Spatial(L1)) # finding the code for each site - over.out.L1 <- sp::over(U.S.SB.sp, as_Spatial(L1)) - over.out.L2 <- sp::over(U.S.SB.sp, as_Spatial(L2)) + over.out.L1 <- sp::over(U.S.SB.sp, sf::as_Spatial(L1)) + over.out.L2 <- sp::over(U.S.SB.sp, sf::as_Spatial(L2)) return(data.frame(L1 = over.out.L1$NA_L1CODE, L2 = over.out.L2$NA_L2CODE)) } diff --git a/modules/data.land/R/InventoryGrowthFusion.R b/modules/data.land/R/InventoryGrowthFusion.R index cf6f0ba7f27..dd020a9ae63 100644 --- a/modules/data.land/R/InventoryGrowthFusion.R +++ b/modules/data.land/R/InventoryGrowthFusion.R @@ -13,7 +13,6 @@ ##' @return an mcmc.list object ##' @export InventoryGrowthFusion <- function(data, cov.data=NULL, time_data = NULL, n.iter=5000, n.chunk = n.iter, n.burn = min(n.chunk, 2000), random = NULL, fixed = NULL,time_varying=NULL, burnin_plot = FALSE, save.jags = "IGF.txt", z0 = NULL, save.state=TRUE,restart = NULL) { - library(rjags) # baseline variables to monitor burnin.variables <- c("tau_add", "tau_dbh", "tau_inc", "mu") # process variability, dbh and tree-ring observation error, intercept @@ -30,7 +29,7 @@ InventoryGrowthFusion <- function(data, cov.data=NULL, time_data = NULL, n.iter= } max.chunks <- ceiling(n.iter/n.chunk) if(max.chunks < k_restart){ - PEcAn.utils::logger.warn("MCMC already complete",max.chunks,k_restart) + PEcAn.logger::logger.warn("MCMC already complete",max.chunks,k_restart) return(NULL) } avail.chunks <- k_restart:ceiling(n.iter/n.chunk) @@ -426,11 +425,11 @@ model{ PEcAn.logger::logger.info("COMPILE JAGS MODEL") - j.model <- jags.model(file = textConnection(TreeDataFusionMV), data = data, inits = init, n.chains = 3) + j.model <- rjags::jags.model(file = textConnection(TreeDataFusionMV), data = data, inits = init, n.chains = 3) if(n.burn > 0){ PEcAn.logger::logger.info("BURN IN") - jags.out <- coda.samples(model = j.model, + jags.out <- rjags::coda.samples(model = j.model, variable.names = burnin.variables, n.iter = n.burn) if (burnin_plot) { @@ -450,7 +449,7 @@ model{ } ## sample chunk - jags.out <- coda.samples(model = j.model, variable.names = vnames, n.iter = n.chunk) + jags.out <- rjags::coda.samples(model = j.model, variable.names = vnames, n.iter = n.chunk) ## save chunk ofile <- paste("IGF",model,k,"RData",sep=".") diff --git a/modules/data.land/R/Read_Tuscon.R b/modules/data.land/R/Read_Tuscon.R index 3b5e8eadb96..0aa0be32a6d 100644 --- a/modules/data.land/R/Read_Tuscon.R +++ b/modules/data.land/R/Read_Tuscon.R @@ -44,8 +44,6 @@ Clean_Tucson <- function(file) { ##' (WinDendro can sometimes create duplicate records when editing) Read_Tucson <- function(folder) { - library(dplR) - filenames <- dir(folder, pattern = "TXT", full.names = TRUE) filenames <- c(filenames, dir(folder, pattern = "rwl", full.names = TRUE)) filenames <- c(filenames, dir(folder, pattern = "rw", full.names = TRUE)) @@ -56,7 +54,7 @@ Read_Tucson <- function(folder) { filedata <- list() for (file in filenames) { file <- Clean_Tucson(file) - filedata[[file]] <- read.tucson(file, header = FALSE) + filedata[[file]] <- dplR::read.tucson(file, header = FALSE) } return(filedata) diff --git a/modules/data.land/R/dataone_download.R b/modules/data.land/R/dataone_download.R index 1207c835f76..b24cd07c669 100644 --- a/modules/data.land/R/dataone_download.R +++ b/modules/data.land/R/dataone_download.R @@ -21,7 +21,7 @@ dataone_download = function(id, filepath = "/fs/data1/pecan.data/dbfiles", CNode = "PROD", lazyLoad = FALSE, quiet = FALSE){ ### Check for wget functionality test <- try(system2("wget", "--version", stderr = TRUE)) - if (class(test) == "try-error") { + if (inherits(test, "try-error")) { PEcAn.logger::logger.severe("wget system utility is not available on this system. Please install it to use this functionality.") } diff --git a/modules/data.land/R/diametergrow.R b/modules/data.land/R/diametergrow.R index ef80a2174a4..589cc2ec624 100644 --- a/modules/data.land/R/diametergrow.R +++ b/modules/data.land/R/diametergrow.R @@ -14,8 +14,8 @@ diametergrow <- function(diameters, increment, survival = NULL) { ## ## - plotend <- function(fname) { dev.off() } - plotstart <- function(fname) { pdf(fname) } + plotend <- function(fname) { grDevices::dev.off() } + plotstart <- function(fname) { grDevices::pdf(fname) } ##################################################################################### tnorm <- function(n, lo, hi, mu, sig) { # normal truncated lo and hi @@ -27,8 +27,8 @@ diametergrow <- function(diameters, increment, survival = NULL) { hi <- rep(hi, length(mu)) } - z <- runif(n, pnorm(lo, mu, sig), pnorm(hi, mu, sig)) - z <- qnorm(z, mu, sig) + z <- stats::runif(n, stats::pnorm(lo, mu, sig), stats::pnorm(hi, mu, sig)) + z <- stats::qnorm(z, mu, sig) z[z == Inf] <- lo[z == Inf] z[z == -Inf] <- hi[z == -Inf] z @@ -53,7 +53,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { wi <- which(is.finite(dcens[i, ]), arr.ind = TRUE) xi <- time[wi] - wf + 1 # recenter to first year yi <- dcens[i, wi] - intercept <- mean(yi) - mean(xi) * (cov(xi, yi) / var(xi)) + intercept <- mean(yi) - mean(xi) * (stats::cov(xi, yi) / stats::var(xi)) ## modification: if only one census, assume mean increment if (length(xi) == 1) { @@ -99,13 +99,13 @@ diametergrow <- function(diameters, increment, survival = NULL) { v <- crossprod(X, (dgrow[aincr] - teffect[aincr])) / allvars + prior.IVm %*% prior.mu V <- solve(crossprod(X) / allvars + prior.IVm) - alpha <- matrix(rmvnorm(1, V %*% v, V), (ncovars + 1), 1) + alpha <- matrix(mvtnorm::rmvnorm(1, V %*% v, V), (ncovars + 1), 1) mumat[aincr] <- X %*% alpha v <- apply((dgrow - mumat), 2, sum, na.rm = TRUE) / allvars V <- 1 / (ntt / allvars + 1 / prior.Vmu) - beta <- rnorm(length(v), (V * v), sqrt(V)) + beta <- stats::rnorm(length(v), (V * v), sqrt(V)) mb <- mean(beta[ntt > 0]) #extract mean beta.t <- beta - mb beta.t[ntt == 0] <- 0 @@ -234,12 +234,12 @@ diametergrow <- function(diameters, increment, survival = NULL) { # errors: ss <- sum((dcens[dobs] - diam.t[dobs]) ^ 2, na.rm = TRUE) #diameter error - sw <- 1 / (rgamma(1, (w1 + ndobs / 2), (w2 + 0.5 * ss))) + sw <- 1 / (stats::rgamma(1, (w1 + ndobs / 2), (w2 + 0.5 * ss))) sv <- 0 if (length(iobs) > 0) { ss <- sum((dgrow[iobs] - dincr[iobs]) ^ 2, na.rm = TRUE) #growth error - sv <- 1 / (rgamma(1, (v11 + 0.5 * niobs), (v22 + 0.5 * ss))) + sv <- 1 / (stats::rgamma(1, (v11 + 0.5 * niobs), (v22 + 0.5 * ss))) } list(diam.t = diam.t, sw = sw, sv = sv, ad = ad, aa = aa) @@ -272,17 +272,17 @@ diametergrow <- function(diameters, increment, survival = NULL) { pnew <- pnow # diameter data - pnow[dobs] <- pnow[dobs] + dnorm(dcens[dobs], diam.t[dobs], sqrt(w.error), log = TRUE) - pnew[dobs] <- pnew[dobs] + dnorm(dcens[dobs], diamnew[dobs], sqrt(w.error), log = TRUE) + pnow[dobs] <- pnow[dobs] + stats::dnorm(dcens[dobs], diam.t[dobs], sqrt(w.error), log = TRUE) + pnew[dobs] <- pnew[dobs] + stats::dnorm(dcens[dobs], diamnew[dobs], sqrt(w.error), log = TRUE) # regression - pnow[, -1] <- pnow[, -1] + dnorm(dgrow, lreg, sqrt(sig), log = TRUE) - pnew[, -1] <- pnew[, -1] + dnorm(dnew, lreg, sqrt(sig), log = TRUE) + pnow[, -1] <- pnow[, -1] + stats::dnorm(dgrow, lreg, sqrt(sig), log = TRUE) + pnew[, -1] <- pnew[, -1] + stats::dnorm(dnew, lreg, sqrt(sig), log = TRUE) # increment data if (length(iobs) > 0) { - pnow[iobs] <- pnow[iobs] + dnorm(dincr[iobs], dgrow[iobs], sqrt(v.error), log = TRUE) - pnew[iobs] <- pnew[iobs] + dnorm(dincr[iobs], dnew[iobs], sqrt(v.error), log = TRUE) + pnow[iobs] <- pnow[iobs] + stats::dnorm(dincr[iobs], dgrow[iobs], sqrt(v.error), log = TRUE) + pnew[iobs] <- pnew[iobs] + stats::dnorm(dincr[iobs], dnew[iobs], sqrt(v.error), log = TRUE) } pnow <- apply(pnow, 1, sum, na.rm = TRUE) @@ -299,10 +299,10 @@ diametergrow <- function(diameters, increment, survival = NULL) { # errors: ss <- sum((dcens[dobs] - diam.t[dobs]) ^ 2, na.rm = TRUE) #diameter error - sw <- 1 / (rgamma(1, (w1 + ndobs / 2), (w2 + 0.5 * ss))) + sw <- 1 / (stats::rgamma(1, (w1 + ndobs / 2), (w2 + 0.5 * ss))) ss <- sum((dgrow[iobs] - dincr[iobs])^2, na.rm = TRUE) #growth error - sv <- 1 / (rgamma(1, (v11 + 0.5 * niobs), (v22 + 0.5 * ss))) + sv <- 1 / (stats::rgamma(1, (v11 + 0.5 * niobs), (v22 + 0.5 * ss))) if (length(iobs) == 0) { sv <- 0 } @@ -312,18 +312,18 @@ diametergrow <- function(diameters, increment, survival = NULL) { sd.update <- function() { # variance on random effects - 1 / rgamma(1, (vi1 + n/2), (vi2 + 0.5 * sum(beta.i ^ 2))) + 1 / stats::rgamma(1, (vi1 + n/2), (vi2 + 0.5 * sum(beta.i ^ 2))) } # sd.update sp.update <- function() { # variance on random plot effects - 1 / rgamma(1, (pi1 + mplot / 2), (pi2 + 0.5 * sum(beta.p ^ 2))) + 1 / stats::rgamma(1, (pi1 + mplot / 2), (pi2 + 0.5 * sum(beta.p ^ 2))) } # sp.update se.update <- function() { # process error ss <- sum((dgrow - mumat - ieffect - teffect - peffect) ^ 2, na.rm = TRUE) - 1 / (rgamma(1, (s1 + 0.5 * sum(nti)), (s2 + 0.5 * ss))) + 1 / (stats::rgamma(1, (s1 + 0.5 * sum(nti)), (s2 + 0.5 * ss))) } # se.update @@ -462,7 +462,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { ncovars <- 1 #number of covariates X <- matrix(1, nrow(aincr), (ncovars + 1)) nx <- nrow(X) - X[, 2] <- rnorm(nx, (dgrow[aincr] * 0.5 + 1), 0.1) #simulated data + X[, 2] <- stats::rnorm(nx, (dgrow[aincr] * 0.5 + 1), 0.1) #simulated data prior.mu <- rep(0, (1 + ncovars)) prior.Vmu <- rep(10, (1 + ncovars)) prior.IVm <- solve(diag(prior.Vmu)) @@ -505,11 +505,11 @@ diametergrow <- function(diameters, increment, survival = NULL) { ############# initial values ################ mu <- tnorm(1, 0, 1, prior.mu, 1) - sig <- 1 / rgamma(1, s1, s2) - sigd <- 1 / rgamma(1, vi1, vi2) - sigp <- 1 / rgamma(1, pi1, pi2) - w.error <- 1 / rgamma(1, w1, w2) - v.error <- 1 / rgamma(1, vi1, vi2) + sig <- 1 / stats::rgamma(1, s1, s2) + sigd <- 1 / stats::rgamma(1, vi1, vi2) + sigp <- 1 / stats::rgamma(1, pi1, pi2) + w.error <- 1 / stats::rgamma(1, w1, w2) + v.error <- 1 / stats::rgamma(1, vi1, vi2) beta.i <- rep(0, n) #individual random effects beta.p <- rep(0, mplot) #plot random effects beta.t <- rep(0, (nt - 1)) #fixed year effects @@ -678,7 +678,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { estimate <- c(apply(cbind(mgibbs, sgibbs, tgibbs)[keep, ], 2, mean), peff) std_err <- c(apply(cbind(mgibbs, sgibbs, tgibbs)[keep, ], 2, sd), sdp) - p3 <- t(apply(cbind(mgibbs, sgibbs, tgibbs)[keep, ], 2, quantile, c(0.025, 0.975))) + p3 <- t(apply(cbind(mgibbs, sgibbs, tgibbs)[keep, ], 2, stats::quantile, c(0.025, 0.975))) p3 <- rbind(p3, pci) nn <- c(rep(nall, (ncovars + 2)), n, mplot, ndobs, niobs, ntt, ntp) p3 <- cbind(nn, estimate, std_err, p3) @@ -693,7 +693,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { colnames(diampars) <- c(colnames(p3), "par1", "par2", "prior mean") outfile <- file.path(outfolder, "diampars.txt") - write.table(signif(diampars, 3), outfile, row.names = TRUE, col.names = TRUE, quote = FALSE) + utils::write.table(signif(diampars, 3), outfile, row.names = TRUE, col.names = TRUE, quote = FALSE) # determine posterior means and sd's for diameter, growth, and other columns in treemat @@ -769,8 +769,8 @@ diametergrow <- function(diameters, increment, survival = NULL) { yjvec <- c(1:nyr[j]) for (w in wna) { - lfit <- lm(md[w, ] ~ yjvec) - newvals <- predict.lm(lfit, newdata = data.frame(yjvec)) + lfit <- stats::lm(md[w, ] ~ yjvec) + newvals <- stats::predict.lm(lfit, newdata = data.frame(yjvec)) md[w, is.na(md[w, ])] <- newvals[is.na(md[w, ])] check <- diff(md[w, ]) @@ -812,7 +812,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { plotfile <- file.path(outfolder, "incrementdata.ps") plotstart(plotfile) - par(mfrow = c(6, 2), mar = c(1, 1, 2, 1), bty = "n") + graphics::par(mfrow = c(6, 2), mar = c(1, 1, 2, 1), bty = "n") for (j in seq_len(mplot)) { if (mtree[j] == 0) { @@ -869,7 +869,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { prior.mu <- 0.3 #prior mean variance for mean growth rate prior.Vmu <- 10 - par(mfrow = c(3, 2)) + graphics::par(mfrow = c(3, 2)) for (j in 1:5) { mj <- vp[j, 2] / (vp[j, 1] - 1) if (max(sgibbs[keep, j], na.rm = TRUE) == 0) { @@ -884,7 +884,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { title(colnames(sgibbs)[j]) } vt <- seq(-0.3, 0.3, length = 100) - plot(vt, dnorm(vt, 0, sqrt(prior.Vmu)), + plot(vt, stats::dnorm(vt, 0, sqrt(prior.Vmu)), col = "darkgreen", type = "l", lwd = 2, ylim = c(0, 60), xlab = "Parameter value", ylab = "Density") title("yr effects") @@ -901,7 +901,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { # var comparison sdi <- apply(tgibbs, 1, sd) - par(mfrow = c(2, 1)) + graphics::par(mfrow = c(2, 1)) meanyr <- apply(tgibbs[keep, ], 2, mean) plot(yrvec[-nt], log10(mgrow[1, ]), ylim = c(-2, 0.5), type = "l", xlab = "Year", ylab = "Diameter increment (log cm)") @@ -967,7 +967,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { plotfile <- file.path(outfolder, "diam_ind.ps") plotstart(plotfile) - par(mfrow = c(2, 2)) + graphics::par(mfrow = c(2, 2)) for (j in seq_along(mgibbs)) { plot(mgibbs[keep, j], type = "l") # title(ins[j]) @@ -983,7 +983,7 @@ diametergrow <- function(diameters, increment, survival = NULL) { # diameters and growth rates ## par(mfrow=c(2,2)) - par(mfrow = c(1, 1)) + graphics::par(mfrow = c(1, 1)) if (length(iobs) > 0) { lo <- mgrow[iobs] - 1.96 * sgrow[iobs] @@ -1018,8 +1018,8 @@ diametergrow <- function(diameters, increment, survival = NULL) { jj <- jj + 1 iplot <- sort(sample(seq_len(n), 5)) - par(mfrow = c(5, 2)) - par(mar = c(3, 2, 2, 1)) + graphics::par(mfrow = c(5, 2)) + graphics::par(mar = c(3, 2, 2, 1)) for (j in 1:5) { md <- exp(mldiam[iplot[j], ]) diff --git a/modules/data.land/R/download_NEON_soilmoisture.R b/modules/data.land/R/download_NEON_soilmoisture.R new file mode 100644 index 00000000000..78ae44326d1 --- /dev/null +++ b/modules/data.land/R/download_NEON_soilmoisture.R @@ -0,0 +1,119 @@ +##' @name download_NEON_soilmoist +##' @description: +##' Download NEON Soil Water Content and Soil Salinity data by date and site name +##' +##' @param site four letter NEON site code name(s). If no site is specified, it will download all of them (chr) (e.g "BART" or c("SRER", "KONA", "BART")) +##' @param avg averaging interval (minutes): 1, 30, or both ("all") . default returns both +##' @param var variable of interest: "SWC" (soil water content) or "SIC" (soil ion content) or both ("all") default returns both. +##' Both variables will be saved in outdir automatically (chr) +##' @param startdate start date as YYYY-mm. If left empty, all data available will be downloaded (chr) +##' @param enddate start date as YYYY-mm. If left empty, all data available will be downloaded (chr) +##' @param outdir out directory to store the following data: +##' .rds list files of SWC and SIC data for each site and sensor position, +##' sensor positions .csv for each site, +##' variable description .csv file, +##' readme .csv file +##' @return List of specified variable(s) AND prints the path to output folder +##' +##' @author Juliette Bateman +##' +##' @example +##' \run{ +##' test <- download_NEON_soilmoisture( +##' site = c("SRER", "BART", "KONA"), +##' avg = 30, +##' var = "SWC", +##' startdate = "2019-01", +##' enddate = "2020-01", +##' outdir = getwd())} + +## Install NEON libs +#devtools::install_github("NEONScience/NEON-geolocation/geoNEON") +#devtools::install_github("NEONScience/NEON-utilities/neonUtilities", force = TRUE) +#install.packages("BiocManager") +# BiocManager::install("rhdf5") + + +download_NEON_soilmoist <- function(site, avg = "all", var = "all", + startdate = NA, enddate = NA, + outdir) { + + + #################### Data Download from NEON #################### + soil.raw = neonUtilities::loadByProduct(dpID = "DP1.00094.001", site = site, avg = avg, startdate = startdate, enddate = enddate, check.size = FALSE) + + # Export into new folder in outdir + dir = paste0(outdir, "/NEONSoilMoist", "_", startdate, "-", enddate) + dir.create(dir) + + #################### Clean-up Data Observations #################### + # Only select data from list and remove flagged observations + if (avg == 30) { + data.raw = soil.raw$SWS_30_minute %>% stats::na.omit() + } else if (avg == 1) { + data.raw = soil.raw$SWS_1_minute %>% stats::na.omit() + } else { + data.raw = list(soil.raw$SWS_1_minute, soil.raw$SWS_30_minute) %>% stats::na.omit() + } + + # Separate variables, omit flagged data obs + data.raw.SWC = (split(data.raw, data.raw$VSWCFinalQF))$'0' %>% + dplyr::select(c("domainID", "siteID", "horizontalPosition", "verticalPosition", "startDateTime", "endDateTime", "VSWCMean", "VSWCMinimum", "VSWCMaximum", "VSWCVariance", "VSWCNumPts", "VSWCExpUncert", "VSWCStdErMean")) + data.raw.SIC = (split(data.raw, data.raw$VSICFinalQF))$'0' %>% + dplyr::select(c("domainID", "siteID", "horizontalPosition", "verticalPosition", "startDateTime", "endDateTime","VSICMean", "VSICMinimum", "VSICMaximum", "VSICVariance", "VSICNumPts", "VSICExpUncert", "VSICStdErMean")) + + data.raw.both = list(data.raw.SWC, data.raw.SIC) + names(data.raw.both) <- c("SWC", "SIC") + data.split.both = lapply(data.raw.both, function(x) split(x, x$siteID)) + + # Separate dataframe into lists by site and sensor position + data.SWC.sites = split(data.raw.SWC, data.raw.SWC$siteID) + data.SIC.sites = split(data.raw.SIC, data.raw.SIC$siteID) + for (i in 1:length(data.SWC.sites)){ + data.SWC.sites[i]=lapply(data.SWC.sites[i], function(x) split(x, list(x$horizontalPosition, x$verticalPosition))) + } + for (i in 1:length(data.SIC.sites)){ + data.SIC.sites[i]=lapply(data.SIC.sites[i], function(x) split(x, list(x$horizontalPosition, x$verticalPosition))) + } + + #################### Save data into folders #################### + + # Saving metadata and site data lists as .rds files to outdir, organize into site specific folders + sensor.pos = split(soil.raw$sensor_positions_00094, soil.raw$sensor_positions_00094$siteID) + for (i in names(sensor.pos)){ + utils::write.csv(sensor.pos[[i]], file = paste0(dir, "/", i, "_sensor_positions.csv")) + } + for (i in names(data.SIC.sites)) { + saveRDS(data.SIC.sites[[i]], file = paste0(dir, "/", i, "_SIC_data.rds")) + } + for (i in names(data.SWC.sites)) { + saveRDS(data.SWC.sites[[i]], file = paste0(dir, "/", i, "_SWC_data.rds")) + } + for (i in 1:length(site)){ + folders = paste0(dir, "/", site[1:i]) + dir.create(folders[i]) + fs::file_move(paste0(dir, "/", site[i], "_sensor_positions.csv"), folders[i]) + fs::file_move(paste0(dir, "/", site[i], "_SIC_data.rds"), folders[i]) + fs::file_move(paste0(dir, "/", site[i], "_SWC_data.rds"), folders[i]) + } + + utils::write.csv(soil.raw$readme_00094, file = (paste0(dir,"/readme.csv"))) + utils::write.csv(soil.raw$variables_00094, file = paste0(dir, "/variable_description.csv")) + + # Return file path to data and print lists of + PEcAn.logger::logger.info("Done! NEON soil data has been downloaded and stored in ", paste0(dir), ".") + if (var == "SWC") { + data.SWC = data.SWC.sites + return(data.SWC) + } else if (var == "SIC") { + data.SIC = data.SIC.sites + return(data.SIC) + } else if (var == "all") { + data.SWC <- data.SWC.sites + data.SIC <- data.SIC.sites + both.var = list(data.SWC, data.SIC) + names(both.var) = c("SWC", "SIC") + return(both.var) + } + +} diff --git a/modules/data.land/R/ens.veg.module.R b/modules/data.land/R/ens.veg.module.R index a4ba6308ec5..4abbfe0655e 100644 --- a/modules/data.land/R/ens.veg.module.R +++ b/modules/data.land/R/ens.veg.module.R @@ -31,7 +31,7 @@ ens_veg_module <- function(getveg.id, dbparms, password = dbparms$bety$password) con <- bety$con - on.exit(db.close(con)) + on.exit(db.close(con), add = TRUE) PEcAn.logger::logger.info("Begin IC sampling, ensemble member: ", n.ensemble) diff --git a/modules/data.land/R/extract_FIA.R b/modules/data.land/R/extract_FIA.R index b1c8ed526ae..431e10e7493 100644 --- a/modules/data.land/R/extract_FIA.R +++ b/modules/data.land/R/extract_FIA.R @@ -8,7 +8,7 @@ extract_FIA <- function(lon, lat, start_date, end_date, gridres = 0.075, dbparms veg_info <- list() fia.con <- PEcAn.DB::db.open(dbparms$fia) - on.exit(db.close(fia.con), add = T) + on.exit(db.close(fia.con), add = TRUE) lonmin <- lon - gridres lonmax <- lon + gridres diff --git a/modules/data.land/R/extract_soil_nc.R b/modules/data.land/R/extract_soil_nc.R index 2499f8bb9db..dff30b31335 100644 --- a/modules/data.land/R/extract_soil_nc.R +++ b/modules/data.land/R/extract_soil_nc.R @@ -38,9 +38,17 @@ extract_soil_gssurgo<-function(outdir, lat, lon, size=1, radius=500, depths=c(0. if ("GML" %in% rgdal::ogrDrivers()$name) { suppressMessages({ - #disambiguateFIDs if TRUE, and FID values are not unique, they will be set to unique values 1:N for N features; problem observed in GML files - sarea <-rgdal::readOGR(mu.Path, disambiguateFIDs=T) - + + #disambiguateFIDs if TRUE, and FID values are not unique, they will be set to unique values 1:N for N features; problem observed in GML files + #idk why but gssurgo api seems to fail for no reason, that'w why I try 3 times. + for(i in 1:3){ + # try to read the polygon to get the mukey + sarea <-try(rgdal::readOGR(mu.Path, disambiguateFIDs=T), silent = TRUE) + if( class(sarea) != "try-error" ) break; + PEcAn.logger::logger.warn(paste0(i, " attemp was unsuccessful")) + Sys.sleep(1) + } + # flipping the coordinates # gdal reads the gSSUGO layers with fliped coordinateds for (i in seq_along(sarea@polygons)){ @@ -52,7 +60,7 @@ extract_soil_gssurgo<-function(outdir, lat, lon, size=1, radius=500, depths=c(0. areasf <-sf::st_as_sf(sarea) # getting the site point ready - site = sf::st_as_sf(data.frame(long=lon, lat=lat),coords=c("long","lat")) + site = sf::st_as_sf(data.frame(long=lon, lat=lat), coords=c("long","lat")) #buffer the radius around site / and clip the study area based on buffer site_buffer = sf::st_buffer(site, (radius/111000)) # converting radius m to dgree - each degree is about 111 Km @@ -114,7 +122,7 @@ extract_soil_gssurgo<-function(outdir, lat, lon, size=1, radius=500, depths=c(0. }) %>% setNames(names(soilprop.new)[1:4]) #This ensures that I have at least one soil ensemble in case the modeling part failed - all.soil.ens <-c(all.soil.ens,list(soil.data.gssurgo)) + all.soil.ens <-c(all.soil.ens, list(soil.data.gssurgo)) # What I do here is that I put soil data into depth classes and then model each class speparatly @@ -173,6 +181,7 @@ extract_soil_gssurgo<-function(outdir, lat, lon, size=1, radius=500, depths=c(0. split(.$mukey)%>% purrr::map(function(soiltype.sim){ sizein <- (mukey_area$Area[ mukey_area$mukey == soiltype.sim$mukey %>% unique()])*size + 1:ceiling(sizein) %>% purrr::map(function(x){ soiltype.sim %>% @@ -243,7 +252,7 @@ extract_soil_gssurgo<-function(outdir, lat, lon, size=1, radius=500, depths=c(0. #' @param lat #' @param lon #' -#' @return +#' @return path to netCDF file containing extracted data #' @export #' #' @examples @@ -343,7 +352,7 @@ extract_soil_nc <- function(in.file,outdir,lat,lon){ #' #' @param varname #' -#' @return +#' @return character #' @export #' #' @examples diff --git a/modules/data.land/R/fia2ED.R b/modules/data.land/R/fia2ED.R index 0871ba0f56d..c4d7c0e14d5 100644 --- a/modules/data.land/R/fia2ED.R +++ b/modules/data.land/R/fia2ED.R @@ -7,9 +7,6 @@ # http://opensource.ncsa.illinois.edu/license.html #------------------------------------------------------------------------------- -library(PEcAn.utils) -library(PEcAn.DB) - ##' convert x into a table ##' ##' @title fia.to.psscss @@ -37,14 +34,14 @@ fia.to.psscss <- function(settings, lonmin <- lon - gridres ## connect to database - con <- db.open(settings$database$bety) - on.exit(db.close(con)) + con <- PEcAn.DB::db.open(settings$database$bety) + on.exit(PEcAn.DB::db.close(con), add = TRUE) # Check whether inputs exist already if(!overwrite) { existing.files <- list() for(format in formatnames) { - existing.files[[format]] <- dbfile.input.check( + existing.files[[format]] <- PEcAn.DB::dbfile.input.check( siteid = settings$run$site$id, startdate = startdate, enddate = enddate, @@ -82,7 +79,7 @@ fia.to.psscss <- function(settings, query <- paste0(query, " OR bp.name = '", pft$name, "'") } } - pfts <- db.query(query, con = con) + pfts <- PEcAn.DB::db.query(query, con = con) # Convert PFT names to ED2 Numbers data(pftmapping) @@ -109,7 +106,7 @@ fia.to.psscss <- function(settings, bad <- pfts$spcd[duplicated(pfts$spcd)] if (length(bad) > 0) { # Coerce spcds back into species names using data from FIA manual. Makes a more readable warning. - symbol.table <- db.query("SELECT spcd, \"Symbol\" FROM species where spcd IS NOT NULL", con = con) + symbol.table <- PEcAn.DB::db.query("SELECT spcd, \"Symbol\" FROM species where spcd IS NOT NULL", con = con) names(symbol.table) <- tolower(names(symbol.table)) # grab the names where we have bad spcds in the symbol.table, exclude NAs @@ -121,8 +118,8 @@ fia.to.psscss <- function(settings, } ## connect to database - fia.con <- db.open(settings$database$fia) - on.exit(db.close(fia.con), add = T) + fia.con <- PEcAn.DB::db.open(settings$database$fia) + on.exit(PEcAn.DB::db.close(fia.con), add = TRUE) ################## ## ## @@ -137,7 +134,7 @@ fia.to.psscss <- function(settings, " AND p.lat <= ", latmax, " AND p.measyear >= ", min.year, " AND p.measyear <= ", max.year, " GROUP BY p.cn") - pss <- db.query(query, con = fia.con) + pss <- PEcAn.DB::db.query(query, con = fia.con) if (nrow(pss) == 0) { PEcAn.logger::logger.severe("No pss data found.") } @@ -195,7 +192,7 @@ fia.to.psscss <- function(settings, " and p.lon < ", lonmax, " and p.lat >= ", latmin, " and p.lat < ", latmax) - css <- db.query(query, con = fia.con) + css <- PEcAn.DB::db.query(query, con = fia.con) names(css) <- tolower(names(css)) if (nrow(css) == 0) { PEcAn.logger::logger.severe("No FIA data found.") @@ -232,7 +229,7 @@ fia.to.psscss <- function(settings, if (length(pft.only) > 0) { if (!exists("symbol.table")) { - symbol.table <- db.query("SELECT spcd, \"Symbol\" FROM species where spcd IS NOT NULL", con = con) + symbol.table <- PEcAn.DB::db.query("SELECT spcd, \"Symbol\" FROM species where spcd IS NOT NULL", con = con) names(symbol.table) <- tolower(names(symbol.table)) } name.list <- na.omit(symbol.table$symbol[symbol.table$spcd %in% pft.only]) @@ -247,7 +244,7 @@ fia.to.psscss <- function(settings, if (length(fia.only) > 0) { if (!exists("symbol.table")) { - symbol.table <- db.query("SELECT spcd, \"Symbol\" FROM species where spcd IS NOT NULL", con = con) + symbol.table <- PEcAn.DB::db.query("SELECT spcd, \"Symbol\" FROM species where spcd IS NOT NULL", con = con) names(symbol.table) <- tolower(names(symbol.table)) } name.list <- na.omit(symbol.table$symbol[symbol.table$spcd %in% fia.only]) diff --git a/modules/data.land/R/find.land.R b/modules/data.land/R/find.land.R index 480dee37103..403e3597a4d 100644 --- a/modules/data.land/R/find.land.R +++ b/modules/data.land/R/find.land.R @@ -11,13 +11,12 @@ ##' @export ##' @author David LeBauer find.land <- function(lat, lon, plot = FALSE) { - library(maptools) - data(wrld_simpl) + data("wrld_simpl",package="maptools",envir = environment()) ## Create a SpatialPoints object points <- expand.grid(lon, lat) colnames(points) <- c("lat", "lon") - pts <- SpatialPoints(points, proj4string = CRS(proj4string(wrld_simpl))) + pts <- sp::SpatialPoints(points, proj4string = sp::CRS(sp::proj4string(wrld_simpl))) ## Find which points fall over land landmask <- cbind(points, data.frame(land = !is.na(over(pts, wrld_simpl)$FIPS))) diff --git a/modules/data.land/R/gSSURGO_Query.R b/modules/data.land/R/gSSURGO_Query.R index 81a196473e2..649e7402d85 100644 --- a/modules/data.land/R/gSSURGO_Query.R +++ b/modules/data.land/R/gSSURGO_Query.R @@ -14,28 +14,30 @@ #' Fields need to be defined with their associate tables. For example, sandtotal is a field in chorizon table which needs to be defined as chorizon.sandotal_(r/l/h), where #' r stands for the representative value, l stand for low and h stands for high. At the momeent fields from mapunit, component, muaggatt, and chorizon tables can be extracted. #' -#'#' @examples +#' @examples #' \dontrun{ -#' PEcAn.data.land::gSSURGO.Query(fields = c("chorizon.cec7_r", "chorizon.sandtotal_r", -#' "chorizon.silttotal_r","chorizon.claytotal_r", -#' "chorizon.om_r","chorizon.hzdept_r","chorizon.frag3to10_r", -#' "chorizon.dbovendry_r","chorizon.ph1to1h2o_r", -#' "chorizon.cokey","chorizon.chkey")) +#' PEcAn.data.land::gSSURGO.Query( +#' fields = c( +#' "chorizon.cec7_r", "chorizon.sandtotal_r", +#' "chorizon.silttotal_r","chorizon.claytotal_r", +#' "chorizon.om_r","chorizon.hzdept_r","chorizon.frag3to10_r", +#' "chorizon.dbovendry_r","chorizon.ph1to1h2o_r", +#' "chorizon.cokey","chorizon.chkey")) #' } -gSSURGO.Query<-function(mukeys=2747727, +gSSURGO.Query <- function(mukeys=2747727, fields=c("chorizon.sandtotal_r", "chorizon.silttotal_r", "chorizon.claytotal_r")){ #browser() # , ######### Reteiv soil - headerFields = + headerFields <- c(Accept = "text/xml", Accept = "multipart/*", 'Content-Type' = "text/xml; charset=utf-8", SOAPAction = "http://SDMDataAccess.nrcs.usda.gov/Tabular/SDMTabularService.asmx/RunQuery") - body = paste(' + body <- paste(' @@ -51,14 +53,14 @@ gSSURGO.Query<-function(mukeys=2747727, ') reader <- RCurl::basicTextGatherer() - out<-RCurl::curlPerform(url = "https://SDMDataAccess.nrcs.usda.gov/Tabular/SDMTabularService.asmx", + out <- RCurl::curlPerform(url = "https://SDMDataAccess.nrcs.usda.gov/Tabular/SDMTabularService.asmx", httpheader = headerFields, postfields = body, writefunction = reader$update ) suppressWarnings( suppressMessages({ - xml_doc <- xmlTreeParse(reader$value()) - xmltop <- xmlRoot(xml_doc) + xml_doc <- XML::xmlTreeParse(reader$value()) + xmltop <- XML::xmlRoot(xml_doc) tablesxml <- (xmltop[[1]]["RunQueryResponse"][[1]]["RunQueryResult"][[1]]["diffgram"][[1]]["NewDataSet"][[1]]) }) ) @@ -67,21 +69,21 @@ gSSURGO.Query<-function(mukeys=2747727, tryCatch({ suppressMessages( suppressWarnings({ - tables<-getNodeSet(tablesxml,"//Table") + tables <- XML::getNodeSet(tablesxml,"//Table") ##### All datatables below newdataset # This method leaves out the variables are all NAs - so we can't have a fixed naming scheme for this df - dfs<-tables%>% + dfs <- tables %>% purrr::map_dfr(function(child){ #converting the xml obj to list - allfields <- xmlToList(child) - remov<-names(allfields) %in% c(".attrs") + allfields <- XML::xmlToList(child) + remov <- names(allfields) %in% c(".attrs") #browser() - names(allfields)[!remov]%>% + names(allfields)[!remov] %>% purrr::map_dfc(function(nfield){ #browser() - outv <-allfields[[nfield]] %>% unlist() %>% as.numeric - ifelse(length(outv)>0, outv, NA) + outv <- allfields[[nfield]] %>% unlist() %>% as.numeric + ifelse(length(outv) > 0, outv, NA) })%>% as.data.frame() %>% `colnames<-`(names(allfields)[!remov]) diff --git a/modules/data.land/R/gis.functions.R b/modules/data.land/R/gis.functions.R index fc5ae542dc7..8f9434aea3f 100644 --- a/modules/data.land/R/gis.functions.R +++ b/modules/data.land/R/gis.functions.R @@ -36,8 +36,6 @@ ##' @author Shawn P. Serbin shp2kml <- function(dir, ext, kmz = FALSE, proj4 = NULL, color = NULL, NameField = NULL, out.dir = NULL) { - require(rgdal) - # TODO: Enable compression of KML files using zip/gzip utility. Not quite figured this out yet # TODO: Allow assignment of output projection info by entering proj4 string # TODO: Allow for customization of output fill colors and line size @@ -70,8 +68,8 @@ shp2kml <- function(dir, ext, kmz = FALSE, proj4 = NULL, color = NULL, NameField # Read in shapefile(s) & get coordinates/projection info shp.file <- # readShapeSpatial(file.path(dir,i),verbose=TRUE) coordinates(test) <- ~X+Y - layers <- ogrListLayers(file.path(dir, i)) - info <- ogrInfo(file.path(dir, i), layers) + layers <- rgdal::ogrListLayers(file.path(dir, i)) + info <- rgdal::ogrInfo(file.path(dir, i), layers) # shp.file <- readOGR(file.path(dir,i),layer=layers) # no need to read in file # Display vector info to the console @@ -133,10 +131,10 @@ get.attributes <- function(file, coords) { # ogr tools do not seem to function properly in R. Need to figure out a work around reading in # kml files drops important fields inside the layers. - library(fields) - require(rgdal) + #library(fields) + #require(rgdal) - # print('NOT IMPLEMENTED YET') subset.layer(file,coords) + # print('NOT IMPLEMENTED YET') subset_layer(file,coords) } # get.attributes @@ -159,20 +157,16 @@ get.attributes <- function(file, coords) { ##' file <- Sys.glob(file.path(R.home(), 'library', 'PEcAn.data.land','data','*.shp')) ##' out.dir <- path.expand('~/temp') ##' # with clipping enabled -##' subset.layer(file=file,coords=c(-95,42,-84,47),clip=TRUE,out.dir=out.dir) +##' subset_layer(file=file,coords=c(-95,42,-84,47),clip=TRUE,out.dir=out.dir) ##' # without clipping enables -##' subset.layer(file=file,coords=c(-95,42,-84,47),out.dir=out.dir) +##' subset_layer(file=file,coords=c(-95,42,-84,47),out.dir=out.dir) ##' system(paste('rm -r',out.dir,sep='')) ##' } ##' -##' @export subset.layer +##' @export subset_layer ##' ##' @author Shawn P. Serbin -subset.layer <- function(file, coords = NULL, sub.layer = NULL, clip = FALSE, out.dir = NULL, out.name = NULL) { - - if (!require(rgdal)) { - print("install rgdal") - } +subset_layer <- function(file, coords = NULL, sub.layer = NULL, clip = FALSE, out.dir = NULL, out.name = NULL) { # Setup output directory for subset layer if (is.null(out.dir)) { @@ -213,4 +207,4 @@ subset.layer <- function(file, coords = NULL, sub.layer = NULL, clip = FALSE, ou # Run subset command system(OGRstring) -} # subset.layer +} # subset_layer diff --git a/modules/data.land/R/ic_process.R b/modules/data.land/R/ic_process.R index a7253c15286..8ec256668f0 100644 --- a/modules/data.land/R/ic_process.R +++ b/modules/data.land/R/ic_process.R @@ -48,7 +48,21 @@ ic_process <- function(settings, input, dir, overwrite = FALSE){ password = dbparms$bety$password) con <- bety$con - on.exit(db.close(con)) + on.exit(db.close(con), add = TRUE) + + latlon <- PEcAn.data.atmosphere::db.site.lat.lon(site$id, con = con) + # setup site database number, lat, lon and name and copy for format.vars if new input + new.site <- data.frame(id = as.numeric(site$id), + lat = latlon$lat, + lon = latlon$lon) + + new.site$name <- settings$run$site$name + + + str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09) + + + outfolder <- file.path(dir, paste0(input$source, "_site_", str_ns)) ## We need two types of start/end dates now ## i) start/end of the run when we have no veg file to begin with (i.e. we'll be querying a DB) @@ -62,7 +76,21 @@ ic_process <- function(settings, input, dir, overwrite = FALSE){ start_date <- settings$run$start.date end_date <- settings$run$end.date }else if (input$source=="BADM"){ - settings$run$inputs[['poolinitcond']]$path <- PEcAn.data.land::BADM_IC_process(settings, dir=dir, overwrite=FALSE) + + outfolder <- file.path(dir, paste0(input$source, "_site_", str_ns)) + if(!dir.exists(outfolder)) dir.create(outfolder) + + #see if there is already files generated there + newfile <-list.files(outfolder, "*.nc$", full.names = TRUE) %>% + as.list() + names(newfile) <- rep("path", length(newfile)) + + if (length(newfile)==0){ + newfile <- PEcAn.data.land::BADM_IC_process(settings, dir=outfolder, overwrite=FALSE) + } + + settings$run$inputs[['poolinitcond']]$path <- newfile + return(settings) }else{ @@ -81,18 +109,7 @@ ic_process <- function(settings, input, dir, overwrite = FALSE){ modeltype_id <- db.query(paste0("SELECT modeltype_id FROM models where id = '", settings$model$id, "'"), con)[[1]] model <- db.query(paste0("SELECT name FROM modeltypes where id = '", modeltype_id, "'"), con)[[1]] } - - # setup site database number, lat, lon and name and copy for format.vars if new input - new.site <- data.frame(id = as.numeric(site$id), - lat = PEcAn.data.atmosphere::db.site.lat.lon(site$id, con = con)$lat, - lon = PEcAn.data.atmosphere::db.site.lat.lon(site$id, con = con)$lon) - new.site$name <- settings$run$site$name - - str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09) - - - outfolder <- file.path(dir, paste0(input$source, "_site_", str_ns)) getveg.id <- putveg.id <- NULL diff --git a/modules/data.land/R/ic_utils.R b/modules/data.land/R/ic_utils.R index 248e6abe59a..3615ead69f3 100644 --- a/modules/data.land/R/ic_utils.R +++ b/modules/data.land/R/ic_utils.R @@ -2,6 +2,10 @@ ##' ##' @name write_veg ##' @title write_veg +##' @param outfolder output folder +##' @param start_date start date +##' @param veg_info vegetation data to be saved +##' @param source name of data source (used in file naming) ##' @export write_veg <- function(outfolder, start_date, veg_info, source){ diff --git a/modules/data.land/R/land.utils.R b/modules/data.land/R/land.utils.R index 8b549222862..483333dab64 100644 --- a/modules/data.land/R/land.utils.R +++ b/modules/data.land/R/land.utils.R @@ -1,13 +1,12 @@ get.elevation <- function(lat, lon) { # http://stackoverflow.com/a/8974308/199217 - library(RCurl) - + url <- paste("http://www.earthtools.org/height", lat, lon, sep = "/") - page <- getURL(url) - ans <- xmlTreeParse(page, useInternalNodes = TRUE) - heightNode <- xpathApply(ans, "//meters")[[1]] - return(as.numeric(xmlValue(heightNode))) + page <- RCurl::getURL(url) + ans <- XML::xmlTreeParse(page, useInternalNodes = TRUE) + heightNode <- XML::xpathApply(ans, "//meters")[[1]] + return(as.numeric(XML::xmlValue(heightNode))) } # get.elevation diff --git a/modules/data.land/R/matchInventoryRings.R b/modules/data.land/R/matchInventoryRings.R index c6526a2d380..7abb370a03a 100644 --- a/modules/data.land/R/matchInventoryRings.R +++ b/modules/data.land/R/matchInventoryRings.R @@ -13,7 +13,7 @@ matchInventoryRings <- function(trees, rings, extractor = "TreeCode", nyears = 3 ## build tree ring codes if (is.list(rings)) { ring.file <- rep(names(rings), times = sapply(rings, ncol)) - rings <- combine.rwl(rings) + rings <- dplR::combine.rwl(rings) } ring.ID <- names(rings) id.extract <- function(x) { diff --git a/modules/data.land/R/match_species_id.R b/modules/data.land/R/match_species_id.R index 790f60b9475..ab211237c59 100644 --- a/modules/data.land/R/match_species_id.R +++ b/modules/data.land/R/match_species_id.R @@ -72,44 +72,54 @@ match_species_id <- function(input_codes, format_name = 'custom', bety = NULL, t suffix = c('.translation_table', '')) } } else { - column <- formats_dict[format_name] - if(!is.null(bety)){ + column <- formats_dict[[format_name]] + if (!is.null(bety)) { # query BETY for species, id, genus, and latin name - translation <- dplyr::tbl(bety, 'species') %>% + translation <- dplyr::tbl(bety, "species") %>% dplyr::select(bety_species_id = id, genus, species, - input_code = column) %>% + input_code = !!column) %>% dplyr::collect() - translation<- translation %>% dplyr::mutate(input_code = toupper(input_code)) #match_species_id is case-sensitive, to match species names in obs to translation, 'input_codes' needs to be upper-case since 'latin_names' in obs are upper-case - colnames(translation) <- c('bety_species_id', 'genus', 'species',"input_codes") #semi_join requires that the column name within the tables being matched have the same name - translation <- dplyr::semi_join(translation, as.data.frame(input_codes), by = "input_codes" ) #Keep rows in translation table that have the same 'latin_name' within obs + translation <- dplyr::semi_join( + translation, + data.frame(input_code = input_codes, stringsAsFactors = FALSE), + by = "input_code") }else{ # use traits package - + # can call traits::betydb_query one at a time? # reduce the number of calls - translation <- data.frame(bety_species_id = rep(NA, length(unique(input_codes))), - genus = rep(NA, length(unique(input_codes))), - species = rep(NA, length(unique(input_codes))), - input_code = unique(input_codes), - stringsAsFactors = FALSE) - for(i in 1:nrow(translation)){ - foo <- eval(parse(text =paste0("traits::betydb_query(", - column, "='", translation$input_code[i], "', table = 'species', user = 'bety', pwd = 'bety')"))) + translation <- data.frame( + bety_species_id = rep(NA, length(unique(input_codes))), + genus = rep(NA, length(unique(input_codes))), + species = rep(NA, length(unique(input_codes))), + input_code = unique(input_codes), + stringsAsFactors = FALSE) + for (i in seq_len(nrow(translation))) { + foo <- eval(parse(text = paste0( + "traits::betydb_query(", + column, "='", translation$input_code[i], + "', table = 'species', user = 'bety', pwd = 'bety')"))) translation$bety_species_id[i] <- foo$id translation$genus[i] <- foo$genus translation$species[i] <- foo$species } - } - } input_table <- data.frame(input_code = input_codes, stringsAsFactors = FALSE) # preserving the order is important for downstream - colnames(translation)<- c('bety_species_id', 'genus', 'species',"input_code") #changed 'latin_name' back to 'input_codes' to enable 'left_join' since columns being matched must have same name, also changed 'id' back to 'bety_species_id' so species id can be checked in bety database + translation <- dplyr::select( + .data = translation, + "bety_species_id", + "genus", + "species", + "input_code", + dplyr::everything()) merge_table <- dplyr::left_join(input_table, translation) - if(sum(is.na(merge_table$bety_species_id)) > 0){ + if (sum(is.na(merge_table$bety_species_id)) > 0) { bad <- unique(merge_table$input_code[is.na(merge_table$bety_species_id)]) - PEcAn.logger::logger.error(paste0("Species for the following code(s) not found : ", paste(bad, collapse = ", "))) + PEcAn.logger::logger.error( + "Species for the following code(s) not found : ", + paste(bad, collapse = ", ")) } return(merge_table) } # match_species_id diff --git a/modules/data.land/R/plot2AGB.R b/modules/data.land/R/plot2AGB.R index 7e535c6e224..d545d191526 100644 --- a/modules/data.land/R/plot2AGB.R +++ b/modules/data.land/R/plot2AGB.R @@ -21,8 +21,6 @@ ##' @export plot2AGB <- function(combined, out, outfolder, allom.stats, unit.conv = 0.02) { - library(mvtnorm) - ## Jenkins: hemlock (kg) b0 <- -2.5384 b1 <- 2.4814 ## Allometric statistics @@ -55,7 +53,7 @@ plot2AGB <- function(combined, out, outfolder, allom.stats, unit.conv = 0.02) { for (g in seq_len(nrep)) { ## Draw allometries - b <- rmvnorm(1, B, Bcov) + b <- mvtnorm::rmvnorm(1, B, Bcov) ## convert tree diameter to biomass biomass <- matrix(exp(b[1] + b[2] * log(out[g, ])), ntree, nt) @@ -115,7 +113,7 @@ plot2AGB <- function(combined, out, outfolder, allom.stats, unit.conv = 0.02) { lines(yrvec, upA) lines(yrvec, lowA) } - dev.off() + grDevices::dev.off() save(AGB, NPP, mNPP, sNPP, mAGB, sAGB, yrvec, mbiomass_tsca, sbiomass_tsca, mbiomass_acsa3, sbiomass_acsa3, diff --git a/modules/data.land/R/pool_ic_netcdf2list.R b/modules/data.land/R/pool_ic_netcdf2list.R index a004efc41d4..acf2a3850d3 100644 --- a/modules/data.land/R/pool_ic_netcdf2list.R +++ b/modules/data.land/R/pool_ic_netcdf2list.R @@ -8,7 +8,7 @@ ##' @author Anne Thomas pool_ic_netcdf2list <- function(nc.path){ IC.nc <- try(ncdf4::nc_open(nc.path)) - if(class(IC.nc) != 'try-error'){ + if(!inherits(IC.nc, "try-error")) { dims <- vector(mode = "list", length = length(IC.nc$dim)) names(dims) <- names(IC.nc$dim) for(i in seq(IC.nc$dim)){ diff --git a/modules/data.land/R/put.veg.module.R b/modules/data.land/R/put.veg.module.R index feaf37a5e82..93560651012 100644 --- a/modules/data.land/R/put.veg.module.R +++ b/modules/data.land/R/put.veg.module.R @@ -34,7 +34,7 @@ put_veg_module <- function(getveg.id, dbparms, password = dbparms$bety$password) con <- bety$con - on.exit(db.close(con)) + on.exit(db.close(con), add = TRUE) # Determine IC file format name and mimetype model_info <- db.query(paste0("SELECT f.name, f.id, mt.type_string from modeltypes as m", " join modeltypes_formats as mf on m.id = mf.modeltype_id", diff --git a/modules/data.land/R/soil_process.R b/modules/data.land/R/soil_process.R index 9fb6d4dff5b..5f7f1e54990 100644 --- a/modules/data.land/R/soil_process.R +++ b/modules/data.land/R/soil_process.R @@ -31,7 +31,7 @@ soil_process <- function(settings, input, dbfiles, overwrite = FALSE,run.local=T user = dbparms$bety$user, password = dbparms$bety$password) con <- bety$con - on.exit(PEcAn.DB::db.close(con)) + on.exit(PEcAn.DB::db.close(con), add = TRUE) # get site info latlon <- PEcAn.data.atmosphere::db.site.lat.lon(site$id, con = con) new.site <- data.frame(id = as.numeric(site$id), @@ -40,13 +40,42 @@ soil_process <- function(settings, input, dbfiles, overwrite = FALSE,run.local=T str_ns <- paste0(new.site$id %/% 1e+09, "-", new.site$id %% 1e+09) - outfolder <- file.path(dbfiles, paste0(input$soil$source, "_site_", str_ns)) + outfolder <- file.path(dbfiles, paste0(input$source, "_site_", str_ns)) if(!dir.exists(outfolder)) dir.create(outfolder) #--------------------------------------------------------------------------------------------------# # if we are reading from gSSURGO if (input$source=="gSSURGO"){ - newfile<-extract_soil_gssurgo(outfolder, lat = latlon$lat, lon=latlon$lon) + + #see if there is already files generated there + newfile <-list.files(outfolder, "*.nc$", full.names = TRUE) %>% + as.list() + names(newfile) <- rep("path", length(newfile)) + + if(length(newfile)==0){ + radiusL <- ifelse(is.null(settings$run$input$soil$radius), 500, as.numeric(settings$run$input$soil$radius)) + + newfile<-extract_soil_gssurgo(outfolder, lat = latlon$lat, lon=latlon$lon, radius = radiusL) + + # register files in DB + for(i in 1:length(newfile)){ + in.path = paste0(dirname(newfile[i]$path), '/') + in.prefix = stringr::str_remove(basename(newfile[i]$path), ".nc") + + PEcAn.DB::dbfile.input.insert (in.path, + in.prefix, + new.site$id, + startdate = NULL, + enddate = NULL, + mimetype = "application/x-netcdf", + formatname = "pecan_soil_standard", + con = con, + ens=TRUE) + } + + + } + return(newfile) } #--------------------------------------------------------------------------------------------------# @@ -82,4 +111,4 @@ soil_process <- function(settings, input, dbfiles, overwrite = FALSE,run.local=T newfile <- PEcAn.data.land::extract_soil_nc(source.file,outfolder,lat = latlon$lat,lon=latlon$lon) return(newfile) -} # ic_process \ No newline at end of file +} # ic_process diff --git a/modules/data.land/R/soil_utils.R b/modules/data.land/R/soil_utils.R index 255aab8dc93..eca214a2a9e 100644 --- a/modules/data.land/R/soil_utils.R +++ b/modules/data.land/R/soil_utils.R @@ -212,10 +212,10 @@ soil_params <- function(soil_type=NULL, sand=NULL, silt=NULL, clay=NULL, bulk=NU mysoil$soil_thermal_capacity <- mysoil$slcpd / mysoil$soil_bulk_density ## J/m3/K / [kg m-3] -> J/kg/K ## drop variables that are only meaningful internally - mysoil$slpotcp <- NULL - mysoil$slpotwp <- NULL - mysoil$slden <- NULL ## not clear how this is is different from bulk density in the look-up-table - mysoil$slcpd <- NULL + #mysoil$slpotcp <- NULL + #mysoil$slpotwp <- NULL + #mysoil$slden <- NULL ## not clear how this is is different from bulk density in the look-up-table + #mysoil$slcpd <- NULL return(mysoil) }#end function @@ -232,7 +232,9 @@ soil_params <- function(soil_type=NULL, sand=NULL, silt=NULL, clay=NULL, bulk=NU #' @param sandfrac #' @param clayfrac #' -#' @return +#' @return vector of integers identifying textural class of each input layer. +#' Possible values are 1 through 17; NB these are NOT the same class +#' boundaries as the 12 USDA soil texture classes. #' @export #' #' @examples @@ -308,7 +310,7 @@ sclass <- function(sandfrac,clayfrac){ #' @param mpot water potential #' @param mysoil soil property list #' -#' @return +#' @return volumetric soil water content #' @export #' #' @examples diff --git a/modules/data.land/inst/LoadFLUXNETsites.R b/modules/data.land/inst/LoadFLUXNETsites.R index 7c7fe603ad2..dc5eb7490f2 100644 --- a/modules/data.land/inst/LoadFLUXNETsites.R +++ b/modules/data.land/inst/LoadFLUXNETsites.R @@ -96,7 +96,7 @@ for(s in 1:nsite){ " TOWER_BEGAN =",as.character(AMERIFLUX_table$TOWER_BEGAN[s]), " TOWER_END =",as.character(AMERIFLUX_table$TOWER_END[s]) ) - InsertString = paste0("INSERT INTO sites(sitename,country,mat,map,notes,geometry,user_id,created_at,updated_at) VALUES(", + InsertString = paste0("INSERT INTO sites(sitename,country,mat,map,notes,geometry,user_id) VALUES(", "'",sitename,"', ", "'",country,"', ", mat,", ", @@ -104,7 +104,7 @@ for(s in 1:nsite){ "'",notes,"', ", "ST_GeomFromText('POINT(",lon," ",lat," ",elev,")', 4326), ", user.id, - ", NOW(), NOW() );") + ");") db.query(InsertString,con) } @@ -185,13 +185,13 @@ for(s in 1:nsite){ notes = paste0("PI: ",PI,"; ",site.char,"; FLUXNET DESCRIPTION: ",description) notes = gsub("'","",notes) # drop single quotes from notes - InsertString = paste0("INSERT INTO sites(sitename,country,notes,geometry,user_id,created_at,updated_at) VALUES(", + InsertString = paste0("INSERT INTO sites(sitename,country,notes,geometry,user_id) VALUES(", "'",sitename,"', ", "'",country,"', ", "'",notes,"', ", "ST_GeomFromText('POINT(",lon," ",lat," ",elev,")', 4326), ", user.id, - ", NOW(), NOW() );") + ");") db.query(InsertString,con) } ## end IF new site diff --git a/modules/data.land/man/InventoryGrowthFusion.Rd b/modules/data.land/man/InventoryGrowthFusion.Rd index 92aadc13530..0a05e6594d2 100644 --- a/modules/data.land/man/InventoryGrowthFusion.Rd +++ b/modules/data.land/man/InventoryGrowthFusion.Rd @@ -4,11 +4,22 @@ \alias{InventoryGrowthFusion} \title{InventoryGrowthFusion} \usage{ -InventoryGrowthFusion(data, cov.data = NULL, time_data = NULL, - n.iter = 5000, n.chunk = n.iter, n.burn = min(n.chunk, 2000), - random = NULL, fixed = NULL, time_varying = NULL, - burnin_plot = FALSE, save.jags = "IGF.txt", z0 = NULL, - save.state = TRUE, restart = NULL) +InventoryGrowthFusion( + data, + cov.data = NULL, + time_data = NULL, + n.iter = 5000, + n.chunk = n.iter, + n.burn = min(n.chunk, 2000), + random = NULL, + fixed = NULL, + time_varying = NULL, + burnin_plot = FALSE, + save.jags = "IGF.txt", + z0 = NULL, + save.state = TRUE, + restart = NULL +) } \arguments{ \item{data}{list of data inputs} diff --git a/modules/data.land/man/dataone_download.Rd b/modules/data.land/man/dataone_download.Rd index 8b008d763dc..208110cb09c 100644 --- a/modules/data.land/man/dataone_download.Rd +++ b/modules/data.land/man/dataone_download.Rd @@ -4,8 +4,13 @@ \alias{dataone_download} \title{DataONE download} \usage{ -dataone_download(id, filepath = "/fs/data1/pecan.data/dbfiles", - CNode = "PROD", lazyLoad = FALSE, quiet = FALSE) +dataone_download( + id, + filepath = "/fs/data1/pecan.data/dbfiles", + CNode = "PROD", + lazyLoad = FALSE, + quiet = FALSE +) } \arguments{ \item{id}{"The identifier of a package, package metadata or other package member" -- dataone r} diff --git a/modules/data.land/man/download_package_rm.Rd b/modules/data.land/man/download_package_rm.Rd index b9dc7ab3cf6..212db948073 100644 --- a/modules/data.land/man/download_package_rm.Rd +++ b/modules/data.land/man/download_package_rm.Rd @@ -4,9 +4,13 @@ \alias{download_package_rm} \title{download_packages} \usage{ -download_package_rm(resource_map, directory, CNode = "PROD", +download_package_rm( + resource_map, + directory, + CNode = "PROD", download_format = "application/bagit-097", - overwrite_directory = TRUE) + overwrite_directory = TRUE +) } \arguments{ \item{resource_map}{the resource map that corresponds to the given data package} diff --git a/modules/data.land/man/ens_veg_module.Rd b/modules/data.land/man/ens_veg_module.Rd index 68dce462385..b15c9f4d76c 100644 --- a/modules/data.land/man/ens_veg_module.Rd +++ b/modules/data.land/man/ens_veg_module.Rd @@ -4,8 +4,18 @@ \alias{ens_veg_module} \title{Sampling/ensemble module} \usage{ -ens_veg_module(getveg.id, dbparms, input_veg, outfolder, machine, - start_date, end_date, n.ensemble, new_site, host) +ens_veg_module( + getveg.id, + dbparms, + input_veg, + outfolder, + machine, + start_date, + end_date, + n.ensemble, + new_site, + host +) } \arguments{ \item{getveg.id}{list, input.id and dbfile.id of the IC file in intermediate pecan standard} diff --git a/modules/data.land/man/extract_soil_gssurgo.Rd b/modules/data.land/man/extract_soil_gssurgo.Rd index f2aeaf141eb..d8231132824 100644 --- a/modules/data.land/man/extract_soil_gssurgo.Rd +++ b/modules/data.land/man/extract_soil_gssurgo.Rd @@ -4,8 +4,14 @@ \alias{extract_soil_gssurgo} \title{Extract soil data from gssurgo} \usage{ -extract_soil_gssurgo(outdir, lat, lon, size = 1, radius = 500, - depths = c(0.15, 0.3, 0.6)) +extract_soil_gssurgo( + outdir, + lat, + lon, + size = 1, + radius = 500, + depths = c(0.15, 0.3, 0.6) +) } \arguments{ \item{outdir}{Output directory for writing down the netcdf file} diff --git a/modules/data.land/man/extract_soil_nc.Rd b/modules/data.land/man/extract_soil_nc.Rd index 1567a528de5..b69e5470bcb 100644 --- a/modules/data.land/man/extract_soil_nc.Rd +++ b/modules/data.land/man/extract_soil_nc.Rd @@ -15,6 +15,9 @@ extract_soil_nc(in.file, outdir, lat, lon) \item{lon}{} } +\value{ +path to netCDF file containing extracted data +} \description{ Extract soil data } diff --git a/modules/data.land/man/extract_veg.Rd b/modules/data.land/man/extract_veg.Rd index b4d2e9d3d1b..84b18c37f79 100644 --- a/modules/data.land/man/extract_veg.Rd +++ b/modules/data.land/man/extract_veg.Rd @@ -4,9 +4,19 @@ \alias{extract_veg} \title{load_veg} \usage{ -extract_veg(new_site, start_date, end_date, source, gridres, - format_name = NULL, machine_host, dbparms, outfolder, - overwrite = FALSE, ...) +extract_veg( + new_site, + start_date, + end_date, + source, + gridres, + format_name = NULL, + machine_host, + dbparms, + outfolder, + overwrite = FALSE, + ... +) } \description{ Function queries a DB to extract veg info downstream diff --git a/modules/data.land/man/fia.to.psscss.Rd b/modules/data.land/man/fia.to.psscss.Rd index 407da71a410..14c23d93231 100644 --- a/modules/data.land/man/fia.to.psscss.Rd +++ b/modules/data.land/man/fia.to.psscss.Rd @@ -4,10 +4,16 @@ \alias{fia.to.psscss} \title{fia.to.psscss} \usage{ -fia.to.psscss(settings, lat = as.numeric(settings$run$site$lat), +fia.to.psscss( + settings, + lat = as.numeric(settings$run$site$lat), lon = as.numeric(settings$run$site$lon), - year = lubridate::year(settings$run$start.date), gridres = 0.075, - min.year = year - 5, max.year = year + 5, overwrite = FALSE) + year = lubridate::year(settings$run$start.date), + gridres = 0.075, + min.year = year - 5, + max.year = year + 5, + overwrite = FALSE +) } \arguments{ \item{create}{pss/css files based on data in the fia database} diff --git a/modules/data.land/man/gSSURGO.Query.Rd b/modules/data.land/man/gSSURGO.Query.Rd index 4eb9ddf7fff..b67d3278c38 100644 --- a/modules/data.land/man/gSSURGO.Query.Rd +++ b/modules/data.land/man/gSSURGO.Query.Rd @@ -4,8 +4,10 @@ \alias{gSSURGO.Query} \title{This function queries the gSSURGO database for a series of map unit keys} \usage{ -gSSURGO.Query(mukeys = 2747727, fields = c("chorizon.sandtotal_r", - "chorizon.silttotal_r", "chorizon.claytotal_r")) +gSSURGO.Query( + mukeys = 2747727, + fields = c("chorizon.sandtotal_r", "chorizon.silttotal_r", "chorizon.claytotal_r") +) } \arguments{ \item{mukeys}{map unit key from gssurgo} @@ -23,14 +25,16 @@ Full documention of available tables and their relationships can be found here \ There have been occasions where NRCS made some minor changes to the structure of the API which this code is where those changes need to be implemneted here. Fields need to be defined with their associate tables. For example, sandtotal is a field in chorizon table which needs to be defined as chorizon.sandotal_(r/l/h), where -r stands for the representative value, l stand for low and h stands for high. At the momeent fields from mapunit, component, muaggatt, and chorizon tables can be extracted. - -#' @examples +r stands for the representative value, l stand for low and h stands for high. At the momeent fields from mapunit, component, muaggatt, and chorizon tables can be extracted. +} +\examples{ \dontrun{ - PEcAn.data.land::gSSURGO.Query(fields = c("chorizon.cec7_r", "chorizon.sandtotal_r", - "chorizon.silttotal_r","chorizon.claytotal_r", - "chorizon.om_r","chorizon.hzdept_r","chorizon.frag3to10_r", - "chorizon.dbovendry_r","chorizon.ph1to1h2o_r", - "chorizon.cokey","chorizon.chkey")) + PEcAn.data.land::gSSURGO.Query( + fields = c( + "chorizon.cec7_r", "chorizon.sandtotal_r", + "chorizon.silttotal_r","chorizon.claytotal_r", + "chorizon.om_r","chorizon.hzdept_r","chorizon.frag3to10_r", + "chorizon.dbovendry_r","chorizon.ph1to1h2o_r", + "chorizon.cokey","chorizon.chkey")) } } diff --git a/modules/data.land/man/get_veg_module.Rd b/modules/data.land/man/get_veg_module.Rd index 400f5e53175..4f40e4ce0c6 100644 --- a/modules/data.land/man/get_veg_module.Rd +++ b/modules/data.land/man/get_veg_module.Rd @@ -4,8 +4,17 @@ \alias{get_veg_module} \title{Load/extract + match species module} \usage{ -get_veg_module(input_veg, outfolder, start_date, end_date, dbparms, - new_site, host, machine_host, overwrite) +get_veg_module( + input_veg, + outfolder, + start_date, + end_date, + dbparms, + new_site, + host, + machine_host, + overwrite +) } \arguments{ \item{input_veg}{list, this is a sublist of settings$run$inputs that has info about source, id, metadata of the requested IC file} diff --git a/modules/data.land/man/load_veg.Rd b/modules/data.land/man/load_veg.Rd index 6f04359155d..38695c7b485 100644 --- a/modules/data.land/man/load_veg.Rd +++ b/modules/data.land/man/load_veg.Rd @@ -4,9 +4,20 @@ \alias{load_veg} \title{load_veg} \usage{ -load_veg(new_site, start_date, end_date, source_id, source, - icmeta = NULL, format_name = NULL, machine_host, dbparms, outfolder, - overwrite = FALSE, ...) +load_veg( + new_site, + start_date, + end_date, + source_id, + source, + icmeta = NULL, + format_name = NULL, + machine_host, + dbparms, + outfolder, + overwrite = FALSE, + ... +) } \description{ Function uses load_data{benchmark} to get veg data diff --git a/modules/data.land/man/matchInventoryRings.Rd b/modules/data.land/man/matchInventoryRings.Rd index 13d3e8feafd..6f873832bbe 100644 --- a/modules/data.land/man/matchInventoryRings.Rd +++ b/modules/data.land/man/matchInventoryRings.Rd @@ -4,8 +4,13 @@ \alias{matchInventoryRings} \title{matchInventoryRings} \usage{ -matchInventoryRings(trees, rings, extractor = "TreeCode", nyears = 30, - coredOnly = TRUE) +matchInventoryRings( + trees, + rings, + extractor = "TreeCode", + nyears = 30, + coredOnly = TRUE +) } \description{ matchInventoryRings diff --git a/modules/data.land/man/match_pft.Rd b/modules/data.land/man/match_pft.Rd index 22f94d730a3..26c712d8b1a 100644 --- a/modules/data.land/man/match_pft.Rd +++ b/modules/data.land/man/match_pft.Rd @@ -4,8 +4,13 @@ \alias{match_pft} \title{Match model PFTs} \usage{ -match_pft(bety_species_id, pfts, query = NULL, con = NULL, - allow_missing = FALSE) +match_pft( + bety_species_id, + pfts, + query = NULL, + con = NULL, + allow_missing = FALSE +) } \arguments{ \item{bety_species_id}{vector of BETYdb species IDs} diff --git a/modules/data.land/man/match_species_id.Rd b/modules/data.land/man/match_species_id.Rd index a9f7e85ff2b..d460df24d91 100644 --- a/modules/data.land/man/match_species_id.Rd +++ b/modules/data.land/man/match_species_id.Rd @@ -4,8 +4,13 @@ \alias{match_species_id} \title{Match BETY species ID.} \usage{ -match_species_id(input_codes, format_name = "custom", bety = NULL, - translation_table = NULL, ...) +match_species_id( + input_codes, + format_name = "custom", + bety = NULL, + translation_table = NULL, + ... +) } \arguments{ \item{input_codes}{Character vector of species codes} diff --git a/modules/data.land/man/mpot2smoist.Rd b/modules/data.land/man/mpot2smoist.Rd index 16dc504105c..7d0cbb9aafb 100644 --- a/modules/data.land/man/mpot2smoist.Rd +++ b/modules/data.land/man/mpot2smoist.Rd @@ -4,14 +4,21 @@ \alias{mpot2smoist} \title{Convert a matric potential to a soil moisture} \usage{ -mpot2smoist(mpot, soil_water_potential_at_saturation, soil_hydraulic_b, - volume_fraction_of_water_in_soil_at_saturation) +mpot2smoist( + mpot, + soil_water_potential_at_saturation, + soil_hydraulic_b, + volume_fraction_of_water_in_soil_at_saturation +) } \arguments{ \item{mpot}{water potential} \item{mysoil}{soil property list} } +\value{ +volumetric soil water content +} \description{ Convert a matric potential to a soil moisture } diff --git a/modules/data.land/man/put_veg_module.Rd b/modules/data.land/man/put_veg_module.Rd index 62bdde250ca..02ac62b14a2 100644 --- a/modules/data.land/man/put_veg_module.Rd +++ b/modules/data.land/man/put_veg_module.Rd @@ -4,8 +4,22 @@ \alias{put_veg_module} \title{Match species to PFTs + veg2model module} \usage{ -put_veg_module(getveg.id, dbparms, input_veg, pfts, outfolder, n.ensemble, - dir, machine, model, start_date, end_date, new_site, host, overwrite) +put_veg_module( + getveg.id, + dbparms, + input_veg, + pfts, + outfolder, + n.ensemble, + dir, + machine, + model, + start_date, + end_date, + new_site, + host, + overwrite +) } \arguments{ \item{getveg.id}{list, input.id and dbfile.id of the IC file in intermediate pecan standard} diff --git a/modules/data.land/man/sample_ic.Rd b/modules/data.land/man/sample_ic.Rd index f5c77391fac..c1f726b9540 100644 --- a/modules/data.land/man/sample_ic.Rd +++ b/modules/data.land/man/sample_ic.Rd @@ -4,8 +4,17 @@ \alias{sample_ic} \title{sample_ic} \usage{ -sample_ic(in.path, in.name, start_date, end_date, outfolder, n.ensemble, - machine_host, source, ...) +sample_ic( + in.path, + in.name, + start_date, + end_date, + outfolder, + n.ensemble, + machine_host, + source, + ... +) } \arguments{ \item{in.path}{path to folder of the file to be sampled} diff --git a/modules/data.land/man/sclass.Rd b/modules/data.land/man/sclass.Rd index 0fb6fa044ad..7a0ee3e41a5 100644 --- a/modules/data.land/man/sclass.Rd +++ b/modules/data.land/man/sclass.Rd @@ -11,6 +11,11 @@ sclass(sandfrac, clayfrac) \item{clayfrac}{} } +\value{ +vector of integers identifying textural class of each input layer. + Possible values are 1 through 17; NB these are NOT the same class + boundaries as the 12 USDA soil texture classes. +} \description{ This function determines the soil class number based on the fraction of sand, clay, and silt } diff --git a/modules/data.land/man/shp2kml.Rd b/modules/data.land/man/shp2kml.Rd index 8a1e52e3f1d..afae5b612e8 100644 --- a/modules/data.land/man/shp2kml.Rd +++ b/modules/data.land/man/shp2kml.Rd @@ -4,8 +4,15 @@ \alias{shp2kml} \title{Convert shapefile to KML} \usage{ -shp2kml(dir, ext, kmz = FALSE, proj4 = NULL, color = NULL, - NameField = NULL, out.dir = NULL) +shp2kml( + dir, + ext, + kmz = FALSE, + proj4 = NULL, + color = NULL, + NameField = NULL, + out.dir = NULL +) } \arguments{ \item{dir}{Directory of GIS shapefiles to convert to kml/kmz} diff --git a/modules/data.land/man/soil.units.Rd b/modules/data.land/man/soil.units.Rd index c582332cbe8..2607af0e836 100644 --- a/modules/data.land/man/soil.units.Rd +++ b/modules/data.land/man/soil.units.Rd @@ -9,6 +9,9 @@ soil.units(varname = NA) \arguments{ \item{varname}{} } +\value{ +character +} \description{ Get standard units for a soil variable } diff --git a/modules/data.land/man/soil_params.Rd b/modules/data.land/man/soil_params.Rd index 4bddee1a6ef..4fa1ae61e10 100644 --- a/modules/data.land/man/soil_params.Rd +++ b/modules/data.land/man/soil_params.Rd @@ -4,8 +4,13 @@ \alias{soil_params} \title{Estimate soil parameters from texture class or sand/silt/clay} \usage{ -soil_params(soil_type = NULL, sand = NULL, silt = NULL, - clay = NULL, bulk = NULL) +soil_params( + soil_type = NULL, + sand = NULL, + silt = NULL, + clay = NULL, + bulk = NULL +) } \arguments{ \item{soil_type}{USDA Soil Class. See Details} diff --git a/modules/data.land/man/soil_process.Rd b/modules/data.land/man/soil_process.Rd index 43c657884f0..db7b568d5ce 100644 --- a/modules/data.land/man/soil_process.Rd +++ b/modules/data.land/man/soil_process.Rd @@ -4,8 +4,7 @@ \alias{soil_process} \title{Module for managing soil texture extraction} \usage{ -soil_process(settings, input, dbfiles, overwrite = FALSE, - run.local = TRUE) +soil_process(settings, input, dbfiles, overwrite = FALSE, run.local = TRUE) } \arguments{ \item{settings}{PEcAn settings list} diff --git a/modules/data.land/man/subset.layer.Rd b/modules/data.land/man/subset_layer.Rd similarity index 79% rename from modules/data.land/man/subset.layer.Rd rename to modules/data.land/man/subset_layer.Rd index 5a6de814fe2..a147dd48c62 100644 --- a/modules/data.land/man/subset.layer.Rd +++ b/modules/data.land/man/subset_layer.Rd @@ -1,12 +1,18 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gis.functions.R -\name{subset.layer} -\alias{subset.layer} +\name{subset_layer} +\alias{subset_layer} \title{Function to subset and clip a GIS vector or raster layer by a bounding box or clip/subset layer (e.g. shapefile/KML)} \usage{ -\method{subset}{layer}(file, coords = NULL, sub.layer = NULL, - clip = FALSE, out.dir = NULL, out.name = NULL) +subset_layer( + file, + coords = NULL, + sub.layer = NULL, + clip = FALSE, + out.dir = NULL, + out.name = NULL +) } \arguments{ \item{file}{input file to be subset} @@ -33,9 +39,9 @@ or clip/subset layer (e.g. shapefile/KML) file <- Sys.glob(file.path(R.home(), 'library', 'PEcAn.data.land','data','*.shp')) out.dir <- path.expand('~/temp') # with clipping enabled -subset.layer(file=file,coords=c(-95,42,-84,47),clip=TRUE,out.dir=out.dir) +subset_layer(file=file,coords=c(-95,42,-84,47),clip=TRUE,out.dir=out.dir) # without clipping enables -subset.layer(file=file,coords=c(-95,42,-84,47),out.dir=out.dir) +subset_layer(file=file,coords=c(-95,42,-84,47),out.dir=out.dir) system(paste('rm -r',out.dir,sep='')) } diff --git a/modules/data.land/man/write_ic.Rd b/modules/data.land/man/write_ic.Rd index 00837f4455d..09f519124af 100644 --- a/modules/data.land/man/write_ic.Rd +++ b/modules/data.land/man/write_ic.Rd @@ -4,8 +4,19 @@ \alias{write_ic} \title{write_ic} \usage{ -write_ic(in.path, in.name, start_date, end_date, outfolder, model, - new_site, pfts, source = input_veg$source, overwrite = FALSE, ...) +write_ic( + in.path, + in.name, + start_date, + end_date, + outfolder, + model, + new_site, + pfts, + source = input_veg$source, + overwrite = FALSE, + ... +) } \description{ write_ic diff --git a/modules/data.land/man/write_veg.Rd b/modules/data.land/man/write_veg.Rd index 27efd6e70a1..b50d4165f50 100644 --- a/modules/data.land/man/write_veg.Rd +++ b/modules/data.land/man/write_veg.Rd @@ -6,6 +6,15 @@ \usage{ write_veg(outfolder, start_date, veg_info, source) } +\arguments{ +\item{outfolder}{output folder} + +\item{start_date}{start date} + +\item{veg_info}{vegetation data to be saved} + +\item{source}{name of data source (used in file naming)} +} \description{ Function to save intermediate rds file } diff --git a/modules/data.land/tests/Rcheck_reference.log b/modules/data.land/tests/Rcheck_reference.log new file mode 100644 index 00000000000..a635142754a --- /dev/null +++ b/modules/data.land/tests/Rcheck_reference.log @@ -0,0 +1,1336 @@ +* using log directory ‘/tmp/Rtmp9ipF88/PEcAn.data.land.Rcheck’ +* using R version 4.0.2 (2020-06-22) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-manual --as-cran’ +* checking for file ‘PEcAn.data.land/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.data.land’ version ‘1.7.1’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... NOTE +Imports includes 31 non-default packages. +Importing from so many packages makes the package vulnerable to any of +them becoming unavailable. Move as many as possible to Suggests and +use conditionally. +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.data.land’ can be installed ... WARNING +Found the following significant warnings: + Note: possible error in 'write_veg(outfolder, ': unused argument (source) +See ‘/tmp/Rtmp9ipF88/PEcAn.data.land.Rcheck/00install.out’ for details. +Information on the location(s) of code generating the ‘Note’s can be +obtained by re-running with environment variable R_KEEP_PKG_SOURCE set +to ‘yes’. +* checking installed package size ... NOTE + installed size is 13.4Mb + sub-directories of 1Mb or more: + data 9.4Mb + FIA_allometry 2.7Mb +* checking package directory ... OK +* checking for future file timestamps ... OK +* checking DESCRIPTION meta-information ... OK +* checking top-level files ... NOTE +Non-standard file/directory found at top level: + ‘contrib’ +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... OK +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +dataone_download: no visible binding for '<<-' assignment to + ‘newdir_D1’ +dataone_download: no visible binding for global variable ‘newdir_D1’ +diametergrow : di.update_new: no visible binding for global variable + ‘aa’ +diametergrow : di.update: no visible global function definition for + ‘runif’ +diametergrow: no visible binding for global variable ‘settings’ +diametergrow: no visible global function definition for ‘lines’ +diametergrow: no visible global function definition for ‘density’ +diametergrow: no visible global function definition for ‘dgamma’ +diametergrow: no visible global function definition for ‘title’ +diametergrow: no visible global function definition for ‘text’ +diametergrow: no visible global function definition for ‘abline’ +diametergrow: no visible global function definition for ‘points’ +download_package_rm: no visible binding for '<<-' assignment to ‘mnId’ +download_package_rm: no visible binding for '<<-' assignment to ‘mn’ +download_package_rm: no visible binding for global variable ‘mnId’ +download_package_rm: no visible binding for '<<-' assignment to + ‘bagitFile’ +download_package_rm: no visible binding for global variable ‘mn’ +download_package_rm: no visible binding for '<<-' assignment to + ‘zip_contents’ +download_package_rm: no visible binding for global variable ‘bagitFile’ +download_package_rm: no visible binding for global variable + ‘zip_contents’ +ens_veg_module: no visible global function definition for ‘db.close’ +ens_veg_module: no visible global function definition for ‘db.query’ +ens_veg_module: no visible global function definition for + ‘convert.input’ +EPA_ecoregion_finder: no visible global function definition for + ‘as_Spatial’ +extract_FIA: no visible global function definition for ‘db.close’ +extract_FIA: no visible global function definition for ‘db.query’ +extract_soil_gssurgo: no visible global function definition for ‘as’ +extract_soil_gssurgo: no visible binding for global variable ‘hzdept_r’ +extract_soil_gssurgo: no visible binding for global variable + ‘comppct_r’ +extract_soil_gssurgo: no visible global function definition for + ‘complete.cases’ +extract_soil_gssurgo: no visible global function definition for + ‘setNames’ +extract_soil_gssurgo: no visible global function definition for + ‘mutate’ +extract_soil_gssurgo : : no visible binding for global + variable ‘.’ +extract_soil_gssurgo : : no visible global function + definition for ‘mutate’ +extract_soil_gssurgo: no visible global function definition for + ‘filter’ +extract_soil_gssurgo: no visible binding for global variable ‘Area’ +extract_soil_gssurgo: no visible binding for global variable ‘.’ +extract_soil_gssurgo : : : no visible binding + for global variable ‘.’ +extract_soil_gssurgo : : no visible global function + definition for ‘setNames’ +extract_soil_nc: no visible global function definition for ‘median’ +extract_veg: possible error in write_veg(outfolder, start_date, + end_date, veg_info = veg_info, source): unused argument (source) +fia.to.psscss: no visible global function definition for ‘data’ +fia.to.psscss: no visible binding for global variable ‘pftmapping’ +fia.to.psscss: no visible global function definition for ‘na.omit’ +fia.to.psscss: no visible global function definition for ‘median’ +fia.to.psscss: no visible global function definition for ‘write.table’ +fia.to.psscss: no visible global function definition for + ‘dbfile.input.insert’ +find.land: no visible global function definition for ‘data’ +find.land: no visible binding for global variable ‘wrld_simpl’ +find.land: no visible global function definition for ‘over’ +find.land: no visible binding for global variable ‘land’ +format_identifier: no visible binding for '<<-' assignment to ‘doi1’ +format_identifier: no visible binding for global variable ‘doi1’ +get_resource_map: no visible binding for '<<-' assignment to ‘mnId’ +get_resource_map: no visible binding for '<<-' assignment to ‘mn’ +get_resource_map: no visible binding for global variable ‘mnId’ +get_resource_map: no visible binding for global variable ‘doi1’ +get_resource_map: no visible binding for '<<-' assignment to + ‘resource_map’ +get_resource_map: no visible binding for global variable ‘resource_map’ +get_veg_module: no visible global function definition for + ‘convert.input’ +get_veg_module: no visible binding for global variable ‘input’ +get_veg_module: no visible binding for global variable ‘new.site’ +gSSURGO.Query: no visible global function definition for ‘xmlTreeParse’ +gSSURGO.Query: no visible global function definition for ‘xmlRoot’ +gSSURGO.Query: no visible global function definition for ‘getNodeSet’ +gSSURGO.Query : : no visible global function definition for + ‘xmlToList’ +gSSURGO.Query: no visible binding for global variable ‘comppct_r’ +gSSURGO.Query: no visible binding for global variable ‘mukey’ +gSSURGO.Query: no visible binding for global variable ‘aws050wta’ +ic_process: no visible global function definition for ‘db.close’ +ic_process: no visible global function definition for ‘db.query’ +id_resolveable: no visible binding for global variable ‘doi1’ +InventoryGrowthFusion: no visible global function definition for + ‘is.mcmc.list’ +InventoryGrowthFusion: no visible global function definition for + ‘mcmc.list2init’ +InventoryGrowthFusion: no visible global function definition for + ‘runif’ +InventoryGrowthFusion: no visible global function definition for ‘var’ +InventoryGrowthFusion: no visible global function definition for + ‘load.module’ +InventoryGrowthFusion: no visible global function definition for + ‘coda.samples’ +InventoryGrowthFusion: no visible global function definition for + ‘as.mcmc.list’ +InventoryGrowthFusion : : no visible global function + definition for ‘coef’ +InventoryGrowthFusion : : no visible global function + definition for ‘lm’ +InventoryGrowthFusionDiagnostics: no visible binding for global + variable ‘quantile’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘layout’ +InventoryGrowthFusionDiagnostics: no visible binding for global + variable ‘data’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘points’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘par’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘hist’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘abline’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘pairs’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘as.mcmc.list’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘gelman.diag’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘cor’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘lines’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘boxplot’ +InventoryGrowthFusionDiagnostics: no visible global function definition + for ‘legend’ +is.land: no visible binding for global variable ‘met.nc’ +match_species_id: no visible binding for global variable ‘id’ +match_species_id: no visible binding for global variable ‘genus’ +match_species_id: no visible binding for global variable ‘species’ +matchInventoryRings: no visible global function definition for + ‘combine.rwl’ +matchInventoryRings: no visible global function definition for + ‘write.table’ +plot2AGB: no visible global function definition for ‘txtProgressBar’ +plot2AGB: no visible global function definition for ‘setTxtProgressBar’ +plot2AGB: no visible binding for global variable ‘sd’ +plot2AGB: no visible global function definition for ‘pdf’ +plot2AGB: no visible global function definition for ‘par’ +plot2AGB: no visible global function definition for ‘lines’ +put_veg_module: no visible global function definition for ‘db.close’ +put_veg_module: no visible global function definition for ‘db.query’ +put_veg_module: no visible global function definition for + ‘convert.input’ +Read.IC.info.BADM: no visible global function definition for ‘read.csv’ +Read.IC.info.BADM: no visible binding for global variable ‘NA_L2CODE’ +Read.IC.info.BADM: no visible binding for global variable ‘VARIABLE’ +Read.IC.info.BADM: no visible binding for global variable ‘.’ +Read.IC.info.BADM: no visible binding for global variable ‘SITE_ID’ +Read.IC.info.BADM: no visible binding for global variable ‘GROUP_ID’ +Read.IC.info.BADM: no visible binding for global variable + ‘VARIABLE_GROUP’ +Read.IC.info.BADM: no visible binding for global variable ‘DATAVALUE’ +Read.IC.info.BADM: no visible binding for global variable ‘NA_L1CODE’ +Read.IC.info.BADM : : no visible binding for global variable + ‘VARIABLE’ +Read.IC.info.BADM : : no visible binding for global variable + ‘.’ +Read.IC.info.BADM : : no visible binding for global variable + ‘DATAVALUE’ +read.plot: no visible global function definition for ‘read.csv’ +read.velmex: no visible global function definition for ‘read.fwf’ +sample_ic: no visible global function definition for ‘complete.cases’ +soil_params: no visible binding for global variable ‘soil.name’ +soil_params: no visible binding for global variable ‘xsand.def’ +soil_params: no visible binding for global variable ‘xclay.def’ +soil_params: no visible binding for global variable ‘fieldcp.K’ +soil_params: no visible binding for global variable ‘soilcp.MPa’ +soil_params: no visible binding for global variable ‘grav’ +soil_params: no visible binding for global variable ‘soilwp.MPa’ +soil_params: no visible binding for global variable ‘sand.hcap’ +soil_params: no visible binding for global variable ‘silt.hcap’ +soil_params: no visible binding for global variable ‘clay.hcap’ +soil_params: no visible binding for global variable ‘air.hcap’ +soil_params: no visible binding for global variable ‘ksand’ +soil_params: no visible binding for global variable ‘sand.cond’ +soil_params: no visible binding for global variable ‘ksilt’ +soil_params: no visible binding for global variable ‘silt.cond’ +soil_params: no visible binding for global variable ‘kclay’ +soil_params: no visible binding for global variable ‘clay.cond’ +soil_params: no visible binding for global variable ‘kair’ +soil_params: no visible binding for global variable ‘air.cond’ +soil_params: no visible binding for global variable ‘h2o.cond’ +soil_params: no visible binding for global variable ‘texture’ +soil_params: no visible global function definition for ‘median’ +soil_process: no visible global function definition for ‘db.query’ +write_ic: no visible binding for global variable ‘input_veg’ +Undefined global functions or variables: + . aa abline air.cond air.hcap Area as as_Spatial as.mcmc.list + aws050wta bagitFile boxplot clay.cond clay.hcap coda.samples coef + combine.rwl complete.cases comppct_r convert.input cor data DATAVALUE + db.close db.query dbfile.input.insert density dgamma doi1 fieldcp.K + filter gelman.diag genus getNodeSet grav GROUP_ID h2o.cond hist + hzdept_r id input input_veg is.mcmc.list kair kclay ksand ksilt land + layout legend lines lm load.module mcmc.list2init median met.nc mn + mnId mukey mutate NA_L1CODE NA_L2CODE na.omit new.site newdir_D1 over + pairs par pdf pftmapping points quantile read.csv read.fwf + resource_map runif sand.cond sand.hcap sd setNames settings + setTxtProgressBar silt.cond silt.hcap SITE_ID soil.name soilcp.MPa + soilwp.MPa species text texture title txtProgressBar var VARIABLE + VARIABLE_GROUP write.table wrld_simpl xclay.def xmlRoot xmlToList + xmlTreeParse xsand.def zip_contents +Consider adding + importFrom("graphics", "abline", "boxplot", "hist", "layout", "legend", + "lines", "pairs", "par", "points", "text", "title") + importFrom("grDevices", "pdf") + importFrom("methods", "as") + importFrom("stats", "coef", "complete.cases", "cor", "density", + "dgamma", "filter", "lm", "median", "na.omit", "quantile", + "runif", "sd", "setNames", "var") + importFrom("utils", "data", "read.csv", "read.fwf", + "setTxtProgressBar", "txtProgressBar", "write.table") +to your NAMESPACE file (and ensure that your DESCRIPTION Imports field +contains 'methods'). + +Found the following calls to data() loading into the global environment: +File ‘PEcAn.data.land/R/fia2ED.R’: + data(pftmapping) +See section ‘Good practice’ in ‘?data’. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... NOTE +Rd file 'dataone_download.Rd': + \examples lines wider than 100 characters: + dataone_download(id = "doi:10.6073/pasta/63ad7159306bc031520f09b2faefcf87", filepath = "/fs/data1/pecan.data/dbfiles") + +These lines will be truncated in the PDF manual. +* checking Rd cross-references ... WARNING +Missing link or links in documentation object 'EPA_ecoregion_finder.Rd': + ‘https://www.epa.gov/eco-research/ecoregions’ + +See section 'Cross-references' in the 'Writing R Extensions' manual. + +* checking for missing documentation entries ... WARNING +Undocumented data sets: + ‘BADM’ ‘.extract.nc.module’ ‘.getRunSettings’ ‘.met2model.module’ + ‘.Random.seed’ ‘air.cond’ ‘air.hcap’ ‘clay.cond’ ‘clay.hcap’ + ‘clay.now’ ‘fieldcp.K’ ‘grav’ ‘h2o.cond’ ‘kair’ ‘kclay’ ‘ksand’ + ‘ksilt’ ‘n’ ‘nstext.lines’ ‘nstext.polygon’ ‘sand.cond’ ‘sand.hcap’ + ‘sand.now’ ‘silt.cond’ ‘silt.hcap’ ‘soil.key’ ‘soil.name’ + ‘soilcp.MPa’ ‘soilld.MPa’ ‘soilwp.MPa’ ‘stext.lines’ ‘stext.polygon’ + ‘texture’ ‘theta.crit’ ‘xclay.def’ ‘xsand.def’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'Clean_Tucson' + ‘file’ + +Undocumented arguments in documentation object 'InventoryGrowthFusion' + ‘cov.data’ ‘time_data’ ‘n.iter’ ‘fixed’ ‘time_varying’ ‘burnin_plot’ + ‘save.jags’ ‘z0’ + +Undocumented arguments in documentation object 'Read_Tucson' + ‘folder’ + +Undocumented arguments in documentation object 'extract.stringCode' + ‘x’ ‘extractor’ + +Undocumented arguments in documentation object 'extract_FIA' + ‘lon’ ‘lat’ ‘start_date’ ‘end_date’ ‘gridres’ ‘dbparms’ + +Undocumented arguments in documentation object 'extract_veg' + ‘new_site’ ‘start_date’ ‘end_date’ ‘source’ ‘gridres’ ‘format_name’ + ‘machine_host’ ‘dbparms’ ‘outfolder’ ‘overwrite’ ‘...’ + +Undocumented arguments in documentation object 'fia.to.psscss' + ‘settings’ ‘lat’ ‘lon’ ‘year’ ‘gridres’ ‘min.year’ ‘max.year’ + ‘overwrite’ +Documented arguments not in \usage in documentation object 'fia.to.psscss': + ‘create’ + +Undocumented arguments in documentation object 'find.land' + ‘plot’ + +Undocumented arguments in documentation object 'from.Tag' + ‘x’ + +Undocumented arguments in documentation object 'from.TreeCode' + ‘x’ + +Undocumented arguments in documentation object 'ic_process' + ‘input’ ‘dir’ +Documented arguments not in \usage in documentation object 'ic_process': + ‘dbfiles’ + +Undocumented arguments in documentation object 'load_veg' + ‘new_site’ ‘start_date’ ‘end_date’ ‘source_id’ ‘source’ ‘icmeta’ + ‘format_name’ ‘machine_host’ ‘dbparms’ ‘outfolder’ ‘overwrite’ ‘...’ + +Undocumented arguments in documentation object 'matchInventoryRings' + ‘trees’ ‘rings’ ‘extractor’ ‘nyears’ ‘coredOnly’ + +Undocumented arguments in documentation object 'match_pft' + ‘query’ + +Undocumented arguments in documentation object 'match_species_id' + ‘...’ + +Undocumented arguments in documentation object 'mpot2smoist' + ‘soil_water_potential_at_saturation’ ‘soil_hydraulic_b’ + ‘volume_fraction_of_water_in_soil_at_saturation’ +Documented arguments not in \usage in documentation object 'mpot2smoist': + ‘mysoil’ + +Undocumented arguments in documentation object 'netcdf.writer.BADM' + ‘ens’ + +Undocumented arguments in documentation object 'plot2AGB' + ‘allom.stats’ + +Undocumented arguments in documentation object 'pool_ic_list2netcdf' + ‘ens’ + +Undocumented arguments in documentation object 'sample_ic' + ‘...’ + +Undocumented arguments in documentation object 'soil_process' + ‘run.local’ + +Undocumented arguments in documentation object 'to.Tag' + ‘SITE’ ‘PLOT’ ‘SUBPLOT’ ‘TAG’ + +Undocumented arguments in documentation object 'to.TreeCode' + ‘SITE’ ‘PLOT’ ‘SUBPLOT’ ‘TAG’ + +Undocumented arguments in documentation object 'write_ic' + ‘in.path’ ‘in.name’ ‘start_date’ ‘end_date’ ‘outfolder’ ‘model’ + ‘new_site’ ‘pfts’ ‘source’ ‘overwrite’ ‘...’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'dataone_download': + ‘CNode’ + +Argument items with no description in Rd object 'extract_soil_nc': + ‘in.file’ ‘outdir’ ‘lat’ ‘lon’ + +Argument items with no description in Rd object 'sclass': + ‘sandfrac’ ‘clayfrac’ + +Argument items with no description in Rd object 'soil.units': + ‘varname’ + +Argument items with no description in Rd object 'soil2netcdf': + ‘new.file’ + +* checking for unstated dependencies in examples ... OK +* checking contents of ‘data’ directory ... WARNING +Files not of a type allowed in a ‘data’ directory: + ‘eco-region.json’ ‘eco-regionl2.json’ ‘lake_states_wgs84.dbf’ + ‘lake_states_wgs84.kml’ ‘lake_states_wgs84.prj’ + ‘lake_states_wgs84.qpj’ ‘lake_states_wgs84.shp’ + ‘lake_states_wgs84.shx’ +Please use e.g. ‘inst/extdata’ for non-R data files + +Object named ‘.Random.seed’ found in dataset: ‘soil_class’ +Please remove it. +* checking data for non-ASCII characters ... WARNING + Warning: found non-ASCII strings + 'US-Bar,272,44.0646,-71.2881,NA,4297,GRP_LOCATION,LOCATION_COMMENT,... Bartlett Experimental Forest. ...The correct location is 44 deg 3' 52.702794\ N [NOT 43 deg as I had earlier specified] 71 deg 17 17.0766744\" W","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24353,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_CRS","1100","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24353,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_FINE","900","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24353,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_TOT","2000","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24353,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_UNIT","gC m-2","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24353,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_COMMENT","See: Ruth D. Yanai, Byung B. Park, and Steven P. Hamburg. 2006. The vertical and horizontal distribution of roots in northern hardwood stands of varying age. Can. J. For. Res. 36: 450-459. and Byung B. Park, Ruth D. Yanai, Matthew A. Vadeboncoeur, and Steven P. Hamburg. 2007. Estimating root biomass in rocky soils using pits, cores, and allometric equations. Soil Science Society of America Journal.","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23726,"GRP_SOIL_CHEM","SOIL_CHEM_C_ORG","5","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23726,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","10","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23726,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","30","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23726,"GRP_SOIL_CHEM","SOIL_CHEM_DATE","2004-07-29","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23726,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","mineral","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24095,"GRP_SOIL_CHEM","SOIL_CHEM_C_ORG","18","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24095,"GRP_SOIL_CHEM","SOIL_CHEM_DATE","2004-07-29","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24095,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Forest floor","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24755,"GRP_SOIL_CHEM","SOIL_CHEM_C_ORG","11","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24755,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24755,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","10","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24755,"GRP_SOIL_CHEM","SOIL_CHEM_DATE","2004-07-29","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24755,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","mineral soil","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,29625,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Spodosol","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,29625,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23780,"GRP_SOIL_DEPTH","SOIL_DEPTH","100","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23780,"GRP_SOIL_DEPTH","SOIL_DEPTH_COMMENT","<1m","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24546,"GRP_SOIL_DEPTH","SOIL_DEPTH","7","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23725,"GRP_SOIL_TEX","SOIL_TEX_SAND","74","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23725,"GRP_SOIL_TEX","SOIL_TEX_SILT","23","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23725,"GRP_SOIL_TEX","SOIL_TEX_CLAY","4","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,23725,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","data from Bartlett Experimental Forest, but not within tower footprint. Texture is for shallow-C layer material.","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24634,"GRP_WD_BIOMASS","WD_BIOMASS_CRS","900","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24634,"GRP_WD_BIOMASS","WD_BIOMASS_UNIT","gC m-2","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24634,"GRP_WD_BIOMASS","WD_BIOMASS_DATE","2004-07-29","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-Bar","272",44.0646,-71.2881,NA,24634,"GRP_WD_BIOMASS","WD_BIOMASS_COMMENT","Line intersect sampling","5","NORTHERN FORESTS","5.3","ATLANTIC HIGHLANDS" + "US-BdA",NA,35.8089,-90.0327,NA,13313,"GRP_LOCATION","LOCATION_LAT","35.8089","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-BdA",NA,35.8089,-90.0327,NA,13313,"GRP_LOCATION","LOCATION_LONG","-90.0327","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-BdC",NA,35.8089,-90.0284,NA,13331,"GRP_LOCATION","LOCATION_LAT","35.8089","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-BdC",NA,35.8089,-90.0284,NA,13331,"GRP_LOCATION","LOCATION_LONG","-90.0284","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Bi1","-3.92",38.1022,-121.5042,2016-08-11,30366,"GRP_LOCATION","LOCATION_LAT","38.1022","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bi1","-3.92",38.1022,-121.5042,2016-08-11,30366,"GRP_LOCATION","LOCATION_LONG","-121.5042","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bi1","-3.92",38.1022,-121.5042,2016-08-11,30366,"GRP_LOCATION","LOCATION_ELEV","-3.92","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bi1","-3.92",38.1022,-121.5042,2016-08-11,30366,"GRP_LOCATION","LOCATION_DATE_START","2016-08-11","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bi2","-4.98",38.109,-121.535,2017-04-26,31269,"GRP_LOCATION","LOCATION_LAT","38.1090","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bi2","-4.98",38.109,-121.535,2017-04-26,31269,"GRP_LOCATION","LOCATION_LONG","-121.5350","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bi2","-4.98",38.109,-121.535,2017-04-26,31269,"GRP_LOCATION","LOCATION_ELEV","-4.98","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bi2","-4.98",38.109,-121.535,2017-04-26,31269,"GRP_LOCATION","LOCATION_DATE_START","2017-04-26","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Bkg","510",44.3453,-96.8362,NA,6677,"GRP_LOCATION","LOCATION_LAT","44.3453","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Bkg","510",44.3453,-96.8362,NA,6677,"GRP_LOCATION","LOCATION_LONG","-96.8362","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Bkg","510",44.3453,-96.8362,NA,6677,"GRP_LOCATION","LOCATION_ELEV","510","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Bkg","510",44.3453,-96.8362,NA,6677,"GRP_LOCATION","LOCATION_COMMENT","http://public.ornl.gov/ameriflux/Site_Info/siteInfo.cfm?KEYID=us.brookings.01","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Bkg","510",44.3453,-96.8362,NA,27729,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Deep, well drained clay loams","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Bkg","510",44.3453,-96.8362,NA,27729,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Blk","1718",44.158,-103.65,NA,4244,"GRP_LOCATION","LOCATION_LAT","44.1580","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blk","1718",44.158,-103.65,NA,4244,"GRP_LOCATION","LOCATION_LONG","-103.6500","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blk","1718",44.158,-103.65,NA,4244,"GRP_LOCATION","LOCATION_ELEV","1718","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,23665,"GRP_BIOMASS_CHEM","BIOMASS_N","0.14","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,23665,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,23665,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,23665,"GRP_BIOMASS_CHEM","BIOMASS_SPP","(All)","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,23665,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","see extra data file US-Blo_Ncontent_leaves.xls","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,14394,"GRP_LOCATION","LOCATION_LAT","38.8953","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,14394,"GRP_LOCATION","LOCATION_LONG","-120.6328","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,14394,"GRP_LOCATION","LOCATION_ELEV","1315","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24434,"GRP_SOIL_CHEM","SOIL_CHEM_BD","0.76","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24434,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24434,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","10","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24434,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,28430,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Fine-loamy, mixed, mesic, ultic haploxeralf in the Cohasset series whose parent material was andesitic lahar. Relatively uniform, comprised predominantly of loam or clay-loam. The soil is comprised of 60% sand, 29% loam and 11% clay with a pH of 5.5.","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,28430,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,23802,"GRP_SOIL_DEPTH","SOIL_DEPTH","10","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24300,"GRP_SOIL_DEPTH","SOIL_DEPTH","200","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24300,"GRP_SOIL_DEPTH","SOIL_DEPTH_COMMENT","at least 2 m","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24189,"GRP_SOIL_TEX","SOIL_TEX_SAND","60","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24189,"GRP_SOIL_TEX","SOIL_TEX_SILT","29","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24189,"GRP_SOIL_TEX","SOIL_TEX_CLAY","11","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24189,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MIN","0","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24189,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MAX","10","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Blo","1315",38.8953,-120.6328,NA,24189,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","A","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Bo1","219",40.0062,-88.2904,NA,4521,"GRP_LOCATION","LOCATION_LAT","40.0062","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,4521,"GRP_LOCATION","LOCATION_LONG","-88.2904","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,4521,"GRP_LOCATION","LOCATION_ELEV","219","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,24811,"GRP_SOIL_CHEM","SOIL_CHEM_BD","1.4","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,24811,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,24811,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Meyers et al 2004: Measurements of soil bulk density average <89><88>1.4Mgm<88><92>3.","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,24812,"GRP_SOIL_CHEM","SOIL_CHEM_BD","1.4","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,24812,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","B","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,24812,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Meyers et al 2004: Measurements of soil bulk density average <89><88>1.4Mgm<88><92>3.","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,27186,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Slit loam","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo1","219",40.0062,-88.2904,NA,27186,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,2009,"GRP_LOCATION","LOCATION_LAT","40.0090","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,2009,"GRP_LOCATION","LOCATION_LONG","-88.2900","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,2009,"GRP_LOCATION","LOCATION_ELEV","219","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,2009,"GRP_LOCATION","LOCATION_COMMENT","N; ftp://cdiac.ornl.gov/pub/ameriflux/data/Level1/Sites_ByName/Bondville_Companion_Site/BP08_DAT.LABELS","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,24678,"GRP_SOIL_CHEM","SOIL_CHEM_BD","1.4","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,24678,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","B","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,24678,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Meyers et al 2004: Measurements of soil bulk density average <89><88>1.4Mgm<88><92>3.","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,25064,"GRP_SOIL_CHEM","SOIL_CHEM_BD","1.4","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,25064,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,25064,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Meyers et al 2004: Measurements of soil bulk density average <89><88>1.4Mgm<88><92>3.","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,24023,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Argiudolls ,Haplaquolls","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,24023,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Bo2","219",40.009,-88.29,NA,24023,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_COMMENT","Meyers et al 2004: The field contains three soil series: Dana (Fine-silty, mixed, mesic, Typic Argiudolls), Flanagan (Fine, montmorillonitic, mesic, Aquic Argiudolls), and Drummer (Fine-silty, mixed, mesic, Typic Haplaquolls)","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-Br1","313",41.9749,-93.6906,NA,30048,"GRP_LOCATION","LOCATION_LAT","41.9749","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br1","313",41.9749,-93.6906,NA,30048,"GRP_LOCATION","LOCATION_LONG","-93.6906","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br1","313",41.9749,-93.6906,NA,30048,"GRP_LOCATION","LOCATION_ELEV","313","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br1","313",41.9749,-93.6906,NA,28814,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Soil morphology is based on local topographic orientation. Soils within depressions are characterized by poorly drained clay material while the upslope soils are better drained. All soils are dominantly Clarion-Nicollet-Webster, fine textured with moderate to high organic matter content.","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br1","313",41.9749,-93.6906,NA,28814,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br2","314",41.9757,-93.6925,NA,8375,"GRP_LOCATION","LOCATION_LAT","41.9757","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br2","314",41.9757,-93.6925,NA,8375,"GRP_LOCATION","LOCATION_LONG","-93.6925","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br2","314",41.9757,-93.6925,NA,8375,"GRP_LOCATION","LOCATION_ELEV","314","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br2","314",41.9757,-93.6925,NA,27490,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Soil morphology is based on local topographic orientation. Soils within depressions are characterized by poorly drained clay material while the upslope soils are better drained. All soils are dominantly Clarion-Nicollet-Webster, fine textured with moderate to high organic matter content.","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br2","314",41.9757,-93.6925,NA,27490,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br3","313",41.9747,-93.6936,NA,7512,"GRP_LOCATION","LOCATION_LAT","41.9747","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br3","313",41.9747,-93.6936,NA,7512,"GRP_LOCATION","LOCATION_LONG","-93.6936","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br3","313",41.9747,-93.6936,NA,7512,"GRP_LOCATION","LOCATION_ELEV","313","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br3","313",41.9747,-93.6936,NA,28815,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Soil morphology is based on local topographic orientation. Soils within depressions are characterized by poorly drained clay material while the upslope soils are better drained. All soils are dominantly Clarion-Nicollet-Webster, fine textured with moderate to high organic matter content.","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-Br3","313",41.9747,-93.6936,NA,28815,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","9","GREAT PLAINS","9.2","TEMPERATE PRAIRIES" + "US-BRG","180",39.2167,-86.5406,2015-11-25,30568,"GRP_LOCATION","LOCATION_LAT","39.2167","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-BRG","180",39.2167,-86.5406,2015-11-25,30568,"GRP_LOCATION","LOCATION_LONG","-86.5406","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-BRG","180",39.2167,-86.5406,2015-11-25,30568,"GRP_LOCATION","LOCATION_ELEV","180","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-BRG","180",39.2167,-86.5406,2015-11-25,30568,"GRP_LOCATION","LOCATION_DATE_START","2015-11-25","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Bsg","1398",43.4712,-119.6909,NA,16087,"GRP_LOCATION","LOCATION_LAT","43.4712","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-Bsg","1398",43.4712,-119.6909,NA,16087,"GRP_LOCATION","LOCATION_LONG","-119.6909","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-Bsg","1398",43.4712,-119.6909,NA,16087,"GRP_LOCATION","LOCATION_ELEV","1398","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-BSM","0.5",41.7297,-70.3644,NA,31119,"GRP_LOCATION","LOCATION_LAT","41.7297","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-BSM","0.5",41.7297,-70.3644,NA,31119,"GRP_LOCATION","LOCATION_LONG","-70.3644","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-BSM","0.5",41.7297,-70.3644,NA,31119,"GRP_LOCATION","LOCATION_ELEV","0.5","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-CaV","994",39.0633,-79.4208,NA,6665,"GRP_LOCATION","LOCATION_LAT","39.0633","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-CaV","994",39.0633,-79.4208,NA,6665,"GRP_LOCATION","LOCATION_LONG","-79.4208","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-CaV","994",39.0633,-79.4208,NA,6665,"GRP_LOCATION","LOCATION_ELEV","994","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-Ced","58",39.8379,-74.3791,NA,12662,"GRP_LOCATION","LOCATION_LAT","39.8379","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Ced","58",39.8379,-74.3791,NA,12662,"GRP_LOCATION","LOCATION_LONG","-74.3791","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Ced","58",39.8379,-74.3791,NA,12662,"GRP_LOCATION","LOCATION_ELEV","58","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Ced","58",39.8379,-74.3791,NA,12662,"GRP_LOCATION","LOCATION_COMMENT","Annual tree census data, annual clip plots for understory vegetation, approx. monthly litterfall collection, forest floor sampling in 2003, 2006, 2008, 2012, 2013. Extensive soil sampling in 2012.","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Ced","58",39.8379,-74.3791,NA,29626,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Podzol, underlain by late Miocene fluvial sediments of the Kirkwood formation, and overlain with Cohansey sandy soil with low nutrient and cation exchange capacity","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Ced","58",39.8379,-74.3791,NA,29626,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-CF1","794",46.7815,-117.0821,2017-05-11,98317,"GRP_LOCATION","LOCATION_LAT","46.7815","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF1","794",46.7815,-117.0821,2017-05-11,98317,"GRP_LOCATION","LOCATION_LONG","-117.0821","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF1","794",46.7815,-117.0821,2017-05-11,98317,"GRP_LOCATION","LOCATION_ELEV","794","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF1","794",46.7815,-117.0821,2017-05-11,98317,"GRP_LOCATION","LOCATION_DATE_START","2017-05-11","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF2","807",46.784,-117.0908,2017-05-12,98337,"GRP_LOCATION","LOCATION_LAT","46.7840","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF2","807",46.784,-117.0908,2017-05-12,98337,"GRP_LOCATION","LOCATION_LONG","-117.0908","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF2","807",46.784,-117.0908,2017-05-12,98337,"GRP_LOCATION","LOCATION_ELEV","807","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF2","807",46.784,-117.0908,2017-05-12,98337,"GRP_LOCATION","LOCATION_DATE_START","2017-05-12","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF3","795",46.7551,-117.1261,2017-06-02,98357,"GRP_LOCATION","LOCATION_LAT","46.7551","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF3","795",46.7551,-117.1261,2017-06-02,98357,"GRP_LOCATION","LOCATION_LONG","-117.1261","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF3","795",46.7551,-117.1261,2017-06-02,98357,"GRP_LOCATION","LOCATION_ELEV","795","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF3","795",46.7551,-117.1261,2017-06-02,98357,"GRP_LOCATION","LOCATION_DATE_START","2017-06-02","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF4","795",46.7518,-117.1285,2017-06-02,98377,"GRP_LOCATION","LOCATION_LAT","46.7518","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF4","795",46.7518,-117.1285,2017-06-02,98377,"GRP_LOCATION","LOCATION_LONG","-117.1285","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF4","795",46.7518,-117.1285,2017-06-02,98377,"GRP_LOCATION","LOCATION_ELEV","795","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CF4","795",46.7518,-117.1285,2017-06-02,98377,"GRP_LOCATION","LOCATION_DATE_START","2017-06-02","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-ChR","286",35.9311,-84.3324,NA,1563,"GRP_LOCATION","LOCATION_LAT","35.9311","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-ChR","286",35.9311,-84.3324,NA,1563,"GRP_LOCATION","LOCATION_LONG","-84.3324","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-ChR","286",35.9311,-84.3324,NA,1563,"GRP_LOCATION","LOCATION_ELEV","286","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-Cop","1520",38.09,-109.39,NA,5746,"GRP_LOCATION","LOCATION_LAT","38.0900","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-Cop","1520",38.09,-109.39,NA,5746,"GRP_LOCATION","LOCATION_LONG","-109.3900","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-Cop","1520",38.09,-109.39,NA,5746,"GRP_LOCATION","LOCATION_ELEV","1520","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-Cop","1520",38.09,-109.39,NA,5746,"GRP_LOCATION","LOCATION_COMMENT","From CDIAC Tom Boden database dump","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-Cop","1520",38.09,-109.39,NA,28095,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Young, alkaline, well-drained fine sandy loams with weak or little horizonation","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-Cop","1520",38.09,-109.39,NA,28095,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","10","NORTH AMERICAN DESERTS","10.1","COLD DESERTS" + "US-CPk","2750",41.068,-106.1187,2009-01-01,10215,"GRP_LOCATION","LOCATION_LAT","41.0680","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CPk","2750",41.068,-106.1187,2009-01-01,10215,"GRP_LOCATION","LOCATION_LONG","-106.1187","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CPk","2750",41.068,-106.1187,2009-01-01,10215,"GRP_LOCATION","LOCATION_ELEV","2750","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CPk","2750",41.068,-106.1187,2009-01-01,10215,"GRP_LOCATION","LOCATION_DATE_START","2009-01-01","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CRT","180",41.6285,-83.3471,2010-09-20,12770,"GRP_LOCATION","LOCATION_LAT","41.6285","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-CRT","180",41.6285,-83.3471,2010-09-20,12770,"GRP_LOCATION","LOCATION_LONG","-83.3471","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-CRT","180",41.6285,-83.3471,2010-09-20,12770,"GRP_LOCATION","LOCATION_ELEV","180","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-CRT","180",41.6285,-83.3471,2010-09-20,12770,"GRP_LOCATION","LOCATION_DATE_START","2010-09-20","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-CRT","180",41.6285,-83.3471,2010-09-20,12770,"GRP_LOCATION","LOCATION_COMMENT","The tower was constructed in August and continuous measurement began in September, 2010.","8","EASTERN TEMPERATE FORESTS","8.2","CENTRAL USA PLAINS" + "US-CS1","328",44.1031,-89.5379,2018-06-29,96893,"GRP_LOCATION","LOCATION_LAT","44.1031","8","EASTERN TEMPERATE FORESTS","8.1","MIXED WOOD PLAINS" + "US-CS1","328",44.1031,-89.5379,2018-06-29,96893,"GRP_LOCATION","LOCATION_LONG","-89.5379","8","EASTERN TEMPERATE FORESTS","8.1","MIXED WOOD PLAINS" + "US-CS1","328",44.1031,-89.5379,2018-06-29,96893,"GRP_LOCATION","LOCATION_ELEV","328","8","EASTERN TEMPERATE FORESTS","8.1","MIXED WOOD PLAINS" + "US-CS1","328",44.1031,-89.5379,2018-06-29,96893,"GRP_LOCATION","LOCATION_DATE_START","2018-06-29","8","EASTERN TEMPERATE FORESTS","8.1","MIXED WOOD PLAINS" + "US-CS1","328",44.1031,-89.5379,2018-06-29,96893,"GRP_LOCATION","LOCATION_COMMENT","Approximation based on Google maps. GPS coords forthcoming","8","EASTERN TEMPERATE FORESTS","8.1","MIXED WOOD PLAINS" + "US-Cst","50",33.0442,-91.9204,NA,13214,"GRP_LOCATION","LOCATION_LAT","33.0442","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Cst","50",33.0442,-91.9204,NA,13214,"GRP_LOCATION","LOCATION_LONG","-91.9204","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Cst","50",33.0442,-91.9204,NA,13214,"GRP_LOCATION","LOCATION_ELEV","50","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Ctn","744",43.95,-101.8466,NA,637,"GRP_LOCATION","LOCATION_LAT","43.9500","9","GREAT PLAINS","9.3","WEST-CENTRAL SEMIARID PRAIRIES" + "US-Ctn","744",43.95,-101.8466,NA,637,"GRP_LOCATION","LOCATION_LONG","-101.8466","9","GREAT PLAINS","9.3","WEST-CENTRAL SEMIARID PRAIRIES" + "US-Ctn","744",43.95,-101.8466,NA,637,"GRP_LOCATION","LOCATION_ELEV","744","9","GREAT PLAINS","9.3","WEST-CENTRAL SEMIARID PRAIRIES" + "US-Ctn","744",43.95,-101.8466,NA,637,"GRP_LOCATION","LOCATION_COMMENT","From CDIAC Tom Boden database dump","9","GREAT PLAINS","9.3","WEST-CENTRAL SEMIARID PRAIRIES" + "US-Cwt","690",35.0592,-83.4275,2011-01-01,98507,"GRP_LOCATION","LOCATION_LAT","35.0592","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-Cwt","690",35.0592,-83.4275,2011-01-01,98507,"GRP_LOCATION","LOCATION_LONG","-83.4275","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-Cwt","690",35.0592,-83.4275,2011-01-01,98507,"GRP_LOCATION","LOCATION_ELEV","690","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-Cwt","690",35.0592,-83.4275,2011-01-01,98507,"GRP_LOCATION","LOCATION_DATE_START","2011-01-01","8","EASTERN TEMPERATE FORESTS","8.4","OZARK/OUACHITA-APPALACHIAN FORESTS" + "US-CZ1","400",37.1088,-119.7313,NA,30895,"GRP_LOCATION","LOCATION_LAT","37.1088","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-CZ1","400",37.1088,-119.7313,NA,30895,"GRP_LOCATION","LOCATION_LONG","-119.7313","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-CZ1","400",37.1088,-119.7313,NA,30895,"GRP_LOCATION","LOCATION_ELEV","400","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-CZ2","1160",37.0311,-119.2566,NA,30896,"GRP_LOCATION","LOCATION_LAT","37.0311","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ2","1160",37.0311,-119.2566,NA,30896,"GRP_LOCATION","LOCATION_LONG","-119.2566","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ2","1160",37.0311,-119.2566,NA,30896,"GRP_LOCATION","LOCATION_ELEV","1160","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ3","2015",37.0674,-119.1951,NA,30897,"GRP_LOCATION","LOCATION_LAT","37.0674","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ3","2015",37.0674,-119.1951,NA,30897,"GRP_LOCATION","LOCATION_LONG","-119.1951","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ3","2015",37.0674,-119.1951,NA,30897,"GRP_LOCATION","LOCATION_ELEV","2015","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ4","2710",37.0675,-118.9867,NA,30898,"GRP_LOCATION","LOCATION_LAT","37.0675","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ4","2710",37.0675,-118.9867,NA,30898,"GRP_LOCATION","LOCATION_LONG","-118.9867","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-CZ4","2710",37.0675,-118.9867,NA,30898,"GRP_LOCATION","LOCATION_ELEV","2710","6","NORTHWESTERN FORESTED MOUNTAINS","6.2","WESTERN CORDILLERA" + "US-Dea","-53",32.8136,-115.4423,NA,11411,"GRP_LOCATION","LOCATION_LAT","32.8136","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Dea","-53",32.8136,-115.4423,NA,11411,"GRP_LOCATION","LOCATION_LONG","-115.4423","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Dea","-53",32.8136,-115.4423,NA,11411,"GRP_LOCATION","LOCATION_ELEV","-53","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Dea","-53",32.8136,-115.4423,NA,11411,"GRP_LOCATION","LOCATION_COMMENT","The alfalfa field was existing. The measurements began at the above date.","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Deu","-53",32.8056,-115.4456,NA,11431,"GRP_LOCATION","LOCATION_LAT","32.8056","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Deu","-53",32.8056,-115.4456,NA,11431,"GRP_LOCATION","LOCATION_LONG","-115.4456","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Deu","-53",32.8056,-115.4456,NA,11431,"GRP_LOCATION","LOCATION_ELEV","-53","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Deu","-53",32.8056,-115.4456,NA,11431,"GRP_LOCATION","LOCATION_COMMENT","The tower is situated on scaffolding to measure fluxes from buildings, roads, farm equipment and crops. The measurements began at the above date.","10","NORTH AMERICAN DESERTS","10.2","WARM DESERTS" + "US-Dia","323",37.6773,-121.5296,NA,11505,"GRP_LOCATION","LOCATION_LAT","37.6773","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Dia","323",37.6773,-121.5296,NA,11505,"GRP_LOCATION","LOCATION_LONG","-121.5296","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Dia","323",37.6773,-121.5296,NA,11505,"GRP_LOCATION","LOCATION_ELEV","323","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Dia","323",37.6773,-121.5296,NA,11505,"GRP_LOCATION","LOCATION_COMMENT","From CDIAC Tom Boden database dump","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-Dix","48",39.9712,-74.4346,NA,7507,"GRP_LOCATION","LOCATION_LAT","39.9712","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Dix","48",39.9712,-74.4346,NA,7507,"GRP_LOCATION","LOCATION_LONG","-74.4346","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Dix","48",39.9712,-74.4346,NA,7507,"GRP_LOCATION","LOCATION_ELEV","48","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Dix","48",39.9712,-74.4346,NA,28940,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Podzol, underlain by late Miocene fluvial sediments of the Kirkwood formation, and overlain with Cohansey sandy soil with low nutrient and cation exchange capacity","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Dix","48",39.9712,-74.4346,NA,28940,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","8","EASTERN TEMPERATE FORESTS","8.5","MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27970,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","100","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27970,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27970,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27970,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27970,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2001-06-28","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27970,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","There are no trees and an insignificant number of shrubs in this field. It is mowed annually for hay; biomass was estimated by counting bales and multiplying by measured mass/bale","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27971,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","100","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27971,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27971,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27971,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27971,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2002-06-02","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27971,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","There are no trees and an insignificant number of shrubs in this field. It is mowed annually for hay; biomass was estimated by counting bales and multiplying by measured mass/bale","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28321,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","200","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28321,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28321,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28321,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28321,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2004-05-18","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28321,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","There are no trees and an insignificant number of shrubs in this field. It is mowed annually for hay; biomass was estimated by counting bales and multiplying by measured mass/bale","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29517,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","400","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29517,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29517,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29517,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29517,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2003-07-25","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29517,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","There are no trees and an insignificant number of shrubs in this field. It is mowed annually for hay; biomass was estimated by counting bales and multiplying by measured mass/bale","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29518,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","100","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29518,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29518,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29518,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29518,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2005-09-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29518,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","There are no trees and an insignificant number of shrubs in this field. It is mowed annually for hay; biomass was estimated by counting bales and multiplying by measured mass/bale","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,6039,"GRP_LOCATION","LOCATION_LAT","35.9712","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,6039,"GRP_LOCATION","LOCATION_LONG","-79.0934","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,6039,"GRP_LOCATION","LOCATION_ELEV","168","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28093,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Enon Series, low-fertility, acidic Hapludalf. An imprevious clay pan is located beneath all soils at a depth of 0.30 m.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28093,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27060,"GRP_SOIL_DEPTH","SOIL_DEPTH","3000","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27060,"GRP_SOIL_DEPTH","SOIL_DEPTH_COMMENT","A clay-pan underlies the entire Blackwood division of the Duke forest at 30 cm.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26757,"GRP_SOIL_TEX","SOIL_TEX_SAND","35.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26757,"GRP_SOIL_TEX","SOIL_TEX_SILT","40.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26757,"GRP_SOIL_TEX","SOIL_TEX_CLAY","24.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26757,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","B","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26757,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26758,"GRP_SOIL_TEX","SOIL_TEX_SAND","44","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26758,"GRP_SOIL_TEX","SOIL_TEX_SILT","37.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26758,"GRP_SOIL_TEX","SOIL_TEX_CLAY","18.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26758,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","BC","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26758,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26759,"GRP_SOIL_TEX","SOIL_TEX_SILT","26.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26759,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26759,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26760,"GRP_SOIL_TEX","SOIL_TEX_SILT","27.2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26760,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26760,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26761,"GRP_SOIL_TEX","SOIL_TEX_CLAY","9.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26761,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26761,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26907,"GRP_SOIL_TEX","SOIL_TEX_SAND","55.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26907,"GRP_SOIL_TEX","SOIL_TEX_SILT","32.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26907,"GRP_SOIL_TEX","SOIL_TEX_CLAY","12.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26907,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","CB","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26907,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26908,"GRP_SOIL_TEX","SOIL_TEX_SILT","29.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26908,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26908,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26909,"GRP_SOIL_TEX","SOIL_TEX_SILT","27.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26909,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26909,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26910,"GRP_SOIL_TEX","SOIL_TEX_CLAY","6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26910,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,26910,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27059,"GRP_SOIL_TEX","SOIL_TEX_SAND","25.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27059,"GRP_SOIL_TEX","SOIL_TEX_SILT","40.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27059,"GRP_SOIL_TEX","SOIL_TEX_CLAY","34.2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27059,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27059,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27061,"GRP_SOIL_TEX","SOIL_TEX_SAND","63.8","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27061,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27061,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27353,"GRP_SOIL_TEX","SOIL_TEX_SAND","50.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27353,"GRP_SOIL_TEX","SOIL_TEX_SILT","40.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27353,"GRP_SOIL_TEX","SOIL_TEX_CLAY","9.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27353,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","AE","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27353,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27600,"GRP_SOIL_TEX","SOIL_TEX_SAND","67.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27600,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,27600,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28322,"GRP_SOIL_TEX","SOIL_TEX_WATER_HOLD_CAP","0.52","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28322,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28322,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28584,"GRP_SOIL_TEX","SOIL_TEX_SAND","48.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28584,"GRP_SOIL_TEX","SOIL_TEX_SILT","43.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28584,"GRP_SOIL_TEX","SOIL_TEX_CLAY","8.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28584,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28584,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28585,"GRP_SOIL_TEX","SOIL_TEX_SAND","47.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28585,"GRP_SOIL_TEX","SOIL_TEX_SILT","38.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28585,"GRP_SOIL_TEX","SOIL_TEX_CLAY","14.2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28585,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","BE","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28585,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28820,"GRP_SOIL_TEX","SOIL_TEX_SAND","61","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28820,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28820,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28821,"GRP_SOIL_TEX","SOIL_TEX_CLAY","8.7","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28821,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,28821,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29169,"GRP_SOIL_TEX","SOIL_TEX_SAND","68.9","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29169,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29169,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29523,"GRP_SOIL_TEX","SOIL_TEX_CLAY","4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29523,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk1","168",35.9712,-79.0934,NA,29523,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24271,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24271,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Fruits","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24271,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24271,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24271,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24271,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25546,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25546,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25546,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25546,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25546,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25546,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,26051,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,26051,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_ORGAN","Foliage","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,26051,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,26051,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_CROP_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,26051,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,26051,"GRP_AG_BIOMASS_CROP","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23875,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23875,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_ORGAN","Wood","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23875,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23875,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23875,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23875,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23876,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23876,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23876,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23876,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23876,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23876,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25026,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25026,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_ORGAN","Foliage","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25026,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25026,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_SHRUB_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25026,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25026,"GRP_AG_BIOMASS_SHRUB","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24115,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24115,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24115,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24115,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24115,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24115,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25157,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","18000","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25157,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Wood","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25157,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25157,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25157,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2002-10-07","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25157,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","Estimated based on allometric equations for DBH (Clark et al. 2006)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24119,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24119,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24119,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Measured with litter baskets, annual sum of dry weight (not C)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25027,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25027,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25027,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Measured with litter baskets, annual sum of dry weight (not C)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25028,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25028,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25028,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Measured with litter baskets, annual sum of dry weight (not C)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25547,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25547,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25547,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Measured with litter baskets, annual sum of dry weight (not C)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,6680,"GRP_LOCATION","LOCATION_LAT","35.9736","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,6680,"GRP_LOCATION","LOCATION_LONG","-79.1004","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,6680,"GRP_LOCATION","LOCATION_ELEV","168","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24909,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_CRS","2900","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24909,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24909,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24909,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MAX","40","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24909,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23661,"GRP_SOIL_CHEM","SOIL_CHEM_BD","1.46","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23661,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23661,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","92","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23661,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","B","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23661,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","/Bulk density BE/1.43 Bt/1.38 Bt/1.54 B/1.49 D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series; BE/0.48 Bt/0.8 Bt/1.15 B/1.4 D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23919,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","4.98","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23919,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23919,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","20.32","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23919,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,23919,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","A 4.85; E 5.10 N.-H. Oh, D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series; A--0 to 3 inches; dark grayish brown (10YR 4/2) fine sandy loam; ...strongly acid; clear smooth boundary. (2 to 9 inches thick) E--3 to 8 inches; yellowish brown (10YR 5/4) fine sandy loam; ...moderately acid; clear wavy boundary. (0 to 7 inches thick) source: description ENON Series","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24420,"GRP_SOIL_CHEM","SOIL_CHEM_PH_H2O","6.04","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24420,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24420,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","20.32","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24420,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24420,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","A 5.85; E 6.23 N.-H. Oh, D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series; A--0 to 3 inches; dark grayish brown (10YR 4/2) fine sandy loam; ...strongly acid; clear smooth boundary. (2 to 9 inches thick) E--3 to 8 inches; yellowish brown (10YR 5/4) fine sandy loam; ...moderately acid; clear wavy boundary. (0 to 7 inches thick) source: description ENON Series","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24436,"GRP_SOIL_CHEM","SOIL_CHEM_C_ORG","17.9","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24436,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24436,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","20.32","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24436,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24436,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","A 2.48; E 1.10; (%C) N.-H. Oh, D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series; A--0 to 3 inches; dark grayish brown (10YR 4/2) fine sandy loam; ...strongly acid; clear smooth boundary. (2 to 9 inches thick) E--3 to 8 inches; yellowish brown (10YR 5/4) fine sandy loam; ...moderately acid; clear wavy boundary. (0 to 7 inches thick) source: description ENON Series","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24555,"GRP_SOIL_CHEM","SOIL_CHEM_PH_H2O","5.9","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24555,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24555,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","92","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24555,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","B","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24555,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","/pHw BE/5.75 Bt/5.83 Bt/6.26 B/5.82 D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series; BE/0.48 Bt/0.8 Bt/1.15 B/1.4 D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24942,"GRP_SOIL_CHEM","SOIL_CHEM_BD","1.22","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24942,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24942,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","20.32","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24942,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24942,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","A 1.15; E 1.29 N.-H. Oh, D.D. Richter / Geoderma 126 (2005) 5<80><93>25 description ENON Series; A--0 to 3 inches; dark grayish brown (10YR 4/2) fine sandy loam; ...strongly acid; clear smooth boundary. (2 to 9 inches thick) E--3 to 8 inches; yellowish brown (10YR 5/4) fine sandy loam; ...moderately acid; clear wavy boundary. (0 to 7 inches thick) source: description ENON Series","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,29424,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Enron silt loam transitioning to Iredell gravely loam to the southwest, an imprevious clay pan is located beneath all soils at a depth of 0.30 m","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,29424,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24376,"GRP_SOIL_DEPTH","SOIL_DEPTH","3000","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24376,"GRP_SOIL_DEPTH","SOIL_DEPTH_COMMENT","A clay-pan underlies the entire Blackwood division of the Duke forest at 30 cm.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24377,"GRP_SOIL_TEX","SOIL_TEX_WATER_HOLD_CAP","0.52","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24377,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24377,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24522,"GRP_WD_BIOMASS","WD_BIOMASS_CRS","500","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24522,"GRP_WD_BIOMASS","WD_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24522,"GRP_WD_BIOMASS","WD_BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,24522,"GRP_WD_BIOMASS","WD_BIOMASS_COMMENT","Total annual dry weight, collected in litter baskets (not C only)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25029,"GRP_WD_BIOMASS","WD_BIOMASS_CRS","500","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25029,"GRP_WD_BIOMASS","WD_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25029,"GRP_WD_BIOMASS","WD_BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25029,"GRP_WD_BIOMASS","WD_BIOMASS_COMMENT","Total annual dry weight, collected in litter baskets (not C only)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25030,"GRP_WD_BIOMASS","WD_BIOMASS_CRS","500","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25030,"GRP_WD_BIOMASS","WD_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25030,"GRP_WD_BIOMASS","WD_BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25030,"GRP_WD_BIOMASS","WD_BIOMASS_COMMENT","Total annual dry weight, collected in litter baskets (not C only)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25548,"GRP_WD_BIOMASS","WD_BIOMASS_CRS","500","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25548,"GRP_WD_BIOMASS","WD_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25548,"GRP_WD_BIOMASS","WD_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25548,"GRP_WD_BIOMASS","WD_BIOMASS_COMMENT","Total annual dry weight, collected in litter baskets (not C only)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25549,"GRP_WD_BIOMASS","WD_BIOMASS_FINE","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk2","168",35.9736,-79.1004,NA,25549,"GRP_WD_BIOMASS","WD_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25411,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","7345","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25411,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Wood","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25411,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25411,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25411,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2001-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25411,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25540,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","7664","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25540,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Wood","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25540,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25540,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25540,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25540,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25541,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","8464","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25541,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Wood","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25541,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25541,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25541,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25541,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25916,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","8042","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25916,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25916,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25916,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25916,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25916,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27502,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","7821","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27502,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Wood","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27502,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27502,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27502,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27502,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27503,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","378","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27503,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Foliage","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27503,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27503,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27503,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27503,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27504,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","9123","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27504,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Wood","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27504,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27504,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27504,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27504,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28109,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","8171","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28109,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28109,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28109,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28109,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28109,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28110,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","8859","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28110,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28110,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28110,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28110,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28110,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28222,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","9498","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28222,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28222,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28222,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28222,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28222,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28223,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","7754","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28223,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28223,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28223,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28223,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2001-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28223,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28448,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","398","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28448,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Foliage","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28448,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28448,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28448,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28448,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28452,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","408","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28452,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Foliage","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28452,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28452,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28452,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2001-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28452,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28454,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","375","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28454,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Foliage","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28454,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28454,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28454,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28454,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28949,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE","350","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28949,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_ORGAN","Foliage","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28949,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28949,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_TREE_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28949,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28949,"GRP_AG_BIOMASS_TREE","AG_BIOMASS_COMMENT","References: (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University. (2) McCarthy HR, Oren R, Kim H-K et al. (2006) Interaction of ice storms and management practices on current carbon sequestration in forests with potential mitigation under future CO2 atmosphere. Journal of Geophysical Research - Atmospheres, 111, D15103; (3) Naidu SL, DeLucia EH, Thomas RB (1998) Contrasting patterns of biomass allocation in dominant and suppressed loblolly pine. Canadian Journal of Forest Research, 28, 1116-1124; (4) Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25913,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25913,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25913,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27851,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27851,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2001-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27851,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28947,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28947,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28947,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28950,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28950,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28950,"GRP_AG_LIT_BIOMASS","AG_LIT_BIOMASS_COMMENT","Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26669,"GRP_BIOMASS_CHEM","BIOMASS_N","0.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26669,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26669,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26669,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26669,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2001-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26669,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27256,"GRP_BIOMASS_CHEM","BIOMASS_N","0.01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27256,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27256,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27256,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27256,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27256,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27257,"GRP_BIOMASS_CHEM","BIOMASS_N","0.01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27257,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27257,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27257,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27257,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27257,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27536,"GRP_BIOMASS_CHEM","BIOMASS_N","0.10","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27536,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27536,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27536,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27536,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27536,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27537,"GRP_BIOMASS_CHEM","BIOMASS_N","0.01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27537,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27537,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27537,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27537,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27537,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27892,"GRP_BIOMASS_CHEM","BIOMASS_C","4.8","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27892,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27892,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27892,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27892,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Oren R, Ellsworth DS, Johnsen KH et al. (2001) Soil fertility limits carbon sequestration by forest ecosystems in a CO2 - enriched atmosphere. Nature, 411, 469-472","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28144,"GRP_BIOMASS_CHEM","BIOMASS_N","0.02","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28144,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28144,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28144,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28144,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28144,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28257,"GRP_BIOMASS_CHEM","BIOMASS_N","0.10","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28257,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28257,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28257,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28257,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28257,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28486,"GRP_BIOMASS_CHEM","BIOMASS_N","0.10","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28486,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28486,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28486,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28486,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28486,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28777,"GRP_BIOMASS_CHEM","BIOMASS_N","0.11","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28777,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28777,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28777,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28777,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28777,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28987,"GRP_BIOMASS_CHEM","BIOMASS_N","0.01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28987,"GRP_BIOMASS_CHEM","BIOMASS_ORGAN","Total","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28987,"GRP_BIOMASS_CHEM","BIOMASS_PHEN","Mixed/unknown","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28987,"GRP_BIOMASS_CHEM","BIOMASS_SPP","PITA (NRCS plant code)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28987,"GRP_BIOMASS_CHEM","BIOMASS_DATE","2001-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28987,"GRP_BIOMASS_CHEM","BIOMASS_COMMENT","Data from http://face.env.duke.edu/face.cfm","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,9262,"GRP_LOCATION","LOCATION_LAT","35.9782","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,9262,"GRP_LOCATION","LOCATION_LONG","-79.0942","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,9262,"GRP_LOCATION","LOCATION_ELEV","163","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,9262,"GRP_LOCATION","LOCATION_COMMENT","Central towere located in Ring 1 of FACE experiment","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25280,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_FINE","159","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25280,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25280,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25280,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25280,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_DATE","2004-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25280,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_COMMENT","35 cm (rooting depth ca. 30 cm, Oren et al., 1998; (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26033,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_FINE","156","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26033,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26033,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26033,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26033,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_DATE","2003-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26033,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_COMMENT","35 cm (rooting depth ca. 30 cm, Oren et al., 1998; (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27219,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_FINE","144","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27219,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27219,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27219,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27219,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27219,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_COMMENT","35 cm (rooting depth ca. 30 cm, Oren et al., 1998; (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28221,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_FINE","135","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28221,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28221,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28221,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28221,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_DATE","2001-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28221,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_COMMENT","35 cm (rooting depth ca. 30 cm, Oren et al., 1998; (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28451,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_FINE","172","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28451,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28451,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28451,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28451,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_DATE","2005-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28451,"GRP_ROOT_BIOMASS","ROOT_BIOMASS_COMMENT","35 cm (rooting depth ca. 30 cm, Oren et al., 1998; (1) McCarthy, H.R. 2007 ( Long-term effects of elevated CO2, soil nutrition, water availability and disturbance on carbon relations in a loblolly pine forest. PhD Dissertation. Nicholas School of the Environment, Duke University.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26694,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","4.9","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26694,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","140","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26694,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","75","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26694,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","BC","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26694,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26832,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","5.04","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26832,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","225","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26832,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","275","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26832,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26832,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26971,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","5.24","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26971,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","80","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26971,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","115","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26971,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26971,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26972,"GRP_SOIL_CHEM","SOIL_CHEM_N_TOT","1.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26972,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Schlesinger and Lichter (2001) Nature. Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847. Schlesinger and Lichter (2001) Nature. Also: Unpublished data, K. Johnsen et al.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27259,"GRP_SOIL_CHEM","SOIL_CHEM_C_ORG","61","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27259,"GRP_SOIL_CHEM","SOIL_CHEM_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27259,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Forest Service %C data from soil pit with bulk density from http://face.env.duke.edu/pdf/Full_Soil_Profile.pdf. Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847. Schlesinger and Lichter (2001) Limited carbon storage in soil and litter of experimental forest plots under elevated atmospheric CO2. Nature 411:466-469, See also: http://face.env.duke.edu/pdf/Full_Soil_Profile.pdf. Also: Unpublished data, K. Johnsen et al.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27260,"GRP_SOIL_CHEM","SOIL_CHEM_N_TOT","1.2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27260,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Forest Service %N data from soil pit with bulk density from http://face.env.duke.edu/pdf/Full_Soil_Profile.pdf. Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847. Schlesinger and Lichter (2001) Nature. Also: Unpublished data, K. Johnsen et al.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27261,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","5.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27261,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","12","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27261,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","29","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27261,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","AE","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27261,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27539,"GRP_SOIL_CHEM","SOIL_CHEM_C_ORG","24","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27539,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27539,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","15","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27539,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A, AE","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27539,"GRP_SOIL_CHEM","SOIL_CHEM_DATE","2002-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27539,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Spatially variable. Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847. Schlesinger and Lichter (2001) Limited carbon storage in soil and litter of experimental forest plots under elevated atmospheric CO2. Nature 411:466-469, See also: http://face.env.duke.edu/pdf/Full_Soil_Profile.pdf. Also: Unpublished data, K. Johnsen et al.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28148,"GRP_SOIL_CHEM","SOIL_CHEM_N_TOT","1.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28148,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28148,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","15","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28148,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Spatially variable. Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847. Schlesinger and Lichter (2001) Nature. Also: Unpublished data, K. Johnsen et al.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28149,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","4.85","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28149,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28149,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","12","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28149,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28149,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28258,"GRP_SOIL_CHEM","SOIL_CHEM_BD","1.27","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28258,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28258,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28258,"GRP_SOIL_CHEM","SOIL_CHEM_DATE","2000-01-01","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28258,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Reference: Lichter J, Barron S, Finzi A, Irving K, Roberts M, Stemmler E and W Schlesinger. 2005. Soil carbon sequestration and turnover in a pine forest after six years of atmospheric CO2 enrichment. Ecology 86(7):1835-1847","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28259,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","4.87","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28259,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","29","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28259,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","48","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28259,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","BE","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28259,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28487,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","5.02","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28487,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","75","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28487,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","225","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28487,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","CB","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28487,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28488,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","5.11","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28488,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","275","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28488,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","325","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28488,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,28488,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29091,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","4.95","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29091,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","115","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29091,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","140","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29091,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","B","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29091,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29092,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","4.98","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29092,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","325","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29092,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","700","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29092,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29092,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29450,"GRP_SOIL_CHEM","SOIL_CHEM_PH_SALT","4.91","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29450,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MIN","48","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29450,"GRP_SOIL_CHEM","SOIL_CHEM_PROFILE_MAX","80","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29450,"GRP_SOIL_CHEM","SOIL_CHEM_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,29450,"GRP_SOIL_CHEM","SOIL_CHEM_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27189,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION","Enon Series, low-fertility, acidic Hapludalf. An imprevious clay pan is located beneath all soils at a depth of 0.30 m.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,27189,"GRP_SOIL_CLASSIFICATION","SOIL_CLASSIFICATION_TAXONOMY","Other","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24910,"GRP_SOIL_DEPTH","SOIL_DEPTH","3000","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24910,"GRP_SOIL_DEPTH","SOIL_DEPTH_COMMENT","A clay-pan underlies the entire Blackwood division of the Duke forest at 30 cm.","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23737,"GRP_SOIL_TEX","SOIL_TEX_SAND","55.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23737,"GRP_SOIL_TEX","SOIL_TEX_SILT","32.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23737,"GRP_SOIL_TEX","SOIL_TEX_CLAY","12.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23737,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","BC","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23737,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23739,"GRP_SOIL_TEX","SOIL_TEX_SILT","27.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23739,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23739,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23879,"GRP_SOIL_TEX","SOIL_TEX_SILT","27.2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23879,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23879,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23880,"GRP_SOIL_TEX","SOIL_TEX_SAND","63.8","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23880,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23880,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23881,"GRP_SOIL_TEX","SOIL_TEX_SAND","68.9","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23881,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,23881,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24006,"GRP_SOIL_TEX","SOIL_TEX_SAND","50.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24006,"GRP_SOIL_TEX","SOIL_TEX_SILT","40.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24006,"GRP_SOIL_TEX","SOIL_TEX_CLAY","9.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24006,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","AE","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24006,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24007,"GRP_SOIL_TEX","SOIL_TEX_SAND","35.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24007,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24007,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24103,"GRP_SOIL_TEX","SOIL_TEX_CLAY","24.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24103,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24103,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24121,"GRP_SOIL_TEX","SOIL_TEX_WATER_HOLD_CAP","0.52","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24121,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MIN","0","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24121,"GRP_SOIL_TEX","SOIL_TEX_PROFILE_MAX","30","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24269,"GRP_SOIL_TEX","SOIL_TEX_SILT","40.1","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24269,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24269,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24363,"GRP_SOIL_TEX","SOIL_TEX_SAND","44","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24363,"GRP_SOIL_TEX","SOIL_TEX_SILT","37.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24363,"GRP_SOIL_TEX","SOIL_TEX_CLAY","18.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24363,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","B","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24363,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24523,"GRP_SOIL_TEX","SOIL_TEX_SAND","25.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24523,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24523,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24524,"GRP_SOIL_TEX","SOIL_TEX_SILT","40.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24524,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24524,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24777,"GRP_SOIL_TEX","SOIL_TEX_SAND","61","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24777,"GRP_SOIL_TEX","SOIL_TEX_SILT","29.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24777,"GRP_SOIL_TEX","SOIL_TEX_CLAY","9.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24777,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","CB","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24777,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24778,"GRP_SOIL_TEX","SOIL_TEX_SILT","26.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24778,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24778,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24779,"GRP_SOIL_TEX","SOIL_TEX_SAND","67.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24779,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,24779,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25033,"GRP_SOIL_TEX","SOIL_TEX_SAND","48.4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25033,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25142,"GRP_SOIL_TEX","SOIL_TEX_CLAY","34.2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25142,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","Bt","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25142,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25162,"GRP_SOIL_TEX","SOIL_TEX_SILT","43.3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25162,"GRP_SOIL_TEX","SOIL_TEX_CLAY","8.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25162,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","A","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25162,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25163,"GRP_SOIL_TEX","SOIL_TEX_SAND","47.6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25163,"GRP_SOIL_TEX","SOIL_TEX_SILT","38.5","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25163,"GRP_SOIL_TEX","SOIL_TEX_CLAY","14.2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25163,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","BE","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25163,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25552,"GRP_SOIL_TEX","SOIL_TEX_CLAY","6","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25552,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25552,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25553,"GRP_SOIL_TEX","SOIL_TEX_CLAY","8.7","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25553,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25553,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26055,"GRP_SOIL_TEX","SOIL_TEX_CLAY","4","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26055,"GRP_SOIL_TEX","SOIL_TEX_HORIZON","C","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,26055,"GRP_SOIL_TEX","SOIL_TEX_COMMENT","Oh, N.H. and D.D. Richter. Elemental translocation and loss from three highly weathered soil-bedrock profiles in the southeastern United States. Geoderma 126 (5-25)","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25279,"GRP_WD_BIOMASS","WD_BIOMASS_CRS","255","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25279,"GRP_WD_BIOMASS","WD_BIOMASS_UNIT","gC m-2","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25279,"GRP_WD_BIOMASS","WD_BIOMASS_DATE","2003-01-15","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-Dk3","163",35.9782,-79.0942,NA,25279,"GRP_WD_BIOMASS","WD_BIOMASS_COMMENT","Coarse woody debris following a severe ice storm. See McCarthy et al. (2006) JGR Table 1 and Figure 3","8","EASTERN TEMPERATE FORESTS","8.3","SOUTHEASTERN USA PLAINS" + "US-EDN",NA,37.6156,-122.114,2018-02-16,98227,"GRP_LOCATION","LOCATION_LAT","37.6156","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-EDN",NA,37.6156,-122.114,2018-02-16,98227,"GRP_LOCATION","LOCATION_LONG","-122.1140","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-EDN",NA,37.6156,-122.114,2018-02-16,98227,"GRP_LOCATION","LOCATION_DATE_START","2018-02-16","11","MEDITERRANEAN CALIFORNIA","11.1","MEDITERRANEAN CALIFORNIA" + "US-EDN",NA,37.6156,-122.114,2018-02-16,98227,"GRP_LOCATION","LOCATION_COMMENT","Location was disturbed from late 1800s up to 1972 for salt harvesting. Location elevation between 36 to 48 inches (0.914m to 1.22m),11,MEDITERRANEAN CALIFORNIA,11.1,MEDITERRANEAN CALIFORNIA + US-Elm,0.77,25.5519,-80.7826,NA,6242,GRP_LOCATION,LOCATION_LAT,25.5519,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Elm,0.77,25.5519,-80.7826,NA,6242,GRP_LOCATION,LOCATION_LONG,-80.7826,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Elm,0.77,25.5519,-80.7826,NA,6242,GRP_LOCATION,LOCATION_ELEV,0.77,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Elm,0.77,25.5519,-80.7826,NA,29422,GRP_SOIL_CLASSIFICATION,SOIL_CLASSIFICATION,Peat,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Elm,0.77,25.5519,-80.7826,NA,29422,GRP_SOIL_CLASSIFICATION,SOIL_CLASSIFICATION_TAXONOMY,Other,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Esm,1.07,25.4379,-80.5946,NA,7077,GRP_LOCATION,LOCATION_LAT,25.4379,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Esm,1.07,25.4379,-80.5946,NA,7077,GRP_LOCATION,LOCATION_LONG,-80.5946,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Esm,1.07,25.4379,-80.5946,NA,7077,GRP_LOCATION,LOCATION_ELEV,1.07,15,TROPICAL WET FORESTS,15.4,EVERGLADES + US-Fmf,2160,35.1426,-111.7273,NA,29191,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER,6,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29191,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER_ORGAN,Total,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29191,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER_PHEN,Mixed/unknown,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29191,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER_UNIT,gC m-2,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29191,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_APPROACH,4 , 0.5 m2 plot once per year. projected leaf area was measured in the laboratory with an image analyzer (Agvision, Monochrome System, Decagon Devices, Inc., Pullman, WA, USA).,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29191,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_DATE,2006-09-07,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29206,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER,12,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29206,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER_ORGAN,Total,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29206,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER_PHEN,Mixed/unknown,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29206,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_OTHER_UNIT,gC m-2,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29206,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_APPROACH,4 , 0.5 m2 plot once per year. projected leaf area was measured in the laboratory with an image analyzer (Agvision, Monochrome System, Decagon Devices, Inc., Pullman, WA, USA).,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,29206,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_DATE,2007-09-07,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28840,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE,3910,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28840,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE_ORGAN,Total,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28840,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE_PHEN,Mixed/unknown,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28840,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE_UNIT,gC m-2,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28840,GRP_AG_BIOMASS_TREE,AG_BIOMASS_APPROACH,allometry on 5 25 m radious circular plots. Following equations in Kaye, J. P., Hart, S. C., Fule, P. Z., Covington, W. W., Moore, M. M., Kaye, M. W. 2005. Initial carbon, nitrogen, and phosphorus fluxes following ponderosa pine restoration treatments. Ecological Applications, 15(5) 1581-1593.,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28840,GRP_AG_BIOMASS_TREE,AG_BIOMASS_DATE,2006-09-07,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28841,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE,2660,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28841,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE_ORGAN,Total,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28841,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE_PHEN,Mixed/unknown,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28841,GRP_AG_BIOMASS_TREE,AG_BIOMASS_TREE_UNIT,gC m-2,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28841,GRP_AG_BIOMASS_TREE,AG_BIOMASS_APPROACH,allometry on 5 25 m radious circular plots. Following equations in Kaye, J. P., Hart, S. C., Fule, P. Z., Covington, W. W., Moore, M. M., Kaye, M. W. 2005. Initial carbon, nitrogen, and phosphorus fluxes following ponderosa pine restoration treatments. Ecological Applications, 15(5) 1581-1593.,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,28841,GRP_AG_BIOMASS_TREE,AG_BIOMASS_DATE,2007-09-07,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,27372,GRP_BIOMASS_CHEM,BIOMASS_N,0.12,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,27372,GRP_BIOMASS_CHEM,BIOMASS_ORGAN,Total,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,27372,GRP_BIOMASS_CHEM,BIOMASS_PHEN,Mixed/unknown,13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,27372,GRP_BIOMASS_CHEM,BIOMASS_SPP,PIPO (NRCS plant code),13,TEMPERATE SIERRAS,13.1,UPPER GILA MOUNTAINS + US-Fmf,2160,35.1426,-111.7273,NA,27372,GRP_BIOMASS_CHEM,BIOMASS_COMMENT,pinus ponderosa' in object 'BADM' + 'US-SP1,50,29.7381,-82.2188,NA,29203,GRP_AG_LIT_BIOMASS,AG_LIT_BIOMASS_COMMENT,842 277,8,EASTERN TEMPERATE FORESTS,8.5,MISSISSIPPI ALLUVIAL AND SOUTHEAST USA COASTAL PLAINS' in object 'BADM' + 'US-SRM,1120,31.8214,-110.8661,NA,27355,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_COMMENT,*aboveground tree biomass = (EXP(1.6*LN(35)-0.58)/100)/1000*.47 estimated using equation given in Browning et al. 2008EcolApp,18,933 (be careful<80>numbers not verified), biomass of herbage production given in Follet, SRER100 issue,12,SOUTHERN SEMIARID HIGHLANDS,12.1,WESTERN SIERRA MADRE PIEDMONT' in object 'BADM' + 'US-SRM,1120,31.8214,-110.8661,NA,27975,GRP_AG_BIOMASS_TREE,AG_BIOMASS_COMMENT,*aboveground tree biomass = (EXP(1.6*LN(35)-0.58)/100)/1000*.47 estimated using equation given in Browning et al. 2008EcolApp,18,933 (be careful<80>numbers not verified), biomass of herbage production given in Follet, SRER100 issue,12,SOUTHERN SEMIARID HIGHLANDS,12.1,WESTERN SIERRA MADRE PIEDMONT' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,23740,GRP_SOIL_TEX,SOIL_TEX_COMMENT,(5-6); Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,23741,GRP_SOIL_TEX,SOIL_TEX_COMMENT,(6-7); Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,23742,GRP_SOIL_TEX,SOIL_TEX_COMMENT,(4-5); Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,24008,GRP_SOIL_TEX,SOIL_TEX_COMMENT,Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,24122,GRP_SOIL_TEX,SOIL_TEX_COMMENT,(4-5); Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,24378,GRP_SOIL_TEX,SOIL_TEX_COMMENT,Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,24379,GRP_SOIL_TEX,SOIL_TEX_COMMENT,Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,24781,GRP_SOIL_TEX,SOIL_TEX_COMMENT,(4-5); Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,26057,GRP_SOIL_TEX,SOIL_TEX_COMMENT,Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-Shd,346,36.9333,-96.6833,NA,26058,GRP_SOIL_TEX,SOIL_TEX_COMMENT,Soil at Tallgrass Prairie Site: silty clay loam of Wolco-Dwight complex (Pachic Argiustolls & Typic Natrustolls); George Burba. Y:\Okla-SR\LAIBiomass&Soils\Properties of OK soils.doc.,9,GREAT PLAINS,9.4,SOUTH CENTRAL SEMIARID PRAIRIES' in object 'BADM' + 'US-UMB,234,45.5598,-84.7138,NA,18391,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_COMMENT,Litter traps are .179 m^2 with one trap in each of 60 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMB,234,45.5598,-84.7138,NA,18392,GRP_AG_BIOMASS_TREE,AG_BIOMASS_COMMENT,Litter traps are .179 m^2 with one trap in each of 60 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMB,234,45.5598,-84.7138,NA,18423,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_COMMENT,Litter traps are .179 m^2 with one trap in each of 60 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower at plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMB,234,45.5598,-84.7138,NA,18424,GRP_AG_BIOMASS_TREE,AG_BIOMASS_COMMENT,Litter traps are .179 m^2 with one trap in each of 60 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower at plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMB,234,45.5598,-84.7138,NA,18437,GRP_AG_LIT_BIOMASS,AG_LIT_BIOMASS_COMMENT,Litter does NOT include identifiable leaves, but includes leaf fragments, seeds, flowers, lichens and fine woody debris collected from litter traps. Includes 16.2 50.3 of Quercus rubra acorns.,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMB,234,45.5598,-84.7138,NA,18549,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_COMMENT,Litter traps are .264 m^2 with one trap in each of 60 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMB,234,45.5598,-84.7138,NA,18550,GRP_AG_BIOMASS_TREE,AG_BIOMASS_COMMENT,Litter traps are .264 m^2 with one trap in each of 60 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMd,239,45.5625,-84.6975,NA,18645,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_COMMENT,Litter traps are .264 m^2 with one - 3 traps in each of 21 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMd,239,45.5625,-84.6975,NA,18646,GRP_AG_BIOMASS_TREE,AG_BIOMASS_COMMENT,Litter traps are .264 m^2 with one - 3 traps in each of 21 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20011020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMd,239,45.5625,-84.6975,NA,18656,GRP_AG_BIOMASS_OTHER,AG_BIOMASS_COMMENT,Many of the Populus and all of the Betula trees girdled in 2008 had died by the 2010 census. Litter traps are .264 m^2 with one trap in each of 21 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20101020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-UMd,239,45.5625,-84.6975,NA,18657,GRP_AG_BIOMASS_TREE,AG_BIOMASS_COMMENT,Many of the Populus and all of the Betula trees girdled in 2008 had died by the 2010 census. Litter traps are .264 m^2 with one trap in each of 21 - 0.08 ha plots and 20 traps in a 1.13 ha plot with flux tower a plot center. Litter trap collection date is 20101020 20 d,5,NORTHERN FORESTS,5.2,MIXED WOOD SHIELD' in object 'BADM' + 'US-WBW,283,35.9588,-84.2874,NA,23648,GRP_SOIL_CHEM,SOIL_CHEM_COMMENT,78.9 Mg C ha- 'http://public.ornl.gov/ameriflux/Site_Info/siteInfo.cfm?KEYID=us.walker_branch.01,8,EASTERN TEMPERATE FORESTS,8.4,OZARK/OUACHITA-APPALACHIAN FORESTS' in object 'BADM' +* checking data for ASCII and uncompressed saves ... WARNING + Warning: large data file saved inefficiently: + size ASCII compress + soil_class.RData 117Kb FALSE none + + Note: significantly better compression could be obtained + by using R CMD build --resave-data + old_size new_size compress + soil_class.RData 117Kb 18Kb xz +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... + Running ‘testthat.R’ + OK +* checking for non-standard things in the check directory ... OK +* checking for detritus in the temp directory ... OK +* DONE + +Status: 8 WARNINGs, 5 NOTEs +See + ‘/tmp/Rtmp9ipF88/PEcAn.data.land.Rcheck/00check.log’ +for details. + + diff --git a/modules/data.land/tests/testthat/test.PFT_consistency.R b/modules/data.land/tests/testthat/test.PFT_consistency.R index 1570a73403b..8879d1d008f 100644 --- a/modules/data.land/tests/testthat/test.PFT_consistency.R +++ b/modules/data.land/tests/testthat/test.PFT_consistency.R @@ -8,11 +8,16 @@ library(PEcAn.settings) library(PEcAn.DB) library(RPostgreSQL) -betyparms <- list(host = 'localhost', dbname = 'bety', - user = 'bety', password = 'bety', driver = 'PostgreSQL', write = FALSE) -fiaparms <- list(host = 'localhost', dbname = 'fia5data', - user = 'bety', password = 'bety', driver = 'PostgreSQL') -if(db.exists(params = betyparms) & db.exists(fiaparms)){ +betyparms <- PEcAn.DB::get_postgres_envvars( + host = "localhost", + dbname = "bety", + user = "bety", + password = "bety", + driver = "PostgreSQL", + write = FALSE) +fiaparms <- betyparms +fiaparms$dbname <- "fia5data" +if (db.exists(params = betyparms) & db.exists(fiaparms)) { context("Testing consistency of FIA PFTs") diff --git a/modules/data.land/tests/testthat/test.match_species_id.R b/modules/data.land/tests/testthat/test.match_species_id.R index 0ddb3f3e1ce..e64fdda86b4 100644 --- a/modules/data.land/tests/testthat/test.match_species_id.R +++ b/modules/data.land/tests/testthat/test.match_species_id.R @@ -2,7 +2,6 @@ context("Species matching") test_that("Species matching works", { - skip("Failing test (#1959); please fix and re-enable") test_merge <- function(input_codes, format_name, bety, ...) { dat_merge <- match_species_id(input_codes = input_codes, format_name = format_name, diff --git a/modules/data.mining/DESCRIPTION b/modules/data.mining/DESCRIPTION index b17bceee7db..1265f9067c2 100644 --- a/modules/data.mining/DESCRIPTION +++ b/modules/data.mining/DESCRIPTION @@ -2,8 +2,8 @@ Package: PEcAn.data.mining Type: Package Title: PEcAn functions used for exploring model residuals and structures Description: (Temporary description) PEcAn functions used for exploring model residuals and structures -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze")) Author: Mike Dietze Maintainer: Mike Dietze @@ -13,7 +13,7 @@ Imports: Suggests: PEcAn.utils, testthat (>= 1.0.2) -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE diff --git a/modules/data.remote/DESCRIPTION b/modules/data.remote/DESCRIPTION index 7e0c370e959..1a868474833 100644 --- a/modules/data.remote/DESCRIPTION +++ b/modules/data.remote/DESCRIPTION @@ -1,26 +1,40 @@ Package: PEcAn.data.remote Type: Package Title: PEcAn functions used for extracting remote sensing data -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("Bailey", "Morrison")) Author: Mike Dietze, Bailey Morrison Maintainer: Bailey Morrison Description: PEcAn module for processing remote data. Python module requirements: requests, json, re, ast, panads, sys. If any of these modules are missing, install using pip install . Imports: + DBI, + glue, + ncdf4, + PEcAn.DB, + PEcAn.utils, + purrr, + XML, + raster, + RCurl, + sp, MODISTools (>= 1.1.0), reticulate, PEcAn.logger, PEcAn.remote, - stringr (>= 1.1.0) + stringr (>= 1.1.0), + binaryLogic, + doParallel, + parallel, + foreach Suggests: testthat (>= 1.0.2), ggplot2, rgdal, reshape -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/data.remote/NAMESPACE b/modules/data.remote/NAMESPACE index 01e5532887b..501fe0991ca 100644 --- a/modules/data.remote/NAMESPACE +++ b/modules/data.remote/NAMESPACE @@ -3,5 +3,10 @@ export(call_MODIS) export(download.LandTrendr.AGB) export(download.NLCD) +export(download.thredds.AGB) export(extract.LandTrendr.AGB) export(extract_NLCD) +export(remote_process) +importFrom(foreach,"%do%") +importFrom(foreach,"%dopar%") +importFrom(purrr,"%>%") diff --git a/modules/data.remote/R/LandTrendr.AGB.R b/modules/data.remote/R/LandTrendr.AGB.R index 867e450f76c..ba874c48f62 100644 --- a/modules/data.remote/R/LandTrendr.AGB.R +++ b/modules/data.remote/R/LandTrendr.AGB.R @@ -204,7 +204,7 @@ download.LandTrendr.AGB <- function(outdir, target_dataset = "biomass", product_ ##' @return list of two containing the median AGB values per pixel and the corresponding ##' standard deviation values (uncertainties) ##' -##' ##' @examples +##' @examples ##' \dontrun{ ##' ##' # Example 1 - using BETYdb site IDs to extract data diff --git a/modules/data.remote/R/call_MODIS.R b/modules/data.remote/R/call_MODIS.R index f531c517f49..c5c9db94bb4 100755 --- a/modules/data.remote/R/call_MODIS.R +++ b/modules/data.remote/R/call_MODIS.R @@ -3,134 +3,308 @@ ##' @name call_MODIS ##' @title call_MODIS ##' @export -##' @param outfolder where the output file will be stored -##' @param start_date string value for beginning of date range for download in unambiguous date format (YYYYJJJ) -##' @param end_date string value for end of date range for download in unambiguous date format (YYYYJJJ) -##' @param lat Latitude of the pixel -##' @param lon Longitude of the pixel -##' @param size kmAboveBelow and kmLeftRight distance in km to be included +##' @param outdir where the output file will be stored. Default is NULL and in this case only values are returned. When path is provided values are returned and written to disk. +##' @param var the simple name of the modis dataset variable (e.g. lai) +##' @param site_info Bety list of site info for parsing MODIS data: list(site_id, site_name, lat, +##' lon, time_zone) +##' @param product_dates a character vector of the start and end date of the data in YYYYJJJ +##' @param run_parallel optional method to download data paralleize. Only works if more than 1 +##' site is needed and there are >1 CPUs available. +##' @param ncores number of cpus to use if run_parallel is set to TRUE. If you do not know the +##' number of CPU's available, enter NULL. ##' @param product string value for MODIS product number ##' @param band string value for which measurement to extract -##' @param band_qc string value for which quality control band, or use "NA" if you do not know or do not need QC information (optional) -##' @param band_sd string value for which standard deviation band, or use "NA" if you do not know or do not need StdDev information (optional) -##' @param package_method string value to inform function of which package method to use to download modis data. Either "MODISTools" or "reticulate" (optional) +##' @param package_method string value to inform function of which package method to use to download +##' modis data. Either "MODISTools" or "reticulate" (optional) +##' @param QC_filter Converts QC values of band and keeps only data values that are excellent or good +##' (as described by MODIS documentation), and removes all bad values. qc_band must be supplied for this +##' parameter to work. Default is False. Only MODISTools option. +##' @param progress TRUE reports the download progress bar of the dataset, FALSE omits the download +##' progress bar. Default is TRUE. Only MODISTools option. ##' -##' depends on a number of Python libraries. sudo -H pip install numpy suds netCDF4 json +##' Requires Python3 for reticulate method option. There are a number of required python libraries. +##' sudo -H pip install numpy suds netCDF4 json ##' depends on the MODISTools package version 1.1.0 ##' ##' @examples ##' \dontrun{ -##' test_modistools <- call_MODIS(product = "MOD15A2H", band = "Lai_500m", start_date = "2004300", end_date = "2004365", lat = 38, lon = -123, size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools") -##' plot(lubridate::yday(test_modistools$calendar_date), test_modistools$data, type = 'l', xlab = "day of year", ylab = test_modistools$band[1]) -##' test_reticulate <- call_MODIS(product = "MOD15A2H", band = "Lai_500m", start_date = "2004300", end_date = "2004365", lat = 38, lon = -123, size = 0, band_qc = "",band_sd = "", package_method = "reticulate") +##' site_info <- list( +##' site_id = 1, +##' site_name = "test", +##' lat = 44, +##' lon = 90, +##' time_zone = "UTC") +##' test_modistools <- call_MODIS( +##' var = "lai", +##' product = "MOD15A2H", +##' band = "Lai_500m", +##' site_info = site_info, +##' product_dates = c("2001150", "2001365"), +##' outdir = NULL, +##' run_parallel = TRUE, +##' ncores = NULL, +##' package_method = "MODISTools", +##' QC_filter = TRUE, +##' progress = FALSE) ##' } -##' +##' @importFrom foreach %do% %dopar% ##' @author Bailey Morrison -##' -call_MODIS <- function(outfolder = ".", start_date, end_date, lat, lon, size = 0, product, band, band_qc = "", band_sd = "", package_method = "MODISTools") { +##' +call_MODIS <- function(var, product, + band, site_info, + product_dates, + outdir = NULL, + run_parallel = FALSE, + ncores = NULL, + package_method = "MODISTools", + QC_filter = FALSE, + progress = FALSE) { - # makes the query search for 1 pixel and not for rasters for now. Will be changed when we provide raster output support. - size <- 0 + # makes the query search for 1 pixel and not for rasters chunks for now. Will be changed when we provide raster output support. + size <- 0 - # set start and end dates to correct format - if (package_method == "MODISTools"){ - - products = MODISTools::mt_products() - if (!(product %in% products$product)) - { - print(products) - stop("Product not available for MODIS API. Please chose a product from the list above.") + site_coords <- data.frame(site_info$lon, site_info$lat) + names(site_coords) <- c("lon","lat") + + # set up CPUS for parallel runs. + if (is.null(ncores)) { + total_cores <- parallel::detectCores(all.tests = FALSE, logical = TRUE) + ncores <- total_cores-2 + } + if (ncores > 10) # MODIS API has a 10 download limit / computer + { + ncores <- 10 + } + + # register CPUS if run_parallel = TRUE + if (run_parallel){ + if (progress){ + cl <- parallel::makeCluster(ncores, outfile = "") + doParallel::registerDoParallel(cl) } else { - print("Check #1: Product exists!") + cl <- parallel::makeCluster(ncores) + doParallel::registerDoParallel(cl) } + } + - dates <- MODISTools::mt_dates(product = product, lat = lat, lon = lon)$modis_date - dates <- as.numeric(substr(dates, 2, nchar(dates))) - if (as.numeric(start_date) <= dates[1] | as.numeric(end_date) >= dates[length(dates)]) + #################### if package_method == MODISTools option #################### + + if (package_method == "MODISTools") + { + #################### FUNCTION PARAMETER PRECHECKS #################### + #1. check that modis product is available + products <- MODISTools::mt_products() + if (!(product %in% products$product)) { - print(paste("Range of dates for product are ", dates[1], " - ", dates[length(dates)], sep = "")) - stop("Please choose dates between the date range listed above.") - } else { - print("Check #2: Dates are available!") - } + PEcAn.logger::logger.warn(products) + stop("Product not available for MODIS API. Please chose a product from the list above.") + } + #2. check that modis produdct band is available bands <- MODISTools::mt_bands(product = product) if (!(band %in% bands$band)) { - print(bands$band) + PEcAn.logger::logger.warn(bands$band) stop("Band selected is not avialable. Please selected from the bands listed above that correspond with the data product.") + } + + #3. check that dates asked for in function parameters are fall within dates available for modis product/bands. + if (run_parallel) + { + modis_dates <- as.numeric(substr(sort(unique(foreach::foreach(i = seq_along(nrow(site_coords)), .combine = c) + %dopar% MODISTools::mt_dates(product = product, lat = site_coords$lat[i], lon = site_coords$lon[i])$modis_date)), 2, 8)) } else { - print("Check #3: Band Exists!") + modis_dates <- as.numeric(substr(sort(unique(foreach::foreach(i = seq_along(nrow(site_coords)), .combine = c) %do% + MODISTools::mt_dates(product = product, lat = site_coords$lat[i], lon = site_coords$lon[i])$modis_date)), 2, 8)) } + + # check if user asked for dates for data, if not, download all dates + if (is.null(product_dates)) { + dates <- sort(unique(foreach::foreach(i = seq_along(nrow(site_coords)), .combine = c) %do% + MODISTools::mt_dates(product = product, lat = site_coords$lat[i], lon = site_coords$lon[i])$modis_date)) + #dates = as.Date(as.character(substr(dates, 2, nchar(dates))), format = "%Y%j") + } else { + # if user asked for specific dates, first make sure data is available, then inform user of any missing dates in time period asked for. + start_date <- as.numeric(product_dates[1]) + end_date <- as.numeric(product_dates[2]) - print("Extracting data") - - start <- as.Date(start_date, "%Y%j") - end <- as.Date(end_date, "%Y%j") + # if all dates are available with user defined time period: + if (start_date >= modis_dates[1] & end_date <= modis_dates[length(modis_dates)]) + { + PEcAn.logger::logger.info("Check #2: All dates are available!") + + start_date <- modis_dates[which(modis_dates >= start_date)[1]] + + include <- which(modis_dates <= end_date) + end_date <- modis_dates[include[length(include)]] + } - # extract main band data from api - dat <- MODISTools::mt_subset(lat=lat, lon=lon, product=product, band=band, - start=start, end=end, km_ab=size, km_lr=size) - # extract QC data - if(band_qc != ""){ - qc <- MODISTools::mt_subset(lat=lat, lon=lon, product=product, band=band_qc, - start=start, end=end, km_ab=size, km_lr=size) + # if start and end dates fall completely outside of available modis_dates: + if ((start_date < modis_dates[1] & end_date < modis_dates[1]) | start_date > modis_dates[length(modis_dates)] & end_date > modis_dates[length(modis_dates)]) + { + PEcAn.logger::logger.severe( + "Start and end date (", start_date, ", ", end_date, + ") are not within MODIS data product date range (", modis_dates[1], ", ", modis_dates[length(modis_dates)], + "). Please choose another date.") } - - # extract stdev data - if(band_sd != ""){ - sd <- MODISTools::mt_subset(lat=lat, lon=lon, product=product, band=band_sd, - start=start, end=end, km_ab=size, km_lr=size) + + # if start and end dates are larger than the available range, but part or full range: + if ((start_date < modis_dates[1] & end_date > modis_dates[1]) | start_date < modis_dates[length(modis_dates)] & end_date > modis_dates[length(modis_dates)]) + { + PEcAn.logger::logger.warn("WARNING: Dates are partially available. Start and/or end date extend beyond modis data product availability.") + start_date <- modis_dates[which(modis_dates >= start_date)[1]] + + include <- which(modis_dates <= end_date) + end_date <- modis_dates[include[length(include)]] } + dates <- modis_dates[which(modis_dates >= start_date & modis_dates <= end_date)] + + } + + modis_dates <- as.Date(as.character(modis_dates), format = "%Y%j") + dates <- as.Date(as.character(dates), format = "%Y%j") + + #### Start extracting the data + PEcAn.logger::logger.info("Extracting data") + + if (run_parallel) + { + dat <- foreach::foreach(i=seq_along(site_info$site_id), .combine = rbind) %dopar% + MODISTools::mt_subset(lat = site_coords$lat[i],lon = site_coords$lon[i], + product = product, + band = band, + start = dates[1], + end = dates[length(dates)], + km_ab = size, km_lr = size, + progress = progress, site_name = as.character(site_info$site_id[i])) + } else { + dat <- data.frame() - if (band_qc == "") + for (i in seq_along(site_info$site_id)) { - QC <- rep("nan", nrow(dat)) - } else { - QC <- as.numeric(qc$value) + d <- MODISTools::mt_subset(lat = site_coords$lat[i], + lon = site_coords$lon[i], + product = product, + band = band, + start = dates[1], + end = dates[length(dates)], + km_ab = size, km_lr = size, + progress = progress) + dat <- rbind(dat, d) } + } + + # clean up data outputs so there isn't extra data, format classes. + output <- as.data.frame(cbind(dat$modis_date, dat$calendar_date, dat$band, dat$tile, dat$site, dat$latitude, dat$longitude, dat$pixel, dat$value), stringsAsFactors = FALSE) + names(output) <- c("modis_date", "calendar_date", "band", "tile", "site_id", "lat", "lon", "pixels", "data") + + output[ ,5:9] <- lapply(output[ ,5:9], as.numeric) + + # scale the data + stdev to proper units + output$data <- output$data * (as.numeric(dat$scale)) + output$lat <- round(output$lat, 4) + output$lon <- round(output$lon, 4) + + # remove bad values if QC filter is on + if (QC_filter) + { + qc_band <- bands$band[which(grepl(var, bands$band, ignore.case = TRUE) & grepl("QC", bands$band, ignore.case = TRUE))] - if (band_sd == "") + if (run_parallel) { - SD <- rep("nan", nrow(dat)) - } else { - SD <- as.numeric(sd$value) * as.numeric(sd$scale) #formatC(sd$data$data*scale, digits = 2, format = 'f') - } - - output <- as.data.frame(cbind(dat$modis_date, dat$calendar_date, dat$band, dat$tile, dat$latitude, dat$longitude, dat$pixel, dat$value, QC, SD), stringsAsFactors = F) - names(output) <- c("modis_date", "calendar_date", "band", "tile", "lat", "lon", "pixels", "data", "qc", "sd") - - output[,5:10] <- lapply(output[,5:10], as.numeric) + qc <- foreach::foreach(i=seq_along(site_info$site_id), .combine = rbind) %dopar% + MODISTools::mt_subset(lat = site_coords$lat[i],lon = site_coords$lon[i], + product = product, + band = qc_band, + start = dates[1], + end = dates[length(dates)], + km_ab = size, km_lr = size, + progress = progress) + } else { + qc <- MODISTools::mt_subset(lat = site_coords$lat[i],lon = site_coords$lon[i], + product = product, + band = qc_band, + start = dates[1], + end = dates[length(dates)], + km_ab = size, km_lr = size, + progress = progress) + + } - # scale the data + stdev to proper units - output$data <- output$data * (as.numeric(dat$scale)) - output$sd <- output$sd * (as.numeric(dat$scale)) - output$lat <- round(output$lat, 4) - output$lon <- round(output$lon, 4) + output$qc <- as.character(qc$value) - fname <- paste(product, "_", band, "output_", start_date, "_", end_date, "_", lat, "_", lon, ".csv", sep = "") - fname <- paste0(outfolder, "/", fname) - write.csv(output, fname) - return(output)} - + #convert QC values and keep only okay values + for (i in seq_len(nrow(output))) + { + convert <- paste(binaryLogic::as.binary(as.integer(output$qc[i]), n = 8), collapse = "") + output$qc[i] <- substr(convert, nchar(convert) - 2, nchar(convert)) + } + good <- which(output$qc %in% c("000", "001")) + if (length(good) > 0) + { + output <- output[good, ] + } else { + PEcAn.logger::logger.warn("All QC values are bad. No data to output with QC filter == TRUE.") + } + } - if (package_method == "reticulate"){ - # load in python script - script.path <- file.path(system.file("extract_modis_data.py", package = "PEcAn.data.remote")) - #script.path = file.path('/Users/bmorrison/pecan/modules/data.remote/inst/extract_modis_data.py') - reticulate::source_python(script.path) + # unregister cores since parallel process is done + if (run_parallel) + { + parallel::stopCluster(cl) + } + + # break dataoutput up by site and save out chunks + if (!(is.null(outdir))) + { + for (i in seq_along(site_info$site_id)) + { + if (!(dir.exists(file.path(outdir, site_info$site_id[i])))) + { + dir.create(file.path(outdir, site_info$site_id[i])) + } + + site <- output[which(output$site_id == site_info$site_id[i]), ] + site$modis_date <- substr(site$modis_date, 2, length(site$modis_date)) + + if (QC_filter) + { + fname <- paste(site_info$site_id[i], "/", product, "_", band, "_", start_date, "-", end_date, "_filtered.csv", sep = "") + } else { + fname <- paste(site_info$site_id[i], "/", product, "_", band, "_", start_date, "-", end_date, "_unfiltered.csv", sep = "") + } + fname <- file.path(outdir, fname) + write.csv(site, fname, row.names = FALSE) + } - # extract the data - output <- extract_modis_data(product = product, band = band, lat = lat, lon = lon, start_date = start_date, end_date = end_date, size = size, band_qc = band_qc, band_sd = band_sd) - output[,5:10] <- lapply(output[,5:10], as.numeric) - output$lat <- round(output$lat, 4) - output$lon <- round(output$lon, 4) + } - fname <- paste(product, "_", band, "_", start_date, "_", end_date, "_", lat, "_", lon, ".csv", sep = "") - fname <- paste0(outfolder, "/", fname) - write.csv(output, fname) - return(output)} + return(output) + } + + ########### temporarily removed for now as python2 is being discontinued and modules are not working correctly + # if (package_method == "reticulate"){ + # # load in python script + # script.path <- file.path(system.file("extract_modis_data.py", package = "PEcAn.data.remote")) + # reticulate::source_python(script.path) + # + # # extract the data + # output <- extract_modis_data(product = product, band = band, lat = lat, lon = lon, start_date = start_date, end_date = end_date, size = size, band_qc = band_qc, band_sd = band_sd) + # output[ ,5:10] <- lapply(output[ ,5:10], as.numeric) + # output$lat <- round(output$lat, 4) + # output$lon <- round(output$lon, 4) + # + # if (!(is.null(outdir))) + # { + # fname <- paste(product, "_", band, "_", start_date, "_", end_date, "_", lat, "_", lon, ".csv", sep = "") + # fname <- file.path(outdir, fname) + # write.csv(output, fname) + # } + # + # return(output)} + } diff --git a/modules/data.remote/R/download.thredds.R b/modules/data.remote/R/download.thredds.R new file mode 100755 index 00000000000..568a49b437e --- /dev/null +++ b/modules/data.remote/R/download.thredds.R @@ -0,0 +1,103 @@ +# +##' @title download.thredds.AGB +##' @name download.thredds.AGB +##' +##' @param outdir Where to place output +##' @param site_ids What locations to download data at? +##' @param run_parallel Logical. Download and extract files in parallel? +##' @param ncores Optional. If run_parallel=TRUE how many cores to use? If left as NULL will select max number -1 +##' +##' @return data.frame summarize the results of the function call +##' +##' @examples +##' \dontrun{ +##' outdir <- "~/scratch/abg_data/" + +##' results <- PEcAn.data.remote::download.thredds.AGB(outdir=outdir, +##' site_ids = c(676, 678, 679, 755, 767, 1000000030, 1000000145, 1000025731), +##' run_parallel = TRUE, ncores = 8) +##' } +##' @export +##' @author Bailey Morrison +##' +download.thredds.AGB <- function(outdir = NULL, site_ids, run_parallel = FALSE, + ncores = NULL) { + + + bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) + con <- PEcAn.DB::db.open(bety) + bety$con <- con + site_ID <- as.character(site_ids) + suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) + suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) + site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + mylat = site_info$lat + mylon = site_info$lon + + # site specific URL for dataset --> these will be made to work for all THREDDS datasets in the future, but for now, just testing with + # this one dataset. This specific dataset only has 1 year (2005), so no temporal looping for now. + obs_file = "https://thredds.daac.ornl.gov/thredds/dodsC/ornldaac/1221/agb_5k.nc4" + obs_err = "https://thredds.daac.ornl.gov/thredds/dodsC/ornldaac/1221/agb_SE_5k.nc4" + files = c(obs_file, obs_err) + + # function to extract ncdf data from lat and lon values for value + SE URLs + get_data = function(i) + { + data = ncdf4::nc_open(files[1]) + agb_lats = ncdf4::ncvar_get(data, "latitude") + agb_lons = ncdf4::ncvar_get(data, "longitude") + + agb_x = which(abs(agb_lons- mylon[i]) == min(abs(agb_lons - mylon[i]))) + agb_y = which(abs(agb_lats- mylat[i]) == min(abs(agb_lats - mylat[i]))) + + start = c(agb_x, agb_y) + count = c(1,1) + d = ncdf4::ncvar_get(ncdf4::nc_open(files[1]), "abvgrndbiomass", start=start, count = count) + if (is.na(d)) d <- NA + sd = ncdf4::ncvar_get(ncdf4::nc_open(files[2]), "agbSE", start=start, count = count) + if (is.na(sd)) sd <- NA + date = "2005" + site = site_ID[i] + output = as.data.frame(cbind(d, sd, date, site)) + names(output) = c("value", "sd", "date", "siteID") + + # option to save output dataset to directory for user. + if (!(is.null(outdir))) + { + write.csv(output, file = paste0(outdir, "THREDDS_", sub("^([^.]*).*", "\\1",basename(files[1])), "_site_", site, ".csv"), row.names = FALSE) + } + + return(output) + } + + ## setup parallel + if (run_parallel) { + if (!is.null(ncores)) { + ncores <- ncores + } else { + ncores <- parallel::detectCores() -1 + } + require(doParallel) + PEcAn.logger::logger.info(paste0("Running in parallel with: ", ncores)) + cl = parallel::makeCluster(ncores) + doParallel::registerDoParallel(cl) + data = foreach(i = seq_along(mylat), .combine = rbind) %dopar% get_data(i) + stopCluster(cl) + + } else { + # setup sequential run + data = data.frame() + for (i in seq_along(mylat)) + { + data = rbind(data, get_data(i)) + } + } + + return(data) +} diff --git a/modules/data.remote/R/remote_process.R b/modules/data.remote/R/remote_process.R new file mode 100644 index 00000000000..4e745e55b22 --- /dev/null +++ b/modules/data.remote/R/remote_process.R @@ -0,0 +1,1162 @@ +##' call rp_control (from RpTools Python package) and store the output in BETY +##' +##' @name remote_process +##' @title remote_process +##' @export +##' +##' @param settings PEcAn settings list containing remotedata tags: source, collection, scale, projection, qc, algorithm, credfile, out_get_data, out_process_data, overwrite +##' +##' @examples +##' \dontrun{ +##' remote_process(settings) +##' } +##' @author Ayush Prasad, Istem Fer +##' + +remote_process <- function(settings) { + # Information about the date variables used in remote_process: + # req_start, req_end : start, end dates requested by the user, the user does not have to be aware about the status of the requested file in the DB + # start, end : effective start, end dates created after checking the DB status. These dates are sent to rp_control for downloading and processing data + # write_raw_start, write_raw_end : start, end dates which are used while inserting and updating the DB + # the "pro" version of these variables have the same meaning and are used to refer to the processed file + + # The value of remotefile_check_flag denotes the following cases: + + # When processed file is requested, + # 1 - There are no existing raw and processed files of the requested type in the DB + # 2 - Requested processed file does not exist, the raw file used to create is it present and matches with the requested daterange + # 3 - Requested processed file does not exist, raw file used to create it is present but has to be updated to match with the requested daterange + # 4 - Both processed and raw file of the requested type exists, but they have to be updated to match with the requested daterange + # 5 - Raw file required for creating the processed file exists with the required daterange and the processed file needs to be updated. Here the new processed file will now contain data for the entire daterange of the existing raw file + # 6 - There is a existing processed file of the requested type but the raw file used to create it has been deleted. Here, the raw file will be created again and the processed file will be replaced entirely with the one created from new raw file + + # When raw file is requested, + # 1 - There is no existing raw the requested type in the DB + # 2 - existing raw file will be updated + + RpTools <- reticulate::import("RpTools") + + # extract the variables from the settings list + siteid <- as.numeric(settings$run$site$id) + siteid_short <- paste0(siteid %/% 1e+09, "-", siteid %% 1e+09) + outdir <- settings$database$dbfiles + lat <- as.numeric(settings$run$site$lat) + lon <- as.numeric(settings$run$site$lon) + start <- as.character(as.Date(settings$run$start.date)) + end <- as.character(as.Date(settings$run$end.date)) + source <- settings$remotedata$source + collection <- settings$remotedata$collection + reg_info <- read_remote_registry(source, collection) + collection <- reg_info$pecan_name + raw_mimetype <- reg_info$raw_mimetype + raw_formatname <- reg_info$raw_formatname + pro_mimetype <- reg_info$pro_mimetype + pro_formatname <- reg_info$pro_formatname + + + if (!is.null(reg_info$scale)) { + if(!is.null(settings$remotedata$scale)){ + scale <- as.double(settings$remotedata$scale) + scale <- format(scale, nsmall = 1) + }else{ + scale <- as.double(reg_info$scale) + scale <- format(scale, nsmall = 1) + PEcAn.logger::logger.warn(paste0("scale not provided, using default scale ", scale)) + } + }else{ + scale <- NULL + } + + if (!is.null(reg_info$qc)) { + if(!is.null(settings$remotedata$qc)){ + qc <- as.double(settings$remotedata$qc) + qc <- format(qc, nsmall = 1) + }else{ + qc <- as.double(reg_info$qc) + qc <- format(qc, nsmall = 1) + PEcAn.logger::logger.warn(paste0("qc not provided, using default qc ", qc)) + } + }else{ + qc <- NULL + } + + if (!is.null(reg_info$projection)) { + if(!is.null(settings$remotedata$projection)){ + projection <- settings$remotedata$projection + }else{ + projection <- reg_info$projection + PEcAn.logger::logger.warn(paste0("projection not provided, using default projection ", projection)) + } + }else{ + projection <- NULL + } + + algorithm <- settings$remotedata$algorithm + credfile <- settings$remotedata$credfile + out_get_data <- settings$remotedata$out_get_data + out_process_data <- settings$remotedata$out_process_data + overwrite <- settings$remotedata$overwrite + if (is.null(overwrite)) { + overwrite <- FALSE + } + + + PEcAn.logger::severeifnot("Check if siteid is of numeric type and is not NULL", + is.numeric(siteid)) + PEcAn.logger::severeifnot("Check if outdir is of character type and is not NULL", + is.character(outdir)) + PEcAn.logger::severeifnot("Check if source is of character type and is not NULL", + is.character(source)) + these_sources <- gsub("^.+?\\.(.+?)\\..*$", "\\1", list.files(system.file("registration", package = "PEcAn.data.remote"))) + PEcAn.logger::severeifnot(paste0("Source should be one of ", paste(these_sources, collapse = ' ')), toupper(source) %in% these_sources) + # collection validation to be implemented + if (!is.null(projection)) { + PEcAn.logger::severeifnot("projection should be of character type", + is.character(projection)) + } + if (!is.null(algorithm)) { + PEcAn.logger::severeifnot("algorithm should be of character type", + is.character(algorithm)) + } + if (!is.null(credfile)) { + PEcAn.logger::severeifnot("credfile should be of character type", + is.character(credfile)) + } + PEcAn.logger::severeifnot( + "Check if out_get_data is of character type and is not NULL", + is.character(out_get_data) + ) + if (!is.null(out_process_data)) { + PEcAn.logger::severeifnot("out_process_data should be of character type", + is.character(out_process_data)) + } + + + dbcon <- PEcAn.DB::db.open(settings$database$bety) + on.exit(PEcAn.DB::db.close(dbcon), add = TRUE) + + # extract the AOI of the site from BETYdb + coords <- + unlist(PEcAn.DB::db.query( + sprintf("select ST_AsGeoJSON(geometry) from sites where id=%f", siteid), + con = dbcon + ), use.names = FALSE) + + if(!(tolower(gsub(".*type(.+),coordinates.*", "\\1", gsub("[^=A-Za-z,0-9{} ]+","",coords))) %in% reg_info$coordtype)){ + PEcAn.logger::logger.severe(paste0("Coordinate type of the site is not supported by the requested source, please make sure that your site type is ", reg_info$coordtype)) + } + + # construct raw file name + remotedata_file_names <- construct_remotedata_filename(source, collection, siteid_short, scale, projection, qc, algorithm, out_process_data) + + raw_file_name <- remotedata_file_names$raw_file_name + + pro_file_name <- remotedata_file_names$pro_file_name + + + # check if any data is already present in the inputs table + dbstatus <- + remotedata_db_check( + raw_file_name = raw_file_name, + pro_file_name = pro_file_name, + start = start, + end = end, + siteid = siteid, + siteid_short = siteid_short, + out_get_data = out_get_data, + algorithm = algorithm, + out_process_data = out_process_data, + overwrite = overwrite, + dbcon = dbcon + ) + + remotefile_check_flag <- dbstatus$remotefile_check_flag + start <- dbstatus$start + end <- dbstatus$end + stage_get_data <- dbstatus$stage_get_data + write_raw_start <- dbstatus$write_raw_start + write_raw_end <- dbstatus$write_raw_end + raw_merge <- dbstatus$raw_merge + existing_raw_file_path <- dbstatus$existing_raw_file_path + stage_process_data <- dbstatus$stage_process_data + write_pro_start <- dbstatus$write_pro_start + write_pro_end <- dbstatus$write_pro_end + pro_merge <- dbstatus$pro_merge + input_file <- dbstatus$input_file + existing_pro_file_path <- dbstatus$existing_pro_file_path + raw_check <- dbstatus$raw_check + pro_check <- dbstatus$pro_check + + + if(stage_get_data == FALSE && stage_process_data == FALSE){ + # requested data already exists, no need to call rp_control + settings$remotedata$raw_id <- raw_check$id + settings$remotedata$raw_path <- raw_check$file_path + settings$remotedata$pro_id <- pro_check$id + settings$remotedata$pro_path <- pro_check$file_path + return(settings) + } + + + # construct outdir path + outdir <- + file.path(outdir, paste(toupper(source), "site", siteid_short, sep = "_")) + + + fcn.args <- list() + fcn.args$coords <- coords + fcn.args$outdir <- outdir + fcn.args$lat <- lat + fcn.args$lon <- lon + fcn.args$start <- start + fcn.args$end <- end + fcn.args$source <- source + fcn.args$collection <- collection + fcn.args$siteid <- siteid_short + fcn.args$scale <- as.double(scale) + fcn.args$projection <- projection + fcn.args$qc <- as.double(qc) + fcn.args$algorithm <- algorithm + fcn.args$input_file <- input_file + fcn.args$credfile <- credfile + fcn.args$out_get_data <- out_get_data + fcn.args$out_process_data <- out_process_data + fcn.args$stage_get_data <- stage_get_data + fcn.args$stage_process_data <- stage_process_data + fcn.args$raw_merge <- raw_merge + fcn.args$pro_merge <- pro_merge + fcn.args$existing_raw_file_path <- existing_raw_file_path + fcn.args$existing_pro_file_path <- existing_pro_file_path + fcn.args$raw_file_name <- raw_file_name + fcn.args$pro_file_name <- pro_file_name + + + + + arg.string <- PEcAn.utils::listToArgString(fcn.args) + + cmdFcn <- paste0("RpTools$rp_control(", arg.string, ")") + PEcAn.logger::logger.debug(paste0("Remote module executing the following function:\n", cmdFcn)) + + # call rp_control + output <- do.call(RpTools$rp_control, fcn.args) + + + # insert output data in the DB + db_out <- + remotedata_db_insert( + output = output, + remotefile_check_flag = remotefile_check_flag, + siteid = siteid, + out_get_data = out_get_data, + out_process_data = out_process_data, + write_raw_start = write_raw_start, + write_raw_end = write_raw_end, + write_pro_start = write_pro_start, + write_pro_end = write_pro_end, + raw_check = raw_check, + pro_check = pro_check, + raw_mimetype = raw_mimetype, + raw_formatname = raw_formatname, + pro_mimetype = pro_mimetype, + pro_formatname = pro_formatname, + dbcon = dbcon + ) + + + # return the ids and paths of the inserted data + if (!is.null(out_get_data)) { + settings$remotedata$raw_id <- db_out$raw_id + settings$remotedata$raw_path <- db_out$raw_path + } + if (!is.null(out_process_data)) { + settings$remotedata$pro_id <- db_out$pro_id + settings$remotedata$pro_path <- db_out$pro_path + } + + return (settings) +} + + + +##' construct remotedata module file names +##' +##' @name construct_remotedata_filename +##' @title construct_remotedata_filename +##' @param source source +##' @param collection collection or product requested from the source +##' @param siteid shortform of siteid +##' @param scale scale, NULL by default +##' @param projection projection, NULL by default +##' @param qc qc_parameter, NULL by default +##' @param algorithm algorithm name to process data, NULL by default +##' @param out_process_data variable name requested for the processed file, NULL by default +##' @return remotedata_file_names +##' @examples +##' \dontrun{ +##' remotedata_file_names <- construct_remotedata_filename( +##' source="gee", +##' collection="s2", +##' siteid="0-721", +##' scale=10.0 +##' projection=NULL +##' qc=1.0, +##' algorithm="snap", +##' out_process_data="lai") +##' } +##' @author Ayush Prasad +construct_remotedata_filename <- + function(source, + collection, + siteid, + scale = NULL, + projection = NULL, + qc = NULL, + algorithm = NULL, + out_process_data = NULL) { + # skip if a parameter is not applicable and is NULL + if (is.null(scale)) { + scale_str <- "_" + } else{ + scale_str <- paste0("_", format(scale, nsmall = 1), "_") + } + if (is.null(projection)) { + prj_str <- "" + }else{ + prj_str <- paste0(projection, "_") + } + if (is.null(qc)) { + qc_str <- "" + } else{ + qc_str <- paste0(format(qc, nsmall = 1), "_") + } + + raw_file_name <- paste0(toupper(source), "_", collection, scale_str, prj_str, qc_str, "site_", siteid) + if(!is.null(out_process_data)){ + alg_str <- paste0(algorithm, "_") + var_str <- paste0(out_process_data, "_") + pro_file_name <- paste0(toupper(source), "_", collection, scale_str, prj_str, qc_str, alg_str, var_str, "site_", siteid) + }else{ + pro_file_name <- NULL + } + + remotedata_file_names <- list(raw_file_name = raw_file_name, + pro_file_name = pro_file_name) + + return(remotedata_file_names) + } + + + + +##' set dates, stage and merge status for remote data download +##' +##' @name set_stage +##' @title set_stage +##' @param result dataframe containing id, site_id, name, start_date, end_date from inputs table and file_path from dbfiles table +##' @param req_start start date requested by the user +##' @param req_end end date requested by the user +##' @param stage the stage which needs to be set, get_remote_data or process_remote_data +##' @return list containing req_start, req_end, stage, merge, write_start, write_end +##' @examples +##' \dontrun{ +##' raw_check <- set_stage( +##' result, +##' req_start, +##' req_end, +##' get_remote_data) +##' } +##' @author Ayush Prasad +set_stage <- function(result, req_start, req_end, stage) { + db_start <- as.Date(result$start_date) + db_end <- as.Date(result$end_date) + req_start <- as.Date(req_start) + req_end <- as.Date(req_end) + stage <- TRUE + merge <- TRUE + + # data already exists + if ((req_start >= db_start) && (req_end <= db_end)) { + req_start <- "dont write" + req_end <- "dont write" + stage <- FALSE + merge <- FALSE + write_start <- "dont write" + write_end <- "dont write" + } else if (req_start < db_start && db_end < req_end) { + # data has to be replaced + merge <- "replace" + write_start <- req_start + write_end <- req_end + stage <- TRUE + } else if ((req_start > db_start) && (req_end > db_end)) { + # forward case + req_start <- db_end + 1 + write_start <- db_start + write_end <- req_end + } else if ((req_start < db_start) && (req_end < db_end)) { + # backward case + req_end <- db_start - 1 + write_end <- db_end + write_start <- req_start + } + return (list(req_start = req_start, req_end = req_end, stage = stage, merge = merge, write_start = write_start, write_end = write_end)) + +} + + + + +##' read remote module registration files +##' +##' @name read_remote_registry +##' @title read_remote_registry +##' @importFrom purrr %>% +##' @param source remote source, e.g gee or appeears +##' @param collection collection or product name +##' @return list containing original_name, pecan_name, scale, qc, projection raw_mimetype, raw_formatname pro_mimetype, pro_formatname, coordtype +##' @examples +##' \dontrun{ +##' read_remote_registry( +##' "gee", +##' "COPERNICUS/S2_SR") +##' } +##' @author Istem Fer +read_remote_registry <- function(source, collection){ + + # get registration file + register.xml <- system.file(paste0("registration/register.", toupper(source), ".xml"), package = "PEcAn.data.remote") + + tryCatch(expr = { + register <- XML::xmlToList(XML::xmlParse(register.xml)) + }, + error = function(e){ + PEcAn.logger::logger.severe("Requested source is not available") + } + ) + . <- NULL + + if(!(purrr::is_empty(register %>% purrr::keep(names(.) == "collection")))){ + # this is a type of source that requires different setup for its collections, e.g. GEE + # then read collection specific information + register <- register[[which(register %>% purrr::map_chr("original_name") == collection)]] + } + + reg_list <- list() + reg_list$original_name <- ifelse(is.null(register$original_name), collection, register$original_name) + reg_list$pecan_name <- ifelse(is.null(register$pecan_name), collection, register$pecan_name) + reg_list$scale <- register$scale + reg_list$qc <- register$qc + reg_list$projection <- register$projection + reg_list$raw_mimetype <- register$raw_format$mimetype + reg_list$raw_formatname <- register$raw_format$name + reg_list$pro_mimetype <- register$pro_format$mimetype + reg_list$pro_formatname <- register$pro_format$name + reg_list$coordtype <- unlist(register$coord) + + return(reg_list) +} + + + + + +##' check the status of the requested data in the DB +##' +##' @name remotedata_db_check +##' @title remotedata_db_check +##' @param raw_file_name raw_file_name +##' @param pro_file_name pro_file_name +##' @param start start date requested by user +##' @param end end date requested by the user +##' @param siteid siteid of the site +##' @param siteid_short short form of the siteid +##' @param out_get_data out_get_data +##' @param algorithm algorithm +##' @param out_process_data out_process_data +##' @param overwrite overwrite +##' @param dbcon BETYdb con +##' @return list containing remotefile_check_flag, start, end, stage_get_data, write_raw_start, write_raw_end, raw_merge, existing_raw_file_path, stage_process_data, write_pro_start, write_pro_end, pro_merge, input_file, existing_pro_file_path, raw_check, pro_check +##' @examples +##' \dontrun{ +##' dbstatus <- remotedata_db_check( +##' raw_file_name, +##' pro_file_name, +##' start, +##' end, +##' siteid, +##' siteid_short, +##' out_get_data, +##' algorithm, +##' out_process_data, +##' overwrite +##' dbcon) +##' } +##' @author Ayush Prasad +remotedata_db_check <- + function(raw_file_name, + pro_file_name, + start, + end, + siteid, + siteid_short, + out_get_data, + algorithm, + out_process_data, + overwrite, + dbcon) { + + # Information about the date variables used: + # req_start, req_end : start, end dates requested by the user, the user does not have to be aware about the status of the requested file in the DB + # start, end : effective start, end dates created after checking the DB status. These dates are sent to rp_control for downloading and processing data + # write_raw_start, write_raw_end : start, end dates which are used while inserting and updating the DB + # the "pro" version of these variables have the same meaning and are used to refer to the processed file + + req_start <- start + req_end <- end + input_file <- NULL + stage_get_data <- FALSE + stage_process_data <- FALSE + raw_merge <- NULL + pro_merge <- NULL + existing_raw_file_path <- NULL + existing_pro_file_path <- NULL + write_raw_start <- NULL + write_raw_end <- NULL + write_pro_start <- NULL + write_pro_end <- NULL + raw_check <- NULL + pro_check <- NULL + remotefile_check_flag <- NULL + + existing_data <- + PEcAn.DB::db.query(paste0("SELECT * FROM inputs WHERE site_id=", siteid), dbcon) + if (nrow(existing_data) >= 1) { + if (overwrite) { + PEcAn.logger::logger.warn("overwrite is set to TRUE, any existing file will be entirely replaced") + if (!is.null(out_process_data)) { + if (nrow(pro_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + pro_file_name + ), + dbcon + )) == 1) { + if (nrow(raw_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + raw_file_name + ), + dbcon + )) == 1) { + remotefile_check_flag <- 4 + } else{ + remotefile_check_flag <- 6 + } + } else{ + remotefile_check_flag <- 1 + } + stage_process_data <- TRUE + pro_merge <- "replace" + write_pro_start <- start + write_pro_end <- end + } else if (!is.null(out_get_data)) { + if (nrow(raw_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + raw_file_name + ), + dbcon + )) == 1) { + remotefile_check_flag <- 2 + } else{ + remotefile_check_flag <- 1 + } + } + stage_get_data <- TRUE + start <- req_start + end <- req_end + write_raw_start <- start + write_raw_end <- end + raw_merge <- "replace" + existing_pro_file_path <- NULL + existing_raw_file_path <- NULL + } else if (!is.null(out_process_data)) { + # if processed data is requested, example LAI + + # check if processed file exists + if (nrow(pro_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + pro_file_name + ), + dbcon + )) == 1) { + datalist <- + set_stage(pro_check, req_start, req_end, stage_process_data) + pro_start <- as.character(datalist$req_start) + pro_end <- as.character(datalist$req_end) + write_pro_start <- datalist$write_start + write_pro_end <- datalist$write_end + if (pro_start != "dont write" || pro_end != "dont write") { + stage_process_data <- datalist$stage + pro_merge <- datalist$merge + if (pro_merge == TRUE) { + existing_pro_file_path <- file.path(pro_check$file_path, pro_check$name) + } + if (stage_process_data == TRUE) { + # check about the status of raw file + raw_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + raw_file_name + ), + dbcon + ) + if (!is.null(raw_check$start_date) && + !is.null(raw_check$end_date)) { + raw_datalist <- + set_stage(raw_check, pro_start, pro_end, stage_get_data) + start <- as.character(raw_datalist$req_start) + end <- as.character(raw_datalist$req_end) + write_raw_start <- raw_datalist$write_start + write_raw_end <- raw_datalist$write_end + stage_get_data <- raw_datalist$stage + raw_merge <- raw_datalist$merge + if (stage_get_data == FALSE) { + input_file <- raw_check$file_path + } + remotefile_check_flag <- 4 + if (raw_merge == TRUE) { + existing_raw_file_path <- file.path(raw_check$file_path, raw_check$name) + } + if (pro_merge == TRUE && stage_get_data == FALSE) { + remotefile_check_flag <- 5 + write_pro_start <- raw_check$start_date + write_pro_end <- raw_check$end_date + existing_pro_file_path <- NULL + pro_merge <- FALSE + } + } else{ + # this case happens when the processed file has to be extended but the raw file used to create the existing processed file has been deleted + remotefile_check_flag <- 6 + write_raw_start <- req_start + write_raw_end <- req_end + start <- req_start + end <- req_end + stage_get_data <- TRUE + existing_raw_file_path <- NULL + write_pro_start <- write_raw_start + write_pro_end <- write_raw_end + pro_merge <- "replace" + existing_pro_file_path <- NULL + } + } + } else{ + # requested file already exists + pro_id <- pro_check$id + pro_path <- pro_check$file_path + if (nrow(raw_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + raw_file_name + ), + dbcon + )) == 1) { + raw_id <- raw_check$id + raw_path <- raw_check$file_path + } + } + } + else if (nrow(raw_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + raw_file_name + ), + dbcon + )) == 1) { + # if the processed file does not exist in the DB check if the raw file required for creating it is present + PEcAn.logger::logger.info("Requested processed file does not exist in the DB, checking if the raw file does") + datalist <- + set_stage(raw_check, req_start, req_end, stage_get_data) + start <- as.character(datalist$req_start) + end <- as.character(datalist$req_end) + write_raw_start <- datalist$write_start + write_raw_end <- datalist$write_end + write_pro_start <- req_start + write_pro_end <- req_end + stage_get_data <- datalist$stage + if (stage_get_data == FALSE) { + input_file <- raw_check$file_path + write_pro_start <- raw_check$start_date + write_pro_end <- raw_check$end_date + remotefile_check_flag <- 2 + } + raw_merge <- datalist$merge + stage_process_data <- TRUE + pro_merge <- FALSE + if (raw_merge == TRUE || raw_merge == "replace") { + existing_raw_file_path = file.path(raw_check$file_path, raw_check$name) + remotefile_check_flag <- 3 + } else{ + existing_raw_file_path <- NULL + } + } else{ + # if no processed or raw file of requested type exists + start <- req_start + end <- req_end + write_raw_start <- req_start + write_raw_end <- req_end + write_pro_start <- req_start + write_pro_end <- req_end + stage_get_data <- TRUE + raw_merge <- FALSE + existing_raw_file_path <- NULL + stage_process_data <- TRUE + pro_merge <- FALSE + existing_pro_file_path <- NULL + remotefile_check_flag <- 1 + } + } else if (nrow(raw_check <- + PEcAn.DB::db.query( + sprintf( + "SELECT inputs.id, inputs.site_id, dbfiles.file_name as name, inputs.start_date, inputs.end_date, dbfiles.file_path FROM inputs INNER JOIN dbfiles ON inputs.id=dbfiles.container_id AND dbfiles.file_name LIKE '%s%%';", + raw_file_name + ), + dbcon + )) == 1) { + # if only raw data is requested + datalist <- + set_stage(raw_check, req_start, req_end, stage_get_data) + start <- as.character(datalist$req_start) + end <- as.character(datalist$req_end) + stage_get_data <- datalist$stage + raw_merge <- datalist$merge + write_raw_start <- datalist$write_start + write_raw_end <- datalist$write_end + stage_process_data <- FALSE + if (as.character(write_raw_start) == "dont write" && + as.character(write_raw_end) == "dont write") { + raw_id <- raw_check$id + raw_path <- raw_check$file_path + } + if (raw_merge == TRUE) { + existing_raw_file_path <- file.path(raw_check$file_path, raw_check$name) + remotefile_check_flag <- 2 + } else{ + existing_raw_file_path <- NULL + } + existing_pro_file_path <- NULL + } else{ + # no data of requested type exists + PEcAn.logger::logger.info("Requested data does not exist in the DB, retrieving for the first time") + remotefile_check_flag <- 1 + start <- req_start + end <- req_end + if (!is.null(out_get_data)) { + stage_get_data <- TRUE + write_raw_start <- req_start + write_raw_end <- req_end + raw_merge <- FALSE + existing_raw_file_path <- NULL + } + if (!is.null(out_process_data)) { + stage_process_data <- TRUE + write_pro_start <- req_start + write_pro_end <- req_end + pro_merge <- FALSE + process_file_name <- NULL + existing_pro_file_path <- NULL + remotefile_check_flag <- 1 + } + } + + } else{ + # db is completely empty for the given siteid + PEcAn.logger::logger.info("DB is completely empty for this site") + remotefile_check_flag <- 1 + start <- req_start + end <- req_end + stage_get_data <- TRUE + write_raw_start <- req_start + write_raw_end <- req_end + raw_merge <- FALSE + existing_raw_file_path <- NULL + if (!is.null(out_process_data)) { + stage_process_data <- TRUE + write_pro_start <- req_start + write_pro_end <- req_end + pro_merge <- FALSE + existing_pro_file_path <- NULL + } + } + + + return( + list( + remotefile_check_flag = remotefile_check_flag, + start = start, + end = end, + stage_get_data = stage_get_data, + write_raw_start = write_raw_start, + write_raw_end = write_raw_end, + raw_merge = raw_merge, + existing_raw_file_path = existing_raw_file_path, + stage_process_data = stage_process_data, + write_pro_start = write_pro_start, + write_pro_end = write_pro_end, + pro_merge = pro_merge, + input_file = input_file, + existing_pro_file_path = existing_pro_file_path, + raw_check = raw_check, + pro_check = pro_check + ) + ) + + + } + + + + + +##' Insert the output data returned from rp_control into BETYdb +##' +##' @name remotedata_db_insert +##' @param output output list from rp_control +##' @param remotefile_check_flag remotefile_check_flag +##' @param siteid siteid +##' @param out_get_data out_get_data +##' @param out_process_data out_process_data +##' @param write_raw_start write_raw_start, start date of the raw file +##' @param write_raw_end write_raw_end, end date of the raw file +##' @param write_pro_start write_pro_start +##' @param write_pro_end write_pro_end +##' @param raw_check id, site_id, name, start_date, end_date, of the existing raw file from inputs table and file_path from dbfiles tables +##' @param pro_check pro_check id, site_id, name, start_date, end_date, of the existing processed file from inputs table and file_path from dbfiles tables +##' @param raw_mimetype raw_mimetype +##' @param raw_formatname raw_formatname +##' @param pro_mimetype pro_mimetype +##' @param pro_formatname pro_formatname +##' @param dbcon BETYdb con +##' +##' @return list containing raw_id, raw_path, pro_id, pro_path +##' @author Ayush Prasad +##' @examples +##' \dontrun{ +##' db_out <- remotedata_db_insert( +##' output, +##' remotefile_check_flag, +##' siteid, +##' out_get_data, +##' out_process_data, +##' write_raw_start, +##' write_raw_end, +##' write_pro_start, +##' write_pro_end, +##' raw_check, +##' pro_check +##' raw_mimetype, +##' raw_formatname, +##' pro_mimetype, +##' pro_formatname, +##' dbcon) +##' } +remotedata_db_insert <- + function(output, + remotefile_check_flag, + siteid, + out_get_data, + out_process_data, + write_raw_start, + write_raw_end, + write_pro_start, + write_pro_end, + raw_check, + pro_check, + raw_mimetype, + raw_formatname, + pro_mimetype, + pro_formatname, + dbcon) { + + # The value of remotefile_check_flag denotes the following cases: + + # When processed file is requested, + # 1 - There are no existing raw and processed files of the requested type in the DB + # 2 - Requested processed file does not exist, the raw file used to create is it present and matches with the requested daterange + # 3 - Requested processed file does not exist, raw file used to create it is present but has to be updated to match with the requested daterange + # 4 - Both processed and raw file of the requested type exists, but they have to be updated to match with the requested daterange + # 5 - Raw file required for creating the processed file exists with the required daterange and the processed file needs to be updated. Here the new processed file will now contain data for the entire daterange of the existing raw file + # 6 - There is a existing processed file of the requested type but the raw file used to create it has been deleted. Here, the raw file will be created again and the processed file will be replaced entirely with the one created from new raw file + + # When raw file is requested, + # 1 - There is no existing raw the requested type in the DB + # 2 - existing raw file will be updated + + pro_id <- NULL + pro_path <- NULL + + if (!is.null(out_process_data)) { + # if the requested processed file already exists within the required timeline dont insert or update the DB + if (as.character(write_pro_start) == "dont write" && + as.character(write_pro_end) == "dont write") { + PEcAn.logger::logger.info("Requested processed file already exists") + pro_id <- pro_check$id + pro_path <- pro_check$file_path + raw_id <- raw_check$id + raw_path <- raw_check$file_path + } else{ + if (remotefile_check_flag == 1) { + # no processed and rawfile are present + PEcAn.logger::logger.info("Inserting raw and processed files for the first time") + # insert processed data + pro_ins <- + PEcAn.DB::dbfile.input.insert( + in.path = dirname(output$process_data_path), + in.prefix = basename(output$process_data_path), + siteid = siteid, + startdate = write_pro_start, + enddate = write_pro_end, + mimetype = pro_mimetype, + formatname = pro_formatname, + con = dbcon + ) + # insert raw file + raw_ins <- + PEcAn.DB::dbfile.input.insert( + in.path = dirname(output$raw_data_path), + in.prefix = basename(output$raw_data_path), + siteid = siteid, + startdate = write_raw_start, + enddate = write_raw_end, + mimetype = raw_mimetype, + formatname = raw_formatname, + con = dbcon + ) + pro_id <- pro_ins$input.id + raw_id <- raw_ins$input.id + pro_path <- output$process_data_path + raw_path <- output$raw_data_path + } else if (remotefile_check_flag == 2) { + # requested processed file does not exist but the raw file used to create it exists within the required timeline + PEcAn.logger::logger.info("Inserting processed file for the first time") + pro_ins <- + PEcAn.DB::dbfile.input.insert( + in.path = dirname(output$process_data_path), + in.prefix = basename(output$process_data_path), + siteid = siteid, + startdate = write_pro_start, + enddate = write_pro_end, + mimetype = pro_mimetype, + formatname = pro_formatname, + con = dbcon + ) + raw_id <- raw_check$id + raw_path <- raw_check$file_path + pro_id <- pro_ins$input.id + pro_path <- output$process_data_path + } else if (remotefile_check_flag == 3) { + # requested processed file does not exist, raw file used to create it is present but has to be updated to match with the requested dates + pro_ins <- PEcAn.DB::dbfile.input.insert( + in.path = dirname(output$process_data_path), + in.prefix = basename(output$process_data_path), + siteid = siteid, + startdate = write_pro_start, + enddate = write_pro_end, + mimetype = pro_mimetype, + formatname = pro_formatname, + con = dbcon + ) + raw_id <- raw_check$id + PEcAn.DB::db.query( + sprintf( + "UPDATE inputs SET start_date='%s', end_date='%s', name='%s' WHERE id=%f;", + write_raw_start, + write_raw_end, + basename(dirname(output$raw_data_path)), + raw_id + ), + dbcon + ) + PEcAn.DB::db.query( + sprintf( + "UPDATE dbfiles SET file_path='%s', file_name='%s' WHERE container_id=%f;", + dirname(output$raw_data_path), + basename(output$raw_data_path), + raw_id + ), + dbcon + ) + pro_id <- pro_ins$input.id + pro_path <- output$process_data_path + } else if (remotefile_check_flag == 4) { + # requested processed and raw files are present and have to be updated + pro_id <- pro_check$id + raw_id <- raw_check$id + raw_path <- output$raw_data_path + pro_path <- output$process_data_path + PEcAn.logger::logger.info("Updating processed and raw files") + PEcAn.DB::db.query( + sprintf( + "UPDATE inputs SET start_date='%s', end_date='%s', name='%s' WHERE id=%f;", + write_pro_start, + write_pro_end, + basename(dirname(output$process_data_path)), + pro_id + ), + dbcon + ) + PEcAn.DB::db.query( + sprintf( + "UPDATE dbfiles SET file_path='%s', file_name='%s' WHERE container_id=%f;", + dirname(output$process_data_path), + basename(output$process_data_path), + pro_id + ), + dbcon + ) + PEcAn.DB::db.query( + sprintf( + "UPDATE inputs SET start_date='%s', end_date='%s', name='%s' WHERE id=%f", + write_raw_start, + write_raw_end, + basename(dirname(output$raw_data_path)), + raw_id + ), + dbcon + ) + PEcAn.DB::db.query( + sprintf( + "UPDATE dbfiles SET file_path='%s', file_name='%s' WHERE container_id=%f;", + dirname(output$raw_data_path), + basename(output$raw_data_path), + raw_id + ), + dbcon + ) + } else if (remotefile_check_flag == 5) { + # raw file required for creating the processed file exists and the processed file needs to be updated + pro_id <- pro_check$id + pro_path <- output$process_data_path + raw_id <- raw_check$id + raw_path <- raw_check$file_path + PEcAn.logger::logger.info("Updating the existing processed file") + PEcAn.DB::db.query( + sprintf( + "UPDATE inputs SET start_date='%s', end_date='%s', name='%s' WHERE id=%f;", + write_pro_start, + write_pro_end, + basename(dirname(output$process_data_path)), + pro_id + ), + dbcon + ) + PEcAn.DB::db.query( + sprintf( + "UPDATE dbfiles SET file_path='%s', file_name='%s' WHERE container_id=%f;", + dirname(output$process_data_path), + basename(output$process_data_path), + pro_id + ), + dbcon + ) + } else if (remotefile_check_flag == 6) { + # there is some existing processed file but the raw file used to create it is now deleted, replace the processed file entirely with the one created from new raw file + pro_id <- pro_check$id + pro_path <- output$process_data_path + raw_path <- output$raw_data_path + PEcAn.logger::logger.info("Replacing the existing processed file and creating a new raw file") + PEcAn.DB::db.query( + sprintf( + "UPDATE inputs SET start_date='%s', end_date='%s', name='%s' WHERE id=%f;", + write_pro_start, + write_pro_end, + basename(dirname(output$process_data_path)), + pro_id + ), + dbcon + ) + PEcAn.DB::db.query( + sprintf( + "UPDATE dbfiles SET file_path='%s', file_name='%s' WHERE container_id=%f;", + dirname(output$process_data_path), + basename(output$process_data_path), + pro_id + ), + dbcon + ) + raw_ins <- + PEcAn.DB::dbfile.input.insert( + in.path = dirname(output$raw_data_path), + in.prefix = basename(output$raw_data_path), + siteid = siteid, + startdate = write_raw_start, + enddate = write_raw_end, + mimetype = raw_mimetype, + formatname = raw_formatname, + con = dbcon + ) + raw_id <- raw_ins$input.id + } + } + } + else{ + # if the requested raw file already exists within the required timeline dont insert or update the DB + if (as.character(write_raw_start) == "dont write" && + as.character(write_raw_end) == "dont write") { + PEcAn.logger::logger.info("Requested raw file already exists") + raw_id <- raw_check$id + raw_path <- raw_check$file_path + } else{ + if (remotefile_check_flag == 1) { + PEcAn.logger::logger.info(("Inserting raw file for the first time")) + raw_ins <- + PEcAn.DB::dbfile.input.insert( + in.path = dirname(output$raw_data_path), + in.prefix = basename(output$raw_data_path), + siteid = siteid, + startdate = write_raw_start, + enddate = write_raw_end, + mimetype = raw_mimetype, + formatname = raw_formatname, + con = dbcon + ) + raw_id <- raw_ins$input.id + raw_path <- output$raw_data_path + } else if (remotefile_check_flag == 2) { + PEcAn.logger::logger.info("Updating raw file") + raw_id <- raw_check$id + raw_path <- output$raw_data_path + PEcAn.DB::db.query( + sprintf( + "UPDATE inputs SET start_date='%s', end_date='%s', name='%s' WHERE id=%f;", + write_raw_start, + write_raw_end, + basename(dirname(output$raw_data_path)), + raw_id + ), + dbcon + ) + PEcAn.DB::db.query( + sprintf( + "UPDATE dbfiles SET file_path='%s', file_name='%s' WHERE container_id=%f;", + dirname(output$raw_data_path), + basename(dirname(output$raw_data_path)), + raw_id + ), + dbcon + ) + } + } + } + + return(list(raw_id = raw_id, raw_path = raw_path, pro_id = pro_id, pro_path = pro_path)) + } \ No newline at end of file diff --git a/modules/data.remote/inst/FieldvsSMAP_compare.R b/modules/data.remote/inst/FieldvsSMAP_compare.R new file mode 100644 index 00000000000..c4314260ad9 --- /dev/null +++ b/modules/data.remote/inst/FieldvsSMAP_compare.R @@ -0,0 +1,622 @@ +#load necessities +library(tidyverse) +library(hrbrthemes) +library(plotly) +library(patchwork) +library(babynames) +library(viridis) +library(purrr) +library(lubridate) +library(tidyr) +library(dplyr) +library(ncdf4) + +par(mfrow = c(1,2)) + +#set start and end dates +start = "2019-04-01" +end = as.character(Sys.Date()) + + + + ############################## + ######## WILLOW CREEK ######## + ############################## + + ######## Download Ameriflux field data######## + +#download and get daily average +source("/fs/data3/jbateman/pecan/modules/assim.sequential/inst/NEFI/US_WCr/download_soilmoist_WCr.R") +sm_wcr = download_soilmoist_WCr(start, end) %>% + dplyr::mutate(Day = lubridate::day(Time), Month = lubridate::month(Time), Year = lubridate::year(Time)) %>% + group_by(Year, Month, Day) +sm_wcr$Date = as.Date(with(sm_wcr, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") + +sm_wcr.Dayavg = sm_wcr %>% + summarise(DayAvgsm1 = mean(avgsoil1)) %>% + ungroup() +sm_wcr.Dayavg2= sm_wcr %>% + summarise(DayAvgsm2 = mean(avgsoil2)) %>% + ungroup() +sm_wcr.Dayavg$DayAvgsm2 =sm_wcr.Dayavg2$DayAvgsm2 +sm_wcr.Dayavg$Date = as.Date(with(sm_wcr.Dayavg, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_wcr.Dayavg = sm_wcr.Dayavg %>% dplyr::select(Date, DayAvgsm1, DayAvgsm2) + + + + ######## Download SMAP data ######## +geoJSON_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst/" +smap_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" +site_info <- list( + site_id = 676, + site_name = "Willow Creek", + lat = 45.805925, + lon = -90.07961, + time_zone = "UTC") + +wcr.smap_sm = download_SMAP_gee2pecan(start, end, site_info, geoJSON_outdir, smap_outdir) + +##### plot time series + +# Daily sm average +wcr.d = ggplot() + + geom_line(data = na.omit(wcr.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(wcr.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + geom_line(data = sm_wcr.Dayavg, aes(x=Date, y=DayAvgsm1, color = "red"), linetype = "dashed") + + geom_line(data = sm_wcr.Dayavg, aes(x=Date, y=DayAvgsm2, color = "purple"), linetype = "dashed") + + ylim(0,60) + + ggtitle("SMAP vs Daily Field Data: Willow Creek") + + labs(x = "Date", + y = "Soil Moisture (%)" , + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red", "purple"), + labels = c("SMAP", "Old Field", "New Field"), + guide = "legend") + + theme( + legend.position = "none", + legend.title = element_blank()) + +# 1/2 hr field data vs daily smap (6am) +wcr.half = ggplot() + + geom_line(data = sm_wcr, aes(x=Date, y=avgsoil1, color="red"), linetype ="solid") + + geom_line(data = sm_wcr, aes(x=Date, y=avgsoil2, color="purple"), linetype ="solid") + + geom_line(data = na.omit(wcr.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(wcr.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + ggtitle("SMAP vs 1/2 hr Field Data: Willow Creek") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red", "purple"), + labels = c("SMAP", "Old Field", "New Field"), + guide = "legend") + + theme( + legend.position = "bottom", + legend.title = element_blank()) + +require(gridExtra) +grid.arrange(wcr.d, wcr.half) + + + ############################## + ######## SYLVANIA ######## + ############################## + +######## Download Ameriflux field data######## + +#download and get daily average +source("/fs/data3/jbateman/pecan/modules/assim.sequential/inst/NEFI/US_Syv/download_soilmoist_Syv.R") +sm_syv = download_soilmoist_Syv(start, end) %>% + mutate(Day = day(Time), Month = month(Time), Year = year(Time)) %>% + group_by(Year, Month, Day) +sm_syv$Date = as.Date(with(sm_syv, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") + +sm_syv.Dayavg = sm_syv %>% + summarise(DayAvgsm = mean(avgsoil)) %>% + ungroup() +sm_syv.Dayavg$Date = as.Date(with(sm_syv.Dayavg, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_syv.Dayavg = sm_syv.Dayavg %>% dplyr::select(Date, DayAvgsm) + + + +######## Download SMAP ssm data ######## +geoJSON_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" +smap_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" + +site_info <- list( + site_id = 622, + site_name = "Sylvania", + lat = 46.242017, + lon = -89.347567, + time_zone = "UTC") +syv.smap_sm = download_SMAP_gee2pecan(start, end, site_info, geoJSON_outdir, smap_outdir) + +##### plot time series + +# Daily sm average +syv.d = ggplot() + + geom_line(data = na.omit(syv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(syv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + geom_line(data = sm_syv.Dayavg, aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dashed") + + ylim(0,60) + + ggtitle("SMAP vs Daily Field Data: SYLVANIA") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red"), + labels = c("SMAP", "Field"), + guide = "legend") + + theme( + legend.position = "none", + legend.title = element_blank()) + +# 1/2 hr field data vs daily smap (6am) +syv.half = ggplot() + + geom_line(data = sm_syv, aes(x=Date, y=avgsoil, color="red"), linetype ="solid") + + geom_line(data = na.omit(syv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(syv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + ggtitle("SMAP vs 1/2 hr Field Data: SYLVANIA") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red"), + labels = c("SMAP", "Field"), + guide = "legend") + + theme( + legend.position = "bottom", + legend.title = element_blank()) + +grid.arrange(syv.d, syv.half) + + + + + ############################## + ######## WLEF ######## + ############################## + +######## Download Ameriflux field data######## + +#download and get daily average +source("/fs/data3/jbateman/pecan/modules/assim.sequential/inst/NEFI/US_WLEF/download_soilmoist_WLEF.R") +sm_wlef = download_soilmoist_WLEF(start, end) %>% + mutate(Day = day(Time), Month = month(Time), Year = year(Time)) %>% + group_by(Year, Month, Day) +sm_wlef$Date = as.Date(with(sm_wlef, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") + +sm_wlef.Dayavg = sm_wlef %>% + summarise(DayAvgsm = mean(avgsoil)) %>% + ungroup() +sm_wlef.Dayavg$Date = as.Date(with(sm_wlef.Dayavg, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_wlef.Dayavg = sm_wlef.Dayavg %>% dplyr::select(Date, DayAvgsm) + + + +######## Download SMAP data ######## +geoJSON_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" +smap_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" + +site_info <- list( + site_id = 678, + site_name = "WLEF", + lat = 45.9408, + lon = -90.27, + time_zone = "UTC") +wlef.smap_sm = download_SMAP_gee2pecan(start, end, site_info, geoJSON_outdir, smap_outdir) + +##### plot time series + +# Daily sm average +wlef.d = ggplot() + + geom_line(data = na.omit(wlef.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(wlef.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + geom_line(data = sm_wlef.Dayavg, aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dashed") + + ylim(0,60) + + ggtitle("SMAP vs Daily Field Data: WLEF") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red"), + labels = c("SMAP", "Field"), + guide = "legend") + + theme( + legend.position = "none", + legend.title = element_blank()) + +# 1/2 hr field data vs daily smap (6am) +wlef.half = ggplot() + + geom_line(data = sm_wlef, aes(x=Date, y=avgsoil, color="red"), linetype ="solid") + + geom_line(data = na.omit(wlef.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(wlef.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + ggtitle("SMAP vs 1/2 hr Field Data: WLEF") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red"), + labels = c("SMAP", "Field"), + guide = "legend") + + theme( + legend.position = "bottom", + legend.title = element_blank()) + +grid.arrange(wlef.d, wlef.half) + + + ############################## + ######## HARVARD ######## + ############################## + +######## Download Ameriflux field data######## + +#download and get daily average +source("/fs/data3/jbateman/pecan/modules/assim.sequential/inst/NEFI/US_Harvard/download_soilmoist_harvard.R") +sm_harv = download_soilmoist_Harvard(start, end) %>% + mutate(Day = day(Time), Month = month(Time), Year = year(Time)) %>% + group_by(Year, Month, Day) +sm_harv$Date = as.Date(with(sm_harv, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_harv$SWC15 = replace(sm_harv$SWC15, sm_harv$SWC15 == -9999, NA) + +sm_harv.Dayavg = sm_harv %>% + summarise(DayAvgsm = mean(SWC15)) %>% + ungroup() +sm_harv.Dayavg$Date = as.Date(with(sm_harv.Dayavg, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_harv.Dayavg = sm_harv.Dayavg %>% dplyr::select(Date, DayAvgsm) + + + +######## Download SMAP data ######## +geoJSON_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" +smap_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" + +site_info <- list( + site_id = 1126, + site_name = "Harvard Forest", + lat = 42.531453, + lon = -72.188896, + time_zone = "UTC") +harv.smap_sm = download_SMAP_gee2pecan("2019-11-06", end, site_info, geoJSON_outdir, smap_outdir) + +##### plot time series + +# Daily sm average +harv.d = ggplot() + + geom_line(data = na.omit(harv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(harv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + geom_line(data = sm_harv.Dayavg, aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dashed") + + ylim(0,60) + + ggtitle("SMAP vs Daily Field Data: Harvard") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red"), + labels = c("SMAP", "Field"), + guide = "legend") + + theme( + legend.position = "none", + legend.title = element_blank()) + +# 1/2 hr field data vs daily smap (6am) +harv.half = ggplot() + + geom_line(data = na.omit(sm_harv), aes(x=Date, y=SWC15, color="red"), linetype ="solid") + + geom_line(data = na.omit(harv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(harv.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + ggtitle("SMAP vs 1/2 hr Field Data: Harvard") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red"), + labels = c("SMAP", "Field"), + guide = "legend") + + theme( + legend.position = "bottom", + legend.title = element_blank()) + + +grid.arrange(harv.d, harv.half) + + ############################## + ######## BART ######## + ############################## + +######## NEON data ######## + +#download and get daily average +BART_ssm = split(BART, list(BART$verticalPosition, BART$horizontalPosition, BART$VSWCFinalQF)) +BART_ssm = split(BART, BART$VSWCFinalQF) +sm_bart = BART_ssm$'0' %>% + na.omit() %>% + dplyr::select(startDateTime, VSWCMean, horizontalPosition, verticalPosition) %>% + mutate(Day = day(startDateTime), Month = month(startDateTime), Year = year(startDateTime)) %>% + group_by(Year, Month, Day) +sm_bart$Date = as.Date(with(sm_bart, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_bart$VSWCMean = sm_bart$VSWCMean * 100 +sm_bart = split(sm_bart, list(sm_bart$verticalPosition, sm_bart$horizontalPosition)) + +sm_bart.Dayavg = vector(mode = "list", length = 40) +names(sm_bart.Dayavg) = names(sm_bart) +for (i in 1:length(sm_bart)){ + sm_bart.Dayavg[[i]] = dplyr::select(sm_bart[[i]], Date, VSWCMean) %>% + summarise(DayAvgsm = mean(VSWCMean)) %>% + ungroup() + sm_bart.Dayavg[[i]]$Date = as.Date(with(sm_bart.Dayavg[[i]], paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +} + + +######## Download SMAP data ######## +geoJSON_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" +smap_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" + +site_info <- list( + site_id = 796, + site_name = "Bartlett", + lat = 44.06464, + lon = -71.288077, + time_zone = "UTC") +bart.smap_sm = download_SMAP_gee2pecan(start, end, site_info, geoJSON_outdir, smap_outdir) + +##### plot time series + +# Daily sm average +bart.d = ggplot() + + geom_line(data = na.omit(bart.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(bart.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + geom_line(data = sm_bart.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), size=1) + + geom_line(data = sm_bart.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"),linetype = "dotted", size=.5) + + geom_point(data = sm_bart.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), size=1) + + geom_line(data = sm_bart.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), size=1) + + geom_line(data = sm_bart.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), size=1) + + geom_line(data = sm_bart.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), size=1) + + geom_line(data = sm_bart.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), linetype = "dotted", size=.5) + + ylim(0,60) + + ggtitle("SMAP vs Daily Field Data: Bartlett") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red", "green", "purple", "orange", "yellow"), + labels = c("SMAP", "Field 1 (-6cm)", "Field 2 (-6cm)", "Field 3 (-6cm)", "Field 4 (-6cm)", "Field 5 (-6cm)"), + guide = "legend") + + theme( + legend.position = "none", + legend.title = element_blank()) + +# 1/2 hr field data vs daily smap (6am) +bart.half = ggplot() + + geom_line(data = sm_bart$'502.1', aes(x=Date, y=VSWCMean, color = "red"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart$'502.1', aes(x=Date, y=VSWCMean, color = "red"), size=1) + + geom_line(data = sm_bart$'502.1', aes(x=Date, y=VSWCMean, color = "red"),linetype = "dotted", size=.5) + + geom_point(data = sm_bart$'502.2', aes(x=Date, y=VSWCMean, color = "green"), size=1) + + geom_line(data = sm_bart$'502.2', aes(x=Date, y=VSWCMean, color = "green"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart$'502.3', aes(x=Date, y=VSWCMean, color = "purple"), size=1) + + geom_line(data = sm_bart$'502.3', aes(x=Date, y=VSWCMean, color = "purple"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart$'502.4', aes(x=Date, y=VSWCMean, color = "orange"), size=1) + + geom_line(data = sm_bart$'502.4', aes(x=Date, y=VSWCMean, color = "orange"), linetype = "dotted", size=.5) + + geom_point(data = sm_bart$'502.5', aes(x=Date, y=VSWCMean, color = "yellow"), size=1) + + geom_line(data = sm_bart$'502.5', aes(x=Date, y=VSWCMean, color = "yellow"), linetype = "dotted", size=.5) + + ylim(0,60) + + geom_line(data = na.omit(bart.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(bart.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + ggtitle("SMAP vs 1/2 hr Field Data: Bartlett") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red", "green", "purple", "orange", "yellow"), + labels = c("SMAP", "Field 1 (-6cm)", "Field 2 (-6cm)", "Field 3 (-6cm)", "Field 4 (-6cm)", "Field 5 (-6cm)"), + guide = "legend") + + theme( + legend.position = "bottom", + legend.title = element_blank()) + +#require(gridExtra) +#grid.arrange(bart.d, bart.half) +plot(bart.half) + + + +############################## +######## SRER ######## +############################## + +######## NEON data ######## + +#download and get daily average +SRER_ssm = split(SRER, list(SRER$verticalPosition, SRER$horizontalPosition, SRER$VSWCFinalQF)) +SRER_ssm = split(SRER, SRER$VSWCFinalQF) +sm_srer = SRER_ssm$'0' %>% + na.omit() %>% + dplyr::select(startDateTime, VSWCMean, horizontalPosition, verticalPosition) %>% + mutate(Day = day(startDateTime), Month = month(startDateTime), Year = year(startDateTime)) %>% + group_by(Year, Month, Day) +sm_srer$Date = as.Date(with(sm_srer, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_srer$VSWCMean = sm_srer$VSWCMean * 100 +sm_srer = split(sm_srer, list(sm_srer$verticalPosition, sm_srer$horizontalPosition)) + +sm_srer.Dayavg = vector(mode = "list", length = 40) +names(sm_srer.Dayavg) = names(sm_srer) +for (i in 1:length(sm_srer)){ + sm_srer.Dayavg[[i]] = dplyr::select(sm_srer[[i]], Date, VSWCMean) %>% + summarise(DayAvgsm = mean(VSWCMean)) %>% + ungroup() + sm_srer.Dayavg[[i]]$Date = as.Date(with(sm_srer.Dayavg[[i]], paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +} + + +######## Download SMAP data ######## +geoJSON_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" +smap_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" + +site_info <- list( + site_id = 1000004876, + site_name = "Santa Rita", + lat = 31.91068, + lon = -110.83549, + time_zone = "UTC") +srer.smap_sm = download_SMAP_gee2pecan(start, end, site_info, geoJSON_outdir, smap_outdir) + +##### plot time series + +# Daily sm average +srer.d = ggplot() + + geom_line(data = na.omit(srer.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(srer.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"),linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), linetype = "dotted", size=.5) + + ylim(0,60) + + ggtitle("SMAP vs Daily Field Data: Santa Rita") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red", "green", "purple", "orange", "yellow"), + labels = c("SMAP", "Field 1 (-6cm)", "Field 2 (-6cm)", "Field 3 (-6cm)", "Field 4 (-6cm)", "Field 5 (-6cm)"), + guide = "legend") + + theme( + legend.position = "none", + legend.title = element_blank()) + +# 1/2 hr field data vs daily smap (6am) +srer.half = ggplot() + + geom_line(data = sm_srer.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"),linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), linetype = "dotted", size=.5) + + geom_point(data = sm_srer.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), size=1) + + geom_line(data = sm_srer.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), linetype = "dotted", size=.5) + + geom_line(data = na.omit(srer.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(srer.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + ylim(0,60) + + ggtitle("SMAP vs 1/2 hr Field Data: Santa Rita") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red", "green", "purple", "orange", "yellow"), + labels = c("SMAP", "Field 1 (-6cm)", "Field 2 (-6cm)", "Field 3 (-6cm)", "Field 4 (-6cm)", "Field 5 (-6cm)"), + guide = "legend") + + theme( + legend.position = "bottom", + legend.title = element_blank()) + + +grid.arrange(srer.d, srer.half) +plot(srer.half) + + +############################## +######## KONA ######## +############################## + +######## NEON data ######## + +#download and get daily average +KONA_ssm = split(KONA, list(KONA$verticalPosition, KONA$horizontalPosition, KONA$VSWCFinalQF)) +KONA_ssm = split(KONA, KONA$VSWCFinalQF) +sm_kona = KONA_ssm$'0' %>% + na.omit() %>% + dplyr::select(startDateTime, VSWCMean, horizontalPosition, verticalPosition) %>% + mutate(Day = day(startDateTime), Month = month(startDateTime), Year = year(startDateTime)) %>% + group_by(Year, Month, Day) +sm_kona$Date = as.Date(with(sm_kona, paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +sm_kona$VSWCMean = sm_kona$VSWCMean * 100 +sm_kona = split(sm_kona, list(sm_kona$verticalPosition, sm_kona$horizontalPosition)) + +sm_kona.Dayavg = vector(mode = "list", length = 40) +names(sm_kona.Dayavg) = names(sm_kona) +for (i in 1:length(sm_kona)){ + sm_kona.Dayavg[[i]] = dplyr::select(sm_kona[[i]], Date, VSWCMean) %>% + summarise(DayAvgsm = mean(VSWCMean)) %>% + ungroup() + sm_kona.Dayavg[[i]]$Date = as.Date(with(sm_kona.Dayavg[[i]], paste(Year, Month, Day, sep="-")), "%Y-%m-%d") +} + + + +######## Download SMAP data ######## +geoJSON_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" +smap_outdir = "/projectnb/dietzelab/jbateman/pecan/modules/data.remote/inst" + +site_info <- list( + site_id = 1000004925, + site_name = "KONA", + lat = 39.11044, + lon = -96.61295, + time_zone = "UTC") +kona.smap_sm = download_SMAP_gee2pecan(start, end, site_info, geoJSON_outdir, smap_outdir) + +##### plot time series + +# Daily sm average +kona.d = ggplot() + + geom_line(data = na.omit(kona.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(kona.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + geom_line(data = sm_kona.Dayavg, aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dashed") + + ylim(0,60) + + ggtitle("SMAP vs Daily Field Data: Konza Prairie") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red"), + labels = c("SMAP", "Field"), + guide = "legend") + + theme( + legend.position = "none", + legend.title = element_blank()) + +# 1/2 hr field data vs daily smap (6am) +kona.half = ggplot() + + geom_line(data = sm_kona.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), linetype = "dotted", size=.5) + + geom_point(data = sm_kona.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"), size=1) + + geom_line(data = sm_kona.Dayavg$'502.1', aes(x=Date, y=DayAvgsm, color = "red"),linetype = "dotted", size=.5) + + geom_point(data = sm_kona.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), size=1) + + geom_line(data = sm_kona.Dayavg$'502.2', aes(x=Date, y=DayAvgsm, color = "green"), linetype = "dotted", size=.5) + + geom_point(data = sm_kona.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), size=1) + + geom_line(data = sm_kona.Dayavg$'502.3', aes(x=Date, y=DayAvgsm, color = "purple"), linetype = "dotted", size=.5) + + geom_point(data = sm_kona.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), size=1) + + geom_line(data = sm_kona.Dayavg$'502.4', aes(x=Date, y=DayAvgsm, color = "orange"), linetype = "dotted", size=.5) + + geom_point(data = sm_kona.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), size=1) + + geom_line(data = sm_kona.Dayavg$'502.5', aes(x=Date, y=DayAvgsm, color = "yellow"), linetype = "dotted", size=.5) + + geom_line(data = na.omit(kona.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue")) + + geom_point(data = na.omit(kona.smap_sm), aes(x=Date, y=ssm.vol, color="steel blue"), size=1) + + ggtitle("SMAP vs 1/2 hr Field Data: Konza Prairie") + + labs(x = "Date", + y = "Soil Moisture (%)", + color = "Legend\n") + + scale_color_identity( + breaks = c("steel blue","red", "green", "purple", "orange", "yellow"), + labels = c("SMAP", "Field 1 (-6cm)", "Field 2 (-6cm)", "Field 3 (-6cm)", "Field 4 (-6cm)", "Field 5 (-6cm)"), + guide = "legend") + + theme( + legend.position = "bottom", + legend.title = element_blank()) + + +grid.arrange(kona.d, kona.half) +plot(kona.half) + diff --git a/modules/data.remote/inst/RpTools/RpTools/__init__.py b/modules/data.remote/inst/RpTools/RpTools/__init__.py new file mode 100644 index 00000000000..bee700c9a57 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/__init__.py @@ -0,0 +1,3 @@ +from RpTools.rp_control import rp_control +from RpTools.get_remote_data import get_remote_data +from RpTools.process_remote_data import process_remote_data diff --git a/modules/data.remote/inst/RpTools/RpTools/appeears2pecan.py b/modules/data.remote/inst/RpTools/RpTools/appeears2pecan.py new file mode 100644 index 00000000000..4b7a9b4f9c9 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/appeears2pecan.py @@ -0,0 +1,263 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +appears2pecan downloads remote sensing data using the AppEEARS API + +AppEEARS API documentation: https://lpdaacsvc.cr.usgs.gov/appeears/api/?language=Python%203#introduction + +Requires Python3 + +Author(s): Ayush Prasad +""" +import xarray as xr +import pandas as pd +import requests as r +import geopandas as gpd +import getpass +import time +import os +import cgi +import json +from .gee_utils import get_sitename +from datetime import datetime +from warnings import warn +import os.path +import time + + +def appeears2pecan( + geofile, outdir, out_filename, start, end, product, projection=None, credfile=None +): + """ + Downloads remote sensing data from AppEEARS + + Parameters + ---------- + geofile (str) -- path to the GeoJSON file containing the name and coordinates of AOI + + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + + out_filename (str) -- filename of the output file + + start (str) -- starting date of the data request in the form YYYY-MM-DD + + end (str) -- ending date area of the data request in the form YYYY-MM-DD + + product (str) -- product name followed by " . " and the product version, e.g. "SPL3SMP_E.003", as listed on AppEEARS website. + + projection (str) -- type of projection, only required for polygon AOI type. None by default + + credfile (str) -- path to JSON file containing Earthdata username and password. None by default + + siteid (str) -- shortform of siteid, None by default + + Returns + ------- + Absolute path to the output file. + output netCDF is saved in the specified directory. + """ + + # API url + api = "https://lpdaacsvc.cr.usgs.gov/appeears/api/" + + def authenticate(): + """ + uses the user provided NASA Earthdata credentials to request a token. + + Returns + ------- + head (dict) : header contatining the authentication token + """ + if credfile: + try: + # if the user does not want to enter their credentials everytime they use this function, they need to store their username and password in a JSON file, preferabbly not in a git initialized directory + with open(credfile, "r") as f: + cred = json.load(f) + user = cred["username"] + password = cred["password"] + except IOError: + print( + "specified file does not exist, please make sure that you have specified the path correctly" + ) + else: + # if user does not want to store the credentials + user = getpass.getpass(prompt="Enter NASA Earthdata Login Username: ") + password = getpass.getpass(prompt="Enter NASA Earthdata Login Password: ") + # use the credentials to call log in service. Use request's HTTP Basic Auth to do the authentication + response = r.post("{}login".format(api), auth=(user, password)) + # delete the user and password variables as they are no longer needed + del user, password + # raise an exception if the POST request returned an unsuccessful status code + response.raise_for_status() + token_response = response.json() + # extract the token + token = token_response["token"] + head = {"Authorization": "Bearer {}".format(token)} + return head + + head = authenticate() + + # query the available layers for the product and store it in a layer + product tuple + lst_response = r.get("{}product/{}".format(api, product)).json() + l = list(lst_response.keys()) + layers = [(product, each_l) for each_l in l] + prodLayer = [({"layer": l[1], "product": l[0]}) for l in layers] + + # special case to handle SMAP products + # SMAP products individually have more than 40 layers all of which are not allowed by the API to be downloaded in a single request + # if the requested product is one of the SMAP products then select the first 25 layers + if product in [ + "SPL3FTP.002", + "SPL3SMP.006", + "SPL3SMP_E.003", + "SPL4CMDL.004", + "SPL4SMGP.004", + ]: + warn( + "Since you have requested a SMAP product, all layers cannot be downloaded, selecting first 25 layers.." + ) + # change this part to select your own SMAP layers + prodLayer = prodLayer[0:25] + + site_name = get_sitename(geofile) + + task_name = site_name + product + + # convert start date to MM-DD-YY format as needed by the API + start = datetime.strptime(start, "%Y-%m-%d") + start = datetime.strftime(start, "%m-%d-%Y") + # convert end date to MM-DD-YY format + end = datetime.strptime(end, "%Y-%m-%d") + end = datetime.strftime(end, "%m-%d-%Y") + + # read in the GeoJSON file containing name and coordinates of the AOI + df = gpd.read_file(geofile) + + if (df.geometry.type == "Point").bool(): + # extract coordinates + lon = float(df.geometry.x) + lat = float(df.geometry.y) + coordinates = [{"longitude": lon, "latitude": lat,}] + # compile the JSON task request + task = { + "task_type": "point", + "task_name": task_name, + "params": { + "dates": [{"startDate": start, "endDate": end}], + "layers": prodLayer, + "coordinates": coordinates, + }, + } + outformat = "csv" + + elif (df.geometry.type == "Polygon").bool(): + # query the projections + projections = r.get("{}spatial/proj".format(api)).json() + projs = {} + for p in projections: + projs[p["Name"]] = p + # select the projection which user requested + proj = projs[projection]["Name"] + # extract the coordinates from the dataframe and convert it to JSON + geo = df[df["name"] == site_name].to_json() + geo = json.loads(geo) + # compile the JSON task request + task = { + "task_type": "area", + "task_name": task_name, + "params": { + "dates": [{"startDate": start, "endDate": end}], + "layers": prodLayer, + "output": {"format": {"type": "netcdf4"}, "projection": proj}, + "geo": geo, + }, + } + outformat = "nc" + + else: + # if the input geometry is not of Polygon or Point Type + raise ValueError("geometry type not supported") + + # submit the task request + task_response = r.post("{}task".format(api), json=task, headers=head).json() + + # limit response to 2 + params = { + "limit": 2, + "pretty": True, + } + + # retrieve task response and extract task id + tasks_response = r.get("{}task".format(api), params=params, headers=head).json() + task_id = task_response["task_id"] + + # wait_time (float) : time (sceconds) after which task status is checked + wait_time = 60.0 + + # check the task status as per the wait_time specified + starttime = time.time() + while ( + r.get("{}task/{}".format(api, task_id), headers=head).json()["status"] != "done" + ): + print(r.get("{}task/{}".format(api, task_id), headers=head).json()["status"]) + time.sleep(wait_time - ((time.time() - starttime) % wait_time)) + print(r.get("{}task/{}".format(api, task_id), headers=head).json()["status"]) + + # if specified output directory does not exist create it + if not os.path.exists(outdir): + os.makedirs(outdir, exist_ok=True) + + # query the created files using the bundle + bundle = r.get("{}bundle/{}".format(api, task_id)).json() + + # use the contents of the bundle to store file name and id in a dictionary + files = {} + for f in bundle["files"]: + files[f["file_id"]] = f["file_name"] + # download and save the file + for f in files: + dl = r.get("{}bundle/{}/{}".format(api, task_id, f), stream=True) + filename = os.path.basename( + cgi.parse_header(dl.headers["Content-Disposition"])[1]["filename"] + ) + filepath = os.path.join(outdir, filename) + with open(filepath, "wb") as f: + for data in dl.iter_content(chunk_size=8192): + f.write(data) + if os.path.splitext(filename)[1][1:] == outformat: + break + + + timestamp = time.strftime("%y%m%d%H%M%S") + save_path = os.path.join( + outdir, + filename + + "_" + + timestamp + + "." + + outformat + ) + os.rename(filepath, save_path) + + if outformat == "csv": + df = pd.read_csv(save_path) + coords = { + "time": df["Date"].values, + } + + tosave = xr.Dataset( + df, + coords=coords, + ) + + save_path = os.path.join( + outdir, + out_filename + + "_" + + timestamp + + ".nc" + ) + tosave.to_netcdf(os.path.join(save_path)) + + return os.path.abspath(save_path) diff --git a/modules/data.remote/inst/RpTools/RpTools/bands2lai_snap.py b/modules/data.remote/inst/RpTools/RpTools/bands2lai_snap.py new file mode 100644 index 00000000000..b936c4188fe --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/bands2lai_snap.py @@ -0,0 +1,89 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +Calculates LAI using SNAP. + +Author: Ayush Prasad +""" + +import RpTools.gee2pecan_s2 as gee +from RpTools.gee2pecan_s2 import xr_dataset_to_timeseries +import RpTools.biophys_xarray as bio +from collections import OrderedDict +import geopandas as gpd +import xarray as xr +import numpy as np +import os +import time + + +def bands2lai_snap(inputfile, outdir, lat, lon, filename): + """ + Calculates LAI for the input netCDF file and saves it in a new netCDF file. + + Parameters + ---------- + input (str) -- path to the input netCDF file containing bands. + + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + + lat (float) -- latitude of the site + + lon (float) -- longitude of the site + + filename (str) -- filename of the output file + + Returns + ------- + Absolute path to the output file + output netCDF is saved in the specified directory. + + """ + # load the input file + ds_disk = xr.open_dataset(inputfile) + # select the required bands + ds_disk = ds_disk.sel(band=["B3", "B4", "B5", "B6", "B7", "B8A", "B11", "B12"]) + # calculate LAI using SNAP + area = bio.run_snap_biophys(ds_disk, "LAI") + area = area[["lai"]] + + timeseries = {} + timeseries_variable = ["lai"] + + # if specified output directory does not exist, create it. + if not os.path.exists(outdir): + os.makedirs(outdir, exist_ok=True) + + timestamp = time.strftime("%y%m%d%H%M%S") + + # creating a timerseries + timeseries[area.name] = xr_dataset_to_timeseries(area, timeseries_variable) + + area = area.rename_vars({"lai": "LAI_UNCOLLAPSED"}) + + lat = np.array([lat]) + lon = np.array([lon]) + + od = OrderedDict() + od["x"] = "x" + od["y"] = "y" + + latlon = OrderedDict() + latlon["lat"] = lat + latlon["lon"] = lon + + # aggregate the values + LAI = area.LAI_UNCOLLAPSED.mean(dim=od) + LAI = LAI.expand_dims(dim=latlon) + LAI.attrs = {"units": "m2 m-2"} + + LAI_STD = area.LAI_UNCOLLAPSED.std(dim=od) + LAI_STD = LAI_STD.expand_dims(dim=latlon) + + area = area.assign({"LAI": LAI, "LAI_STD": LAI_STD}) + + save_path = os.path.join(outdir, filename + "_" + timestamp + ".nc") + area.to_netcdf(save_path) + + return os.path.abspath(save_path) diff --git a/modules/data.remote/inst/RpTools/RpTools/biophys_xarray.py b/modules/data.remote/inst/RpTools/RpTools/biophys_xarray.py new file mode 100644 index 00000000000..ca63c18a062 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/biophys_xarray.py @@ -0,0 +1,235 @@ +# -*- coding: utf-8 -*- +""" +Created on Mon May 11 14:34:08 2020 + +@author: Olli Nevalainen (olli.nevalainen@fmi.fi), + Finnish Meteorological Institute) + +Olli's python implementation of ESA SNAP s2toolbox biophysical processor and +computation of vegetation indices. +See ATBD at https://step.esa.int/docs/extra/ATBD_S2ToolBox_L2B_V1.1.pdf +And java source code at +https://github.com/senbox-org/s2tbx/tree/master/s2tbx-biophysical/src/main/java/org/esa/s2tbx/biophysical + +Caveats +Currently changes out of bounds inputs and outputs to nan (or min or max value +if output wihtin tolerance). Maybe output flagging information as well ( i.e. +diffferent flags input and output out of bounds). + +Convex hull input checking currently disabled. It's computationally slow and + not sure of its benefits. Better to filter out bad data based on L2A quality + info/classification\ + and hope averaging removes some bad pixels. +""" + +import requests +import io +import numpy as np +import xarray as xr + +# url to Sentinel 2 Toolbox's auxdata +# This base_url points towards the original toolbox(not the one created by Olli) +base_url = "https://raw.githubusercontent.com/senbox-org/s2tbx/master/s2tbx-biophysical/src/main/resources/auxdata/2_1/{}/{}" + + +def get_fromurl(var, pattern): + """ + Fetches the contents of a text file from the base url and stores it in a ndarray. + + Author: Ayush Prasad + + Parameters + ---------- + var (str) -- type of the product, one of FAPAR, FCOVER, LAI, LAI_Cab and LAI_Cw. + pattern (str) -- name of the file excluding the initial variable part. + + Returns + ------- + ndarray -- loaded with the contents of the text file. + """ + # attach variable and file name to the base url + res_url = base_url.format(var, str(var) + "%s" % str(pattern)) + # make a GET request to the url to fetch the data. + res_url = requests.get(res_url) + # check the HTTP status code to see if any error has occured. + res_url.raise_for_status() + # store the contents of the url in an in-memory buffer and use it to load the ndarray. + return np.loadtxt(io.BytesIO(res_url.content), delimiter=",") + + +# Read SNAP Biophysical processor neural network parameters +nn_params = {} +for var in ["FAPAR", "FCOVER", "LAI", "LAI_Cab", "LAI_Cw"]: + norm_minmax = get_fromurl(var, "_Normalisation") + denorm_minmax = get_fromurl(var, "_Denormalisation") + layer1_weights = get_fromurl(var, "_Weights_Layer1_Neurons") + layer1_bias = get_fromurl(var, "_Weights_Layer1_Bias").reshape(-1, 1) + layer2_weights = get_fromurl(var, "_Weights_Layer2_Neurons").reshape(1, -1) + layer2_bias = get_fromurl(var, "_Weights_Layer2_Bias").reshape(1, -1) + extreme_cases = get_fromurl(var, "_ExtremeCases") + + if var == "FCOVER": + nn_params[var] = { + "norm_minmax": norm_minmax, + "denorm_minmax": denorm_minmax, + "layer1_weights": layer1_weights, + "layer1_bias": layer1_bias, + "layer2_weights": layer2_weights, + "layer2_bias": layer2_bias, + "extreme_cases": extreme_cases, + } + else: + defdom_min = get_fromurl(var, "_DefinitionDomain_MinMax")[0, :].reshape(-1, 1) + defdom_max = get_fromurl(var, "_DefinitionDomain_MinMax")[1, :].reshape(-1, 1) + defdom_grid = get_fromurl(var, "_DefinitionDomain_Grid") + nn_params[var] = { + "norm_minmax": norm_minmax, + "denorm_minmax": denorm_minmax, + "layer1_weights": layer1_weights, + "layer1_bias": layer1_bias, + "layer2_weights": layer2_weights, + "layer2_bias": layer2_bias, + "defdom_min": defdom_min, + "defdom_max": defdom_max, + "defdom_grid": defdom_grid, + "extreme_cases": extreme_cases, + } + + +def _normalization(x, x_min, x_max): + x_norm = 2 * (x - x_min) / (x_max - x_min) - 1 + return x_norm + + +def _denormalization(y_norm, y_min, y_max): + y = 0.5 * (y_norm + 1) * (y_max - y_min) + return y + + +def _input_ouf_of_range(x, variable): + x_copy = x.copy() + x_bands = x_copy[:8, :] + + # check min max domain + defdom_min = nn_params[variable]["defdom_min"][:, 0].reshape(-1, 1) + defdom_max = nn_params[variable]["defdom_max"][:, 0].reshape(-1, 1) + bad_input_mask = (x_bands < defdom_min) | (x_bands > defdom_max) + bad_vector = np.any(bad_input_mask, axis=0) + x_bands[:, bad_vector] = np.nan + + # convex hull check, currently disabled due to time consumption vs benefit + # gridProject = lambda v: np.floor(10 * (v - defdom_min) / (defdom_max - defdom_min) + 1 ).astype(int) + # x_bands = gridProject(x_bands) + # isInGrid = lambda v: any((v == x).all() for x in nn_params[variable]['defdom_grid']) + # notInGrid = ~np.array([isInGrid(v) for v in x_bands.T]) + # x[:,notInGrid | bad_vector] = np.nan + + x_copy[:, bad_vector] = np.nan + return x_copy + + +def _output_ouf_of_range(output, variable): + new_output = np.copy(output) + tolerance = nn_params[variable]["extreme_cases"][0] + output_min = nn_params[variable]["extreme_cases"][1] + output_max = nn_params[variable]["extreme_cases"][2] + + new_output[output < (output_min + tolerance)] = np.nan + new_output[(output > (output_min + tolerance)) & (output < output_min)] = output_min + new_output[(output < (output_max - tolerance)) & (output > output_max)] = output_max + new_output[output > (output_max - tolerance)] = np.nan + return new_output + + +def _compute_variable(x, variable): + + x_norm = np.zeros_like(x) + x = _input_ouf_of_range(x, variable) + x_norm = _normalization( + x, + nn_params[variable]["norm_minmax"][:, 0].reshape(-1, 1), + nn_params[variable]["norm_minmax"][:, 1].reshape(-1, 1), + ) + + out_layer1 = np.tanh( + nn_params[variable]["layer1_weights"].dot(x_norm) + + nn_params[variable]["layer1_bias"] + ) + out_layer2 = ( + nn_params[variable]["layer2_weights"].dot(out_layer1) + + nn_params[variable]["layer2_bias"] + ) + output = _denormalization( + out_layer2, + nn_params[variable]["denorm_minmax"][0], + nn_params[variable]["denorm_minmax"][1], + )[0] + output = _output_ouf_of_range(output, variable) + output = output.reshape(1, np.shape(x)[1]) + return output + + +def run_snap_biophys(dataset, variable): + """Compute specified variable using the SNAP algorithm. + + See ATBD at https://step.esa.int/docs/extra/ATBD_S2ToolBox_L2B_V1.1.pdf + + Parameters + ---------- + dataset : xr dataset + xarray dataset. + variable : str + Options 'FAPAR', 'FCOVER', 'LAI', 'LAI_Cab' or 'LAI_Cw' + + Returns + ------- + xarray dataset + Adds the specified variable array to dataset (variable name in + lowercase). + + """ + # generate view angle bands/layers + vz = ( + np.ones_like(dataset.band_data[:, 0, :, :]).T + * np.cos(np.radians(dataset.view_zenith)).values + ) + vz = vz[..., np.newaxis] + vzarr = xr.DataArray( + vz, + coords=[dataset.y, dataset.x, dataset.time, ["view_zenith"]], + dims=["y", "x", "time", "band"], + ) + + sz = ( + np.ones_like(dataset.band_data[:, 0, :, :]).T + * np.cos(np.radians(dataset.sun_zenith)).values + ) + sz = sz[..., np.newaxis] + szarr = xr.DataArray( + sz, + coords=[dataset.y, dataset.x, dataset.time, ["sun_zenith"]], + dims=["y", "x", "time", "band"], + ) + + raz = ( + np.ones_like(dataset.band_data[:, 0, :, :]).T + * np.cos(np.radians(dataset.sun_azimuth - dataset.view_azimuth)).values + ) + raz = raz[..., np.newaxis] + razarr = xr.DataArray( + raz, + coords=[dataset.y, dataset.x, dataset.time, ["relative_azimuth"]], + dims=["y", "x", "time", "band"], + ) + + newarr = xr.concat([dataset.band_data, vzarr, szarr, razarr], dim="band") + newarr = newarr.stack(xy=("x", "y")) + arr = xr.apply_ufunc( + _compute_variable, + newarr, + input_core_dims=[["band", "xy"]], + output_core_dims=[["xy"]], + kwargs={"variable": variable}, + vectorize=True, + ).unstack() + return dataset.assign({variable.lower(): arr}) diff --git a/modules/data.remote/inst/RpTools/RpTools/create_geojson.py b/modules/data.remote/inst/RpTools/RpTools/create_geojson.py new file mode 100644 index 00000000000..e89ddf732e1 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/create_geojson.py @@ -0,0 +1,47 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +used to Create GeoJSON file from the geometry extracted from sites table in BETY + +Author: Ayush Prasad +""" + + +from geojson import Point, Feature, FeatureCollection, dump +import json +import os + + +def create_geojson(coords, siteid, outdir): + """ + Create GeoJSON file from geometry extracted from BETY + + Parameters + ---------- + coords (str) -- geometry from BETY sites + siteid (str) -- siteid + outdir (str) -- path where the output file has to be stored + Returns + ------- + Absolute path to the merged file + output GeoJSOn file is saved in the specified directory. + """ + + geo = json.loads(coords) + + features = [] + + features.append(Feature(geometry=geo, properties={"name": siteid})) + + feature_collection = FeatureCollection(features) + + if not os.path.exists(outdir): + os.makedirs(outdir, exist_ok=True) + + file = os.path.join(outdir, siteid + ".geojson") + + with open(file, "w") as f: + dump(feature_collection, f) + + return os.path.abspath(file) diff --git a/modules/data.remote/inst/RpTools/RpTools/gee2pecan_l8.py b/modules/data.remote/inst/RpTools/RpTools/gee2pecan_l8.py new file mode 100644 index 00000000000..3b24d209d1a --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/gee2pecan_l8.py @@ -0,0 +1,195 @@ +""" +Extracts Landsat 8 surface reflactance band data from Google Earth Engine and saves it in a netCDF file + +Requires Python3 + +Bands retrieved: B1, B2, B3, B4, B5, B6, B7, B10, B11 along with computed NDVI + +If ROI is a Point, this function can be used for getting SR data from Landsat 7, 5 and 4 as well. + +Author: Ayush Prasad +""" +from RpTools.gee_utils import create_geo, get_sitecoord, get_sitename, calc_ndvi +import ee +import pandas as pd +import geopandas as gpd +import datetime +import os +import xarray as xr +import numpy as np +import re +import time + +ee.Initialize() + + +def gee2pecan_l8(geofile, outdir, filename, start, end, scale, qc): + """ + Extracts Landsat 8 SR band data from GEE + + Parameters + ---------- + geofile (str) -- path to the file containing the name and coordinates of ROI, currently tested with geojson. + + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + + filename (str) -- filename of the output file + + start (str) -- starting date of the data request in the form YYYY-MM-DD + + end (str) -- ending date areaof the data request in the form YYYY-MM-DD + + scale (int) -- pixel resolution + + qc (bool) -- uses the cloud masking function if set to True + + + Returns + ------- + Absolute path to the output file. + output netCDF is saved in the specified directory. + + """ + + def reduce_region(image): + """ + Reduces the selected region + currently set to mean, can be changed as per requirements. + """ + stat_dict = image.reduceRegion(ee.Reducer.mean(), geo, scale) + sensingtime = image.get("SENSING_TIME") + return ee.Feature(None, stat_dict).set("sensing_time", sensingtime) + + def mask(image): + """ + Masks clouds and cloud shadows using the pixel_qa band + Can be configured as per requirements + """ + clear = image.select("pixel_qa") + return image.updateMask(clear) + + # create image collection depending upon the qc choice + if qc == True: + landsat = ( + ee.ImageCollection("LANDSAT/LC08/C01/T1_SR") + .filterDate(start, end) + .map(mask) + .sort("system:time_start", True) + ) + + else: + landsat = ( + ee.ImageCollection("LANDSAT/LC08/C01/T1_SR") + .filterDate(start, end) + .sort("system:time_start", True) + ) + + # map NDVI to the image collection and select the bands + landsat = landsat.map(calc_ndvi(nir="B5", red="B4")).select( + ["B1", "B2", "B3", "B4", "B5", "B6", "B7", "B10", "B11", "NDVI"] + ) + + # if ROI is a point + df = gpd.read_file(geofile) + if (df.geometry.type == "Point").bool(): + + geo = create_geo(geofile) + + # get the data + l_data = landsat.filterBounds(geo).getRegion(geo, scale).getInfo() + # put the data inside a list of dictionary + l_data_dict = [dict(zip(l_data[0], values)) for values in l_data[1:]] + + def getdate(filename): + """ + calculates Date from the landsat id + """ + string = re.compile( + r"(?PLC08|LE07|LT05|LT04)_(?P\d{6})_(?P\d{8})" + ) + x = string.search(filename) + d = datetime.datetime.strptime(x.group("date"), "%Y%m%d").date() + return d + + # pop out unnecessary keys and add date + for d in l_data_dict: + d.pop("longitude", None) + d.pop("latitude", None) + d.pop("time", None) + d.update(time=getdate(d["id"])) + + # Put data in a dataframe + datadf = pd.DataFrame(l_data_dict) + # converting date to the numpy date format + datadf["time"] = datadf["time"].apply(lambda x: np.datetime64(x)) + datadf.rename(columns={"time": "sensing_time"}, inplace=True) + # if ROI is a polygon + elif (df.geometry.type == "Polygon").bool(): + + geo = create_geo(geofile) + + # get the data + l_data = landsat.filterBounds(geo).map(reduce_region).getInfo() + + def l8_fc2dict(fc): + """ + Converts feature collection to dictionary form. + """ + + def eachf2dict(f): + id = f["id"] + out = f["properties"] + out.update(id=id) + return out + + out = [eachf2dict(x) for x in fc["features"]] + return out + + # convert to dictionary + l_data_dict = l8_fc2dict(l_data) + # create a dataframe from the dictionary + datadf = pd.DataFrame(l_data_dict) + # convert date to a more readable format + datadf["sensing_time"] = datadf["sensing_time"].apply( + lambda x: datetime.datetime.strptime(x.split(".")[0], "%Y-%m-%dT%H:%M:%S") + ) + # if ROI type is not a Point ot Polygon + else: + raise ValueError("geometry choice not supported") + + site_name = get_sitename(geofile) + AOI = get_sitecoord(geofile) + coords = { + "time": datadf["sensing_time"].values, + } + # convert the dataframe to an xarray dataset + tosave = xr.Dataset( + datadf, + coords=coords, + attrs={ + "site_name": site_name, + "AOI": AOI, + "sensor": "LANDSAT/LC08/C01/T1_SR", + "scale": scale, + "qc parameter": qc, + }, + ) + + + # if specified path does not exist create it + if not os.path.exists(outdir): + os.makedirs(outdir, exist_ok=True) + + # convert the dataset to a netCDF file and save it + timestamp = time.strftime("%y%m%d%H%M%S") + filepath = os.path.join( + outdir, + filename + + "_" + + timestamp + + ".nc", + ) + + tosave.to_netcdf(filepath) + + return os.path.abspath(filepath) diff --git a/modules/data.remote/inst/RpTools/RpTools/gee2pecan_s2.py b/modules/data.remote/inst/RpTools/RpTools/gee2pecan_s2.py new file mode 100644 index 00000000000..aa1c7851f98 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/gee2pecan_s2.py @@ -0,0 +1,831 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- +""" +Created on Thu Feb 6 15:24:12 2020 + +Module to retrieve Sentinel-2 data from Google Earth Engine (GEE). + +@author: Olli Nevalainen (olli.nevalainen@fmi.fi), + Finnish Meteorological Institute) + + +""" +import time +import sys +import os +import ee +import datetime +import pandas as pd +import geopandas as gpd +import numpy as np +import xarray as xr +from functools import reduce +from RpTools.gee_utils import calc_ndvi + +ee.Initialize() + + +NO_DATA = -99999 +S2_REFL_TRANS = 10000 +# ----------------- Sentinel-2 ------------------------------------- +s2_qi_labels = [ + "NODATA", + "SATURATED_DEFECTIVE", + "DARK_FEATURE_SHADOW", + "CLOUD_SHADOW", + "VEGETATION", + "NOT_VEGETATED", + "WATER", + "UNCLASSIFIED", + "CLOUD_MEDIUM_PROBA", + "CLOUD_HIGH_PROBA", + "THIN_CIRRUS", + "SNOW_ICE", +] + +s2_filter1 = [ + "NODATA", + "SATURATED_DEFECTIVE", + "CLOUD_SHADOW", + "UNCLASSIFIED", + "CLOUD_MEDIUM_PROBA", + "CLOUD_HIGH_PROBA", + "THIN_CIRRUS", + "SNOW_ICE", +] + + +class S2RequestParams: + """S2 data request paramaters. + + Attributes + ---------- + datestart : str + Starting date for data request in form "2019-01-01". + dateend : str + Starting date for data request in form "2019-12-31". + scale : int + pixel resolution + bands : list, optional + List of strings with band name. + the default is ['B3', 'B4', 'B5', + 'B6', 'B7', 'B8A', 'B11', 'B12']. + """ + + def __init__(self, datestart, dateend, scale, bands=None): + """. + + Parameters + ---------- + datestart : str + Starting date for data request in form "2019-01-01". + dateend : str + Starting date for data request in form "2019-12-31". + scale : int + pixel resolution + bands : list, optional + List of strings with band name. + + Returns + ------- + None. + + """ + default_bands = [ + "B1", + "B2", + "B3", + "B4", + "B5", + "B6", + "B7", + "B8", + "B8A", + "B9", + "B11", + "B12", + ] + + self.datestart = datestart + self.dateend = dateend + self.scale = scale + self.bands = bands if bands else default_bands + + +class AOI: + """Area of interest for area info and data. + + Attributes + ---------- + name : str + Name of the area. + geometry : str + Geometry of the area of interest e.g. from geopandas. + Currently only polygons tested. Ayush: modified to work with Point type. The default is None. + coordinate_list : list, optional + List of coordinates of a polygon + (loop should be closed). Computed from geometry if not + provided. The default is None. + tile : str, optional + Tile id as string for the data. Used to keep the data in + same crs because an area can be in multiple tiles with + different crs. The default is None. + qi : pandas dataframe + Dataframe with quality information about available imagery for the AOI. + qi is empty at init and can be computed with + ee_get_s2_quality_info function. + data : pandas dataframe or xarray + Dataframe holding data retrieved from GEE. Data can be computed using + function + qi is empty at init and can be computed with ee_get_s2_data and + converted to xarray using s2_data_to_xarray function. + + Methods + ------- + __init__ + """ + + def __init__(self, name, geometry=None, geometry_type=None, coordinate_list=None, tile=None): + """. + + Parameters + ---------- + name : str + Name of the area. + geometry : geometry in wkt, optional + Geometry of the area of interest e.g. from geopandas. + Currently only polygons tested. Ayush: modified to work with Point type The default is None. + geometry_type: type of geometry, Polygon or Point. The default is None. + coordinate_list : list, optional + List of coordinates of a polygon + (loop should be closed). Computed from geometry if not + provided. The default is None. + tile : str, optional + Tile id as string for the data. Used to keep the data in + same crs because an area can be in multiple tiles with + different crs. The default is None. + + Returns + ------- + None. + + """ + if not geometry and not coordinate_list: + sys.exit("AOI has to get either geometry or coordinates as list!") + elif geometry and not coordinate_list: + if geometry.type == "Polygon": + coordinate_list = list(geometry.exterior.coords) + for i in range(len(coordinate_list)): + coordinate_list[i] = coordinate_list[i][0:2] + else: + lon = float(geometry.x) + lat = float(geometry.y) + coordinate_list = [(lon, lat)] + elif coordinate_list and not geometry: + geometry = None + + self.name = name + self.geometry = geometry + self.geometry_type = geometry.type + self.coordinate_list = coordinate_list + self.qi = None + self.data = None + self.tile = tile + + +def ee_get_s2_quality_info(AOIs, req_params): + """Get S2 quality information from GEE. + + Parameters + ---------- + AOIs : list or AOI instance + List of AOI instances or single AOI instance. If multiple AOIs + proviveded the computation in GEE server is parallellized. + If too many areas with long time range is provided, user might + hit GEE memory limits. Then you should call this function + sequentally to all AOIs. + req_params : S2RequestParams instance + S2RequestParams instance with request details. + + Returns + ------- + Nothing: + Computes qi attribute for the given AOI instances. + + """ + # if single AOI instance, make a list + if isinstance(AOIs, AOI): + AOIs = list([AOIs]) + + features = [ + ee.Feature(ee.Geometry.Polygon(a.coordinate_list), {"name": a.name}) if a.geometry_type == "Polygon" else ee.Feature(ee.Geometry.Point(a.coordinate_list[0][0], a.coordinate_list[0][1]), {"name": a.name}) for a in AOIs + ] + feature_collection = ee.FeatureCollection(features) + + def ee_get_s2_quality_info_feature(feature): + + area = feature.geometry() + image_collection = ( + ee.ImageCollection("COPERNICUS/S2_SR") + .filterBounds(area) + .filterDate(req_params.datestart, req_params.dateend) + .select(["SCL"]) + ) + + def ee_get_s2_quality_info_image(img): + productid = img.get("PRODUCT_ID") + assetid = img.id() + tileid = img.get("MGRS_TILE") + system_index = img.get("system:index") + proj = img.select("SCL").projection() + + # apply reducer to list + img = img.reduceRegion( + reducer=ee.Reducer.toList(), + geometry=area, + maxPixels=1e8, + scale=req_params.scale, + ) + + # get data into arrays + classdata = ee.Array( + ee.Algorithms.If( + img.get("SCL"), ee.Array(img.get("SCL")), ee.Array([0]) + ) + ) + + totalcount = classdata.length() + classpercentages = { + key: classdata.eq(i) + .reduce(ee.Reducer.sum(), [0]) + .divide(totalcount) + .get([0]) + for i, key in enumerate(s2_qi_labels) + } + + tmpfeature = ( + ee.Feature(ee.Geometry.Point([0, 0])) + .set("productid", productid) + .set("system_index", system_index) + .set("assetid", assetid) + .set("tileid", tileid) + .set("projection", proj) + .set(classpercentages) + ) + return tmpfeature + + s2_qi_image_collection = image_collection.map(ee_get_s2_quality_info_image) + + return ( + feature.set( + "productid", s2_qi_image_collection.aggregate_array("productid") + ) + .set("system_index", s2_qi_image_collection.aggregate_array("system_index")) + .set("assetid", s2_qi_image_collection.aggregate_array("assetid")) + .set("tileid", s2_qi_image_collection.aggregate_array("tileid")) + .set("projection", s2_qi_image_collection.aggregate_array("projection")) + .set( + { + key: s2_qi_image_collection.aggregate_array(key) + for key in s2_qi_labels + } + ) + ) + + s2_qi_feature_collection = feature_collection.map( + ee_get_s2_quality_info_feature + ).getInfo() + + s2_qi = s2_feature_collection_to_dataframes(s2_qi_feature_collection) + + for a in AOIs: + name = a.name + a.qi = s2_qi[name] + + +def ee_get_s2_data(AOIs, req_params, qi_threshold=0, qi_filter=s2_filter1): + """Get S2 data (level L2A, bottom of atmosphere data) from GEE. + + Parameters + ---------- + AOIs : list or AOI instance + List of AOI instances or single AOI instance. If multiple AOIs + proviveded the computation in GEE server is parallellized. + If too many areas with long time range is provided, user might + hit GEE memory limits. Then you should call this function + sequentally to all AOIs. AOIs should have qi attribute computed first. + req_params : S2RequestParams instance + S2RequestParams instance with request details. + qi_threshold : float + Threshold value to filter images based on used qi filter. + qi filter holds labels of classes whose percentages within the AOI + is summed. If the sum is larger then the qi_threhold, data will not be + retrieved for that date/image. The default is 1, meaning all data is + retrieved. + qi_filter : list + List of strings with class labels (of unwanted classes) used to compute qi value, + see qi_threhold. The default is s2_filter1 = ['NODATA', + 'SATURATED_DEFECTIVE', + 'CLOUD_SHADOW', + 'UNCLASSIFIED', + 'CLOUD_MEDIUM_PROBA', + 'CLOUD_HIGH_PROBA', + 'THIN_CIRRUS', + 'SNOW_ICE']. + + Returns + ------- + Nothing: + Computes data attribute for the given AOI instances. + + """ + datestart = req_params.datestart + dateend = req_params.dateend + bands = req_params.bands + # if single AOI instance, make a list + if isinstance(AOIs, AOI): + AOIs = list([AOIs]) + + features = [] + for a in AOIs: + filtered_qi = filter_s2_qi_dataframe(a.qi, qi_threshold, qi_filter) + if len(filtered_qi) == 0: + print("No observations to retrieve for area %s" % a.name) + continue + + if a.tile is None: + min_tile = min(filtered_qi["tileid"].values) + filtered_qi = filtered_qi[filtered_qi["tileid"] == min_tile] + a.tile = min_tile + else: + filtered_qi = filtered_qi[filtered_qi["tileid"] == a.tile] + + full_assetids = "COPERNICUS/S2_SR/" + filtered_qi["assetid"] + image_list = [ee.Image(asset_id) for asset_id in full_assetids] + crs = filtered_qi["projection"].values[0]["crs"] + if a.geometry_type == "Polygon": + feature = ee.Feature( + ee.Geometry.Polygon(a.coordinate_list), + {"name": a.name, "image_list": image_list}, + ) + else: + feature = ee.Feature( + ee.Geometry.Point(a.coordinate_list[0][0], a.coordinate_list[0][1]), + {"name": a.name, "image_list": image_list}, + ) + + features.append(feature) + + if len(features) == 0: + print("No data to be retrieved!") + return None + + feature_collection = ee.FeatureCollection(features) + + def ee_get_s2_data_feature(feature): + geom = feature.geometry(0.01, crs) + image_collection = ( + ee.ImageCollection.fromImages(feature.get("image_list")) + .filterBounds(geom) + .filterDate(datestart, dateend) + # .select(bands + ["SCL"]) + ) + image_collection = image_collection.map(calc_ndvi(nir="B8A", red="B4")).select( + bands + ["SCL", "NDVI"] + ) + + def ee_get_s2_data_image(img): + # img = img.clip(geom) + productid = img.get("PRODUCT_ID") + assetid = img.id() + tileid = img.get("MGRS_TILE") + system_index = img.get("system:index") + proj = img.select(bands[0]).projection() + sun_azimuth = img.get("MEAN_SOLAR_AZIMUTH_ANGLE") + sun_zenith = img.get("MEAN_SOLAR_ZENITH_ANGLE") + view_azimuth = ( + ee.Array( + [img.get("MEAN_INCIDENCE_AZIMUTH_ANGLE_%s" % b) for b in bands] + ) + .reduce(ee.Reducer.mean(), [0]) + .get([0]) + ) + view_zenith = ( + ee.Array([img.get("MEAN_INCIDENCE_ZENITH_ANGLE_%s" % b) for b in bands]) + .reduce(ee.Reducer.mean(), [0]) + .get([0]) + ) + + img = img.resample("bilinear").reproject(crs=crs, scale=req_params.scale) + + # get the lat lon and add the ndvi + image_grid = ee.Image.pixelCoordinates(ee.Projection(crs)).addBands( + [img.select(b) for b in bands + ["SCL", "NDVI"]] + ) + + # apply reducer to list + image_grid = image_grid.reduceRegion( + reducer=ee.Reducer.toList(), + geometry=geom, + maxPixels=1e8, + scale=req_params.scale, + ) + + # get data into arrays + x_coords = ee.Array(image_grid.get("x")) + y_coords = ee.Array(image_grid.get("y")) + band_data = {b: ee.Array(image_grid.get("%s" % b)) for b in bands} + + scl_data = ee.Array(image_grid.get("SCL")) + ndvi_data = ee.Array(image_grid.get("NDVI")) + + # perform LAI et al. computation possibly here! + + tmpfeature = ( + ee.Feature(ee.Geometry.Point([0, 0])) + .set("productid", productid) + .set("system_index", system_index) + .set("assetid", assetid) + .set("tileid", tileid) + .set("projection", proj) + .set("sun_zenith", sun_zenith) + .set("sun_azimuth", sun_azimuth) + .set("view_zenith", view_zenith) + .set("view_azimuth", view_azimuth) + .set("x_coords", x_coords) + .set("y_coords", y_coords) + .set("SCL", scl_data) + .set("NDVI", ndvi_data) + .set(band_data) + ) + return tmpfeature + + s2_data_feature = image_collection.map(ee_get_s2_data_image) + + return ( + feature.set("productid", s2_data_feature.aggregate_array("productid")) + .set("system_index", s2_data_feature.aggregate_array("system_index")) + .set("assetid", s2_data_feature.aggregate_array("assetid")) + .set("tileid", s2_data_feature.aggregate_array("tileid")) + .set("projection", s2_data_feature.aggregate_array("projection")) + .set("sun_zenith", s2_data_feature.aggregate_array("sun_zenith")) + .set("sun_azimuth", s2_data_feature.aggregate_array("sun_azimuth")) + .set("view_zenith", s2_data_feature.aggregate_array("view_zenith")) + .set("view_azimuth", s2_data_feature.aggregate_array("view_azimuth")) + .set("x_coords", s2_data_feature.aggregate_array("x_coords")) + .set("y_coords", s2_data_feature.aggregate_array("y_coords")) + .set("SCL", s2_data_feature.aggregate_array("SCL")) + .set("NDVI", s2_data_feature.aggregate_array("NDVI")) + .set({b: s2_data_feature.aggregate_array(b) for b in bands}) + ) + + s2_data_feature_collection = feature_collection.map( + ee_get_s2_data_feature + ).getInfo() + + s2_data = s2_feature_collection_to_dataframes(s2_data_feature_collection) + + for a in AOIs: + name = a.name + a.data = s2_data[name] + + +def filter_s2_qi_dataframe(s2_qi_dataframe, qi_thresh, s2_filter=s2_filter1): + """Filter qi dataframe. + + Parameters + ---------- + s2_qi_dataframe : pandas dataframe + S2 quality information dataframe (AOI instance qi attribute). + qi_thresh : float + Threshold value to filter images based on used qi filter. + qi filter holds labels of classes whose percentages within the AOI + is summed. If the sum is larger then the qi_threhold, data will not be + retrieved for that date/image. The default is 1, meaning all data is + retrieved. + s2_filter : list + List of strings with class labels (of unwanted classes) used to compute qi value, + see qi_threhold. The default is s2_filter1 = ['NODATA', + 'SATURATED_DEFECTIVE', + 'CLOUD_SHADOW', + 'UNCLASSIFIED', + 'CLOUD_MEDIUM_PROBA', + 'CLOUD_HIGH_PROBA', + 'THIN_CIRRUS', + 'SNOW_ICE']. + + Returns + ------- + filtered_s2_qi_df : pandas dataframe + Filtered dataframe. + + """ + filtered_s2_qi_df = s2_qi_dataframe.loc[ + s2_qi_dataframe[s2_filter1].sum(axis=1) < qi_thresh + ] + + return filtered_s2_qi_df + + +def s2_feature_collection_to_dataframes(s2_feature_collection): + """Convert feature collection dict from GEE to pandas dataframe. + + Parameters + ---------- + s2_feature_collection : dict + Dictionary returned by GEE. + + Returns + ------- + dataframes : pandas dataframe + GEE dictinary converted to pandas dataframe. + + """ + dataframes = {} + + for featnum in range(len(s2_feature_collection["features"])): + tmp_dict = {} + key = s2_feature_collection["features"][featnum]["properties"]["name"] + productid = s2_feature_collection["features"][featnum]["properties"][ + "productid" + ] + + dates = [ + datetime.datetime.strptime(d.split("_")[2], "%Y%m%dT%H%M%S") + for d in productid + ] + + tmp_dict.update({"Date": dates}) # , 'crs': crs} + properties = s2_feature_collection["features"][featnum]["properties"] + for prop, data in properties.items(): + if prop not in ["Date"]: # 'crs' ,, 'projection' + tmp_dict.update({prop: data}) + dataframes[key] = pd.DataFrame(tmp_dict) + return dataframes + + +def s2_data_to_xarray(aoi, request_params, convert_to_reflectance=True): + """Convert AOI.data dataframe to xarray dataset. + + Parameters + ---------- + aoi : AOI instance + AOI instance. + request_params : S2RequestParams + S2RequestParams. + convert_to_reflectance : boolean, optional + Convert S2 data from GEE (integers) to reflectances (floats), + i,e, divide by 10000. + The default is True. + + Returns + ------- + Nothing. + Converts the data atrribute dataframe to xarray Dataset. + xarray is better for handling multiband data. It also has + implementation for saving the data in NetCDF format. + + """ + # check that all bands have full data! + datalengths = [ + aoi.data[b].apply(lambda d: len(d)) == len(aoi.data.iloc[0]["x_coords"]) + for b in request_params.bands + ] + consistent_data = reduce(lambda a, b: a & b, datalengths) + aoi.data = aoi.data[consistent_data] + + # 2D data + bands = request_params.bands + + # 1D data + list_vars = [ + "sun_azimuth", + "sun_zenith", + "view_azimuth", + "view_zenith", + ] + + # crs from projection + crs = aoi.data["projection"].values[0]["crs"] + tileid = aoi.data["tileid"].values[0] + # original number of pixels requested (pixels inside AOI) + aoi_pixels = len(aoi.data.iloc[0]["x_coords"]) + + # transform 2D data to arrays + for b in bands: + + aoi.data[b] = aoi.data.apply( + lambda row: s2_lists_to_array( + row["x_coords"], + row["y_coords"], + row[b], + convert_to_reflectance=convert_to_reflectance, + ), + axis=1, + ) + + aoi.data["SCL"] = aoi.data.apply( + lambda row: s2_lists_to_array( + row["x_coords"], row["y_coords"], row["SCL"], convert_to_reflectance=False + ), + axis=1, + ) + + aoi.data["NDVI"] = aoi.data.apply( + lambda row: s2_lists_to_array( + row["x_coords"], row["y_coords"], row["NDVI"], convert_to_reflectance=False + ), + axis=1, + ) + + array = aoi.data[bands].values + + # this will stack the array to ndarray with + # dimension order = (time, band, x,y) + narray = np.stack( + [np.stack(array[:, b], axis=2) for b in range(len(bands))], axis=2 + ).transpose() # .swapaxes(2, 3) + + scl_array = np.stack(aoi.data["SCL"].values, axis=2).transpose() + ndvi_array = np.stack(aoi.data["NDVI"].values, axis=2).transpose() + + coords = { + "time": aoi.data["Date"].values, + "band": bands, + "x": np.unique(aoi.data.iloc[0]["x_coords"]), + "y": np.unique(aoi.data.iloc[0]["y_coords"]), + } + + dataset_dict = { + "band_data": (["time", "band", "x", "y"], narray), + "SCL": (["time", "x", "y"], scl_array), + "NDVI": (["time", "x", "y"], ndvi_array), + } + var_dict = {var: (["time"], aoi.data[var]) for var in list_vars} + dataset_dict.update(var_dict) + + ds = xr.Dataset( + dataset_dict, + coords=coords, + attrs={ + "name": aoi.name, + "crs": crs, + "tile_id": tileid, + "aoi_geometry": aoi.geometry.to_wkt(), + "aoi_pixels": aoi_pixels, + }, + ) + aoi.data = ds + + +def s2_lists_to_array(x_coords, y_coords, data, convert_to_reflectance=True): + """Convert 1D lists of coordinates and corresponding values to 2D array. + + Parameters + ---------- + x_coords : list + List of x-coordinates. + y_coords : list + List of y-coordinates. + data : list + List of data values corresponding to the coordinates. + convert_to_reflectance : boolean, optional + Convert S2 data from GEE (integers) to reflectances (floats), + i,e, divide by 10000. + The default is True. + + Returns + ------- + arr : 2D numpy array + Return 2D numpy array. + + """ + # get the unique coordinates + uniqueYs = np.unique(y_coords) + uniqueXs = np.unique(x_coords) + + # get number of columns and rows from coordinates + ncols = len(uniqueXs) + nrows = len(uniqueYs) + + # determine pixelsizes + # ys = uniqueYs[1] - uniqueYs[0] + # xs = uniqueXs[1] - uniqueXs[0] + + y_vals, y_idx = np.unique(y_coords, return_inverse=True) + x_vals, x_idx = np.unique(x_coords, return_inverse=True) + if convert_to_reflectance: + arr = np.empty(y_vals.shape + x_vals.shape, dtype=np.float64) + arr.fill(np.nan) + arr[y_idx, x_idx] = np.array(data, dtype=np.float64) / S2_REFL_TRANS + else: + arr = np.empty(y_vals.shape + x_vals.shape, dtype=np.float64) + arr.fill(NO_DATA) # or whatever yor desired missing data flag is + arr[y_idx, x_idx] = data + arr = np.flipud(arr) + return arr + + +def xr_dataset_to_timeseries(xr_dataset, variables): + """Compute timeseries dataframe from xr dataset. + + Parameters + ---------- + xr_dataset : xarray dataset + + variables : list + list of variable names as string. + + Returns + ------- + df : pandas dataframe + Pandas dataframe with mean, std, se and percentage of NaNs inside AOI. + + """ + df = pd.DataFrame({"Date": pd.to_datetime(xr_dataset.time.values)}) + + for var in variables: + df[var] = xr_dataset[var].mean(dim=["x", "y"]) + df[var + "_std"] = xr_dataset[var].std(dim=["x", "y"]) + + # nans occure due to missging data from 1D to 2D array + # (pixels outside the polygon), + # from snap algorihtm nans occure due to input/output ouf of bounds + # checking. + # TODO: flaggging with snap biophys algorith or some other solution to + # check which nan are from snap algorithm and which from 1d to 2d transformation + nans = np.isnan(xr_dataset[var]).sum(dim=["x", "y"]) + sample_n = len(xr_dataset[var].x) * len(xr_dataset[var].y) - nans + + # compute how many of the nans are inside aoi (due to snap algorithm) + out_of_aoi_pixels = ( + len(xr_dataset[var].x) * len(xr_dataset[var].y) - xr_dataset.aoi_pixels + ) + nans_inside_aoi = nans - out_of_aoi_pixels + df["aoi_nan_percentage"] = nans_inside_aoi / xr_dataset.aoi_pixels + + df[var + "_se"] = df[var + "_std"] / np.sqrt(sample_n) + + return df + + +def gee2pecan_s2(geofile, outdir, filename, start, end, scale, qc): + """ + Downloads Sentinel 2 data from gee and saves it in a netCDF file at the specified location. + + Parameters + ---------- + geofile (str) -- path to the file containing the name and coordinates of ROI, currently tested with geojson. + + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + + filename (str) -- filename of the output file + + start (str) -- starting date of the data request in the form YYYY-MM-DD + + end (str) -- ending date of the data request in the form YYYY-MM-DD + + scale (int) - pixel resolution, recommended value 10 + + qi_threshold (float) -- From satellitetools: Threshold value to filter images based on used qi filter. qi filter holds labels of classes whose percentages within the AOI is summed. If the sum is larger then the qi_threshold, data will not be retrieved for that date/image. The default is 1, meaning all data is retrieved + + Returns + ------- + Absolute path to the output file. + output netCDF is saved in the specified directory. + + Python dependencies required: earthengine-api, geopandas, pandas, netCDF4, xarray + """ + + # read in the input file containing coordinates + df = gpd.read_file(geofile) + + request = S2RequestParams(start, end, scale) + + # filter area of interest from the coordinates in the input file + area = AOI(df[df.columns[0]].iloc[0], df[df.columns[1]].iloc[0]) + + # calcuate qi attribute for the AOI + ee_get_s2_quality_info(area, request) + + # get the final data + ee_get_s2_data(area, request, qi_threshold=qc) + + # convert dataframe to an xarray dataset, used later for converting to netCDF + s2_data_to_xarray(area, request) + + # if specified output directory does not exist, create it + if not os.path.exists(outdir): + os.makedirs(outdir, exist_ok=True) + timestamp = time.strftime("%y%m%d%H%M%S") + save_path = os.path.join( + outdir, + filename + + "_" + + timestamp + + ".nc", + ) + + area.data.to_netcdf(save_path) + + return os.path.abspath(save_path) diff --git a/modules/data.remote/inst/RpTools/RpTools/gee2pecan_smap.py b/modules/data.remote/inst/RpTools/RpTools/gee2pecan_smap.py new file mode 100644 index 00000000000..10ae8340133 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/gee2pecan_smap.py @@ -0,0 +1,174 @@ +""" +Downloads SMAP Global Soil Moisture Data from Google Earth Engine and saves it in a netCDF file. + +Data retrieved: ssm, susm, smp, ssma, susma + +Requires Python3 + +Author: Ayush Prasad +""" +from RpTools.gee_utils import create_geo, get_sitecoord, get_sitename +import ee +import pandas as pd +import os +import xarray as xr +import datetime +import time + +ee.Initialize() + + +def gee2pecan_smap(geofile, outdir, filename, start, end): + """ + Downloads and saves SMAP data from GEE + + Parameters + ---------- + geofile (str) -- path to the geosjon file containing the name and coordinates of ROI + + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + + filename (str) -- filename of the output file + + start (str) -- starting date of the data request in the form YYYY-MM-dd + + end (str) -- ending date areaof the data request in the form YYYY-MM-dd + + siteid (str) -- shortform of siteid, None by default + + Returns + ------- + Absolute path to the output file. + output netCDF is saved in the specified directory. + """ + + geo = create_geo(geofile) + + def smap_ts(geo, start, end): + # extract a feature from the geometry + features = [ee.Feature(geo)] + # create a feature collection from the features + featureCollection = ee.FeatureCollection(features) + + def smap_ts_feature(feature): + area = feature.geometry() + # create the image collection + collection = ( + ee.ImageCollection("NASA_USDA/HSL/SMAP_soil_moisture") + .filterBounds(area) + .filterDate(start, end) + .select(["ssm", "susm", "smp", "ssma", "susma"]) + ) + + def smap_ts_image(img): + # scale (int) Default: 30 + scale = 30 + # extract date from the image + dateinfo = ee.Date(img.get("system:time_start")).format("YYYY-MM-dd") + # reduce the region to a list, can be configured as per requirements + img = img.reduceRegion( + reducer=ee.Reducer.toList(), + geometry=area, + maxPixels=1e8, + scale=scale, + ) + # store data in an ee.Array + ssm = ee.Array(img.get("ssm")) + susm = ee.Array(img.get("susm")) + smp = ee.Array(img.get("smp")) + ssma = ee.Array(img.get("ssma")) + susma = ee.Array(img.get("susma")) + tmpfeature = ( + ee.Feature(ee.Geometry.Point([0, 0])) + .set("ssm", ssm) + .set("susm", susm) + .set("smp", smp) + .set("ssma", ssma) + .set("susma", susma) + .set("dateinfo", dateinfo) + ) + return tmpfeature + + # map tmpfeature over the image collection + smap_timeseries = collection.map(smap_ts_image) + return ( + feature.set("ssm", smap_timeseries.aggregate_array("ssm")) + .set("susm", smap_timeseries.aggregate_array("susm")) + .set("smp", smap_timeseries.aggregate_array("smp")) + .set("ssma", smap_timeseries.aggregate_array("ssma")) + .set("susma", smap_timeseries.aggregate_array("susma")) + .set("dateinfo", smap_timeseries.aggregate_array("dateinfo")) + ) + + # map feature over featurecollection + featureCollection = featureCollection.map(smap_ts_feature).getInfo() + return featureCollection + + fc = smap_ts(geo=geo, start=start, end=end) + + def fc2dataframe(fc): + ssm_datalist = [] + susm_datalist = [] + smp_datalist = [] + ssma_datalist = [] + susma_datalist = [] + date_list = [] + # extract var and date data from fc dictionary and store in it in smapdatalist and datelist + for i in range(len(fc["features"][0]["properties"]["ssm"])): + ssm_datalist.append(fc["features"][0]["properties"]["ssm"][i][0]) + susm_datalist.append(fc["features"][0]["properties"]["susm"][i][0]) + smp_datalist.append(fc["features"][0]["properties"]["smp"][i][0]) + ssma_datalist.append(fc["features"][0]["properties"]["ssma"][i][0]) + susma_datalist.append(fc["features"][0]["properties"]["susma"][i][0]) + date_list.append( + str( + datetime.datetime.strptime( + (fc["features"][0]["properties"]["dateinfo"][i]).split(".")[0], + "%Y-%m-%d", + ) + ) + ) + fc_dict = { + "date": date_list, + "ssm": ssm_datalist, + "susm": susm_datalist, + "smp": smp_datalist, + "ssma": ssma_datalist, + "susma": susma_datalist, + } + # create a pandas dataframe and store the data + fcdf = pd.DataFrame( + fc_dict, columns=["date", "ssm", "susm", "smp", "ssma", "susma"] + ) + return fcdf + + datadf = fc2dataframe(fc) + + site_name = get_sitename(geofile) + AOI = get_sitecoord(geofile) + + coords = { + "time": datadf["date"].values, + } + # convert the dataframe to an xarray dataset, used for converting it to a netCDF file + tosave = xr.Dataset( + datadf, coords=coords, attrs={"site_name": site_name, "AOI": AOI,}, + ) + + if siteid is None: + sitedid = site_name + + # # if specified output path does not exist create it + if not os.path.exists(outdir): + os.makedirs(outdir, exist_ok=True) + + timestamp = time.strftime("%y%m%d%H%M%S") + + filepath = os.path.join( + outdir, filename + "_" + timestamp + ".nc" + ) + + # convert to netCDF and save the file + tosave.to_netcdf(filepath) + + return os.path.abspath(filepath) diff --git a/modules/data.remote/inst/RpTools/RpTools/gee_utils.py b/modules/data.remote/inst/RpTools/RpTools/gee_utils.py new file mode 100644 index 00000000000..f156d665e43 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/gee_utils.py @@ -0,0 +1,104 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +GEE utility functions + +Requires Python3 + +Author: Ayush Prasad +""" + +import ee +import geopandas as gpd + + +def create_geo(geofile): + """ + creates a GEE geometry from the input file + + Parameters + ---------- + geofile (str) -- path to the file containing the name and coordinates of ROI, currently tested with geojson. + + Returns + ------- + geo -- object of ee.Geometry type + """ + df = gpd.read_file(geofile) + if (df.geometry.type == "Point").bool(): + # extract coordinates + lon = float(df.geometry.x) + lat = float(df.geometry.y) + # create geometry + geo = ee.Geometry.Point(lon, lat) + + elif (df.geometry.type == "Polygon").bool(): + # extract coordinates + area = [ + list(df.geometry.exterior[row_id].coords) for row_id in range(df.shape[0]) + ] + # create geometry + for i in range(len(area[0])): + area[0][i] = area[0][i][0:2] + geo = ee.Geometry.Polygon(area) + + else: + # if the input geometry type is not + raise ValueError("geometry type not supported") + + return geo + + +def get_sitename(geofile): + """ + extracts AOI name from the input file + + Parameters + ---------- + geofile (str) -- path to the file containing the name and coordinates of ROI, currently tested with geojson. + + Returns + ------- + site_name (str) -- name of the AOI + """ + df = gpd.read_file(geofile) + site_name = df[df.columns[0]].iloc[0] + return site_name + + +def get_sitecoord(geofile): + """ + extracts AOI coordinates from the input file + + Parameters + ---------- + geofile (str) -- path to the file containing the name and coordinates of ROI, currently tested with geojson. + + Returns + ------- + site_aoi (str) -- coordinates of the AOI + """ + df = gpd.read_file(geofile) + site_aoi = str(df[df.columns[1]].iloc[0]) + return site_aoi + +def calc_ndvi(nir, red): + """ + calculates NDVI on GEE + + Parameters + ---------- + nir (str) -- NIR band of the image collection + + red (str) -- RED band of the image collection + + Returns + ------- + image -- with added NDVI band + + """ + def add_ndvi(image): + ndvi = image.normalizedDifference([nir, red]).rename("NDVI") + return image.addBands(ndvi) + return add_ndvi diff --git a/modules/data.remote/inst/RpTools/RpTools/get_remote_data.py b/modules/data.remote/inst/RpTools/RpTools/get_remote_data.py new file mode 100644 index 00000000000..bab35d60d95 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/get_remote_data.py @@ -0,0 +1,98 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +get_remote_data controls GEE and AppEEARS functions to download data. + +Requires Python3 + +Author(s): Ayush Prasad, Istem Fer +""" +from RpTools.merge_files import nc_merge, csv_merge +from importlib import import_module +from . appeears2pecan import appeears2pecan +import os +import os.path + + +def get_remote_data( + geofile, + outdir, + start, + end, + source, + collection, + scale=None, + projection=None, + qc=None, + credfile=None, + raw_merge=None, + existing_raw_file_path=None, + raw_file_name=None +): + """ + uses GEE and AppEEARS functions to download data + + Parameters + ---------- + geofile (str) -- path to the file containing the name and coordinates of ROI, currently tested with geojson. + + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + + start (str) -- starting date of the data request in the form YYYY-MM-DD + + end (str) -- ending date areaof the data request in the form YYYY-MM-DD + + source (str) -- source from where data is to be downloaded + + collection (str) -- dataset or product name as it is provided on the source, e.g. "COPERNICUS/S2_SR" for gee or "SPL3SMP_E.003" for appeears + + scale (int) -- pixel resolution, None by default + + projection (str) -- type of projection. Only required for appeears polygon AOI type. None by default. + + qc (float) -- quality control parameter, None by default + + credfile (str) -- path to credentials file only requried for AppEEARS, None by default + + raw_merge (str) -- if the existing raw file has to be merged, None by default + + existing_raw_file_path (str) -- path to exisiting raw file if raw_merge is TRUE., None by default + + raw_file_name (str) -- filename of the output file + + Returns + ------- + Absolute path to the created file. + output netCDF is saved in the specified directory. + """ + + + if source == "gee": + # construct the function name + func_name = "".join([source, "2pecan", "_", collection]) + # import the module + module_from_pack = "RpTools" + "." + func_name + module = import_module(module_from_pack) + # import the function from the module + func = getattr(module, func_name) + # if a qc parameter is specified pass these arguments to the function + if qc: + get_datareturn_path = func(geofile=geofile, outdir=outdir, start=start, end=end, scale=scale, qc=qc, filename=raw_file_name) + # this part takes care of functions which do not perform any quality checks, e.g. SMAP + else: + get_datareturn_path = func(geofile=geofile, outdir=outdir, start=start, end=end, filename=raw_file_name) + + if source == "appeears": + get_datareturn_path = appeears2pecan(geofile=geofile, outdir=outdir, out_filename=raw_file_name, start=start, end=end, product=collection, projection=projection, credfile=credfile) + + if raw_merge == True and raw_merge != "replace": + # if output file is of csv type use csv_merge, example AppEEARS point AOI type + if os.path.splitext(existing_raw_file_path)[1][1:] == "csv": + get_datareturn_path = csv_merge(existing_raw_file_path, get_datareturn_path, outdir) + # else it must be of netCDF type, use nc_merge + else: + get_datareturn_path = nc_merge(existing_raw_file_path, get_datareturn_path, outdir) + + return get_datareturn_path + diff --git a/modules/data.remote/inst/RpTools/RpTools/merge_files.py b/modules/data.remote/inst/RpTools/RpTools/merge_files.py new file mode 100644 index 00000000000..5d0070237b1 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/merge_files.py @@ -0,0 +1,80 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +Used to merge netCDF and CSV files +Author: Ayush Prasad +""" + +import xarray +import os +import time +import pandas as pd + + +def nc_merge(old, new, outdir): + """ + Merge netCDF files. + Order in which the files are specified in the function does not matter. + + Parameters + ---------- + old (str) -- path to the first netCDF file + new (str) -- path to the second netCDF file + outdir (str) -- path where the merged file has to be stored + Returns + ------- + Absolute path to the merged file + output netCDF file is saved in the specified directory. + """ + # extract the name from the new (second) netCDF file and attach timestamp to it, this will be the name of the output merged file + head, tail = os.path.split(new) + orig_nameof_newfile = new + timestamp = time.strftime("%y%m%d%H%M%S") + changed_new = os.path.join(outdir, tail + "temp" + timestamp + ".nc") + # rename the new file to prevent it from being overwritten + os.rename(orig_nameof_newfile, changed_new) + try: + ds = xarray.open_mfdataset([old, changed_new], combine="by_coords") + ds.to_netcdf(os.path.join(outdir, tail)) + except: + os.remove(old) + return os.path.abspath(os.path.join(outdir, changed_new)) + # delete the old and temproary file + os.remove(changed_new) + os.remove(old) + return os.path.abspath(os.path.join(outdir, tail)) + + +def csv_merge(old, new, outdir): + """ + Merge csv files. + Order in which the files are specified in the function does not matter. + + Parameters + ---------- + old (str) -- path to the first csv file + new (str) -- path to the second csv file + outdir (str) -- path where the merged file has to be stored + Returns + ------- + Absolute path to the merged file + output csv file is saved in the specified directory. + """ + + # extract the name from the new (second) csv file and attach timestamp to it, this will be the name of the output merged file + head, tail = os.path.split(new) + orig_nameof_newfile = new + timestamp = time.strftime("%y%m%d%H%M%S") + changed_new = os.path.join(outdir, tail + "temp" + timestamp + ".csv") + # rename the new file to prevent it from being overwritten + os.rename(orig_nameof_newfile, changed_new) + df_old = pd.read_csv(old) + df_changed_new = pd.read_csv(changed_new) + merged_df = pd.concat([df_old, df_changed_new]) + merged_df = merged_df.sort_values(by="Date") + merged_df.to_csv(os.path.join(outdir, tail), index=False) + # delete the old and temproary file + os.remove(changed_new) + os.remove(old) + return os.path.abspath(os.path.join(outdir, tail)) diff --git a/modules/data.remote/inst/RpTools/RpTools/process_remote_data.py b/modules/data.remote/inst/RpTools/RpTools/process_remote_data.py new file mode 100644 index 00000000000..a337d221474 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/process_remote_data.py @@ -0,0 +1,57 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +process_remote_data controls functions which perform further computation on the data. +Requires Python3 +Author: Ayush Prasad +""" +from RpTools.merge_files import nc_merge +from importlib import import_module +import os +import time + +def process_remote_data(out_get_data, out_process_data, outdir, lat, lon, algorithm, input_file, pro_merge=None, existing_pro_file_path=None, pro_file_name=None): + """ + uses processing functions to perform computation on input data + + Parameters + ---------- + output (dict) -- dictionary contatining the keys get_data and process_data + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + lat (float) -- latitude of the site + lon (float) -- longitude of the site + algorithm (str) -- name of the algorithm used to perform computation. + inputfile (str) -- path to raw file + pro_merge (str) -- if the pro file has to be merged + existing_pro_file_path (str) -- path to existing pro file if pro_merge is TRUE + pro_file_name (str) -- name of the output file + + Returns + ------- + Absolute path to the output file + + output netCDF is saved in the specified directory. + """ + + + # get the type of the input data + input_type = out_get_data + # extract the computation which is to be done + output = out_process_data + # construct the function name + func_name = "".join([input_type, "2", output, "_", algorithm]) + # import the module + module_from_pack = "RpTools" + "." + func_name + module = import_module(module_from_pack) + # import the function from the module + func = getattr(module, func_name) + # call the function + process_datareturn_path = func(input_file, outdir, lat, lon, pro_file_name) + + if pro_merge == True and pro_merge != "replace": + try: + process_datareturn_path = nc_merge(existing_pro_file_path, process_datareturn_path, outdir) + except: + print(existing_pro_file_path) + return process_datareturn_path diff --git a/modules/data.remote/inst/RpTools/RpTools/rp_control.py b/modules/data.remote/inst/RpTools/RpTools/rp_control.py new file mode 100644 index 00000000000..561898c7339 --- /dev/null +++ b/modules/data.remote/inst/RpTools/RpTools/rp_control.py @@ -0,0 +1,159 @@ +#!/usr/bin/env python3 +# -*- coding: utf-8 -*- + +""" +rp_control manages the individual functions to create an automatic workflow for downloading and performing computation on remote sensing data. + +Requires Python3 + +Author(s): Ayush Prasad, Istem Fer +""" +from . merge_files import nc_merge, csv_merge +from . get_remote_data import get_remote_data +from . process_remote_data import process_remote_data +from . gee_utils import get_sitename +from . create_geojson import create_geojson + + +def rp_control( + coords, + outdir, + lat, + lon, + start, + end, + source, + collection, + siteid=None, + scale=None, + projection=None, + qc=None, + algorithm=None, + input_file=None, + credfile=None, + out_get_data=None, + out_process_data=None, + stage_get_data=None, + stage_process_data=None, + raw_merge=None, + pro_merge=None, + existing_raw_file_path=None, + existing_pro_file_path=None, + raw_file_name=None, + pro_file_name=None, +): + + """ + Controls get_remote_data() and process_remote_data() to download and process remote sensing data. + + Parameters + ---------- + coords (str) -- geometry of the site from BETY + + outdir (str) -- path to the directory where the output file is stored. If specified directory does not exists, it is created. + + lat (float) -- latitude of the site + + lon (float) -- longitude of the site + + start (str) -- starting date of the data request in the form YYYY-MM-DD + + end (str) -- ending date area of the data request in the form YYYY-MM-DD + + source (str) -- source from where data is to be downloaded, e.g. "gee" or "appeears" + + collection (str) -- dataset or product name as it is provided on the source, e.g. "COPERNICUS/S2_SR" for gee or "SPL3SMP_E.003" for appeears + + siteid(str) -- short form of the siteid , None by default + + scale (int) -- pixel resolution, None by default, recommended to use 10 for Sentinel 2 , None by default + + projection (str) -- type of projection. Only required for appeears polygon AOI type. None by default. + + qc (float) -- quality control parameter, only required for gee queries, None by default + + algorithm (str) -- algorithm used for processing data in process_data(), currently only SNAP is implemented to estimate LAI from Sentinel-2 bands, None by default + + credfile (str) -- path to JSON file containing Earthdata username and password, only required for AppEEARS, None by default + + out_get_data (str) -- the type of output variable requested from get_data module , None by default + + out_process_data (str) -- the type of output variable requested from process_data module, None by default + + stage_get_data (str) -- stage for get_data module, None by default + + stage_process_data (str) -- stage for process_data_module, None by default + + raw_merge (str) -- if raw file has to be merged, None by default + + pro_merge (str) -- if pro file has to be merged, None by default + + existing_raw_file_path (str) -- path to existing raw file , None by default + + existing_pro_file_path (str) -- path to existing pro file path, None by default + + raw_file_name (str) -- filename of the raw file, None by default + + pro_file_name (str) -- filename of the processed file, None by default + + Returns + ------- + dictionary containing raw_id, raw_path, pro_id, pro_path + + """ + + out_get_data = out_get_data.lower() + + if out_process_data: + out_process_data = out_process_data.lower() + + + if stage_get_data: + + # create GeoJSOn file from the BETY sites data + geofile = create_geojson(coords, siteid, outdir) + + get_datareturn_path = get_remote_data( + geofile, + outdir, + start, + end, + source, + collection, + scale, + projection, + qc, + credfile, + raw_merge, + existing_raw_file_path, + raw_file_name + ) + + if stage_process_data: + if input_file is None: + input_file = get_datareturn_path + process_datareturn_path = process_remote_data( + out_get_data, + out_process_data, + outdir, + lat, + lon, + algorithm, + input_file, + pro_merge, + existing_pro_file_path, + pro_file_name + ) + + output = { + "raw_data_path": None, + "process_data_path": None, + } + + if stage_get_data: + output["raw_data_path"] = get_datareturn_path + + if stage_process_data: + output["process_data_path"] = process_datareturn_path + + return output diff --git a/modules/data.remote/inst/RpTools/setup.py b/modules/data.remote/inst/RpTools/setup.py new file mode 100644 index 00000000000..cddd3193f60 --- /dev/null +++ b/modules/data.remote/inst/RpTools/setup.py @@ -0,0 +1,67 @@ +from setuptools import setup + +setup( + name="RpTools", + version="0.1", + description="RpTools contains the Python codes required by PEcAn's remote data module", + # url=' ', + author="Ayush Prasad", + author_email="ayush.prd@gmail.com", + license="University of Illinois/NCSA Open Source License", + packages=["RpTools"], + install_requires=[ + "attrs>=19.3.0", + "cachetools>=4.1.1", + "certifi>=2020.6.20", + "cffi>=1.14.1", + "chardet>=3.0.4", + "click>=7.1.2", + "click-plugins>=1.1.1", + "cligj>=0.5.0", + "cryptography>=1.7.1", + "dask>=2.6.0", + "earthengine-api>=0.1.229", + "Fiona>=1.8.13.post1", + "future>=0.18.2", + "geopandas>=0.8.1", + "google-api-core>=1.22.0", + "google-api-python-client>=1.10.0", + "google-auth>=1.20.0", + "google-auth-httplib2>=0.0.4", + "google-cloud-core>=1.3.0", + "google-cloud-storage>=1.30.0", + "google-crc32c>=0.1.0", + "google-resumable-media>=0.7.0", + "googleapis-common-protos>=1.52.0", + "httplib2>=0.18.1", + "httplib2shim>=0.0.3", + "idna>=2.10", + "keyring>=10.1", + "keyrings.alt>=1.3", + "munch>=2.5.0", + "numpy>=1.18.5", + "pandas>=0.25.3", + "protobuf>=3.12.4", + "pyasn1>=0.4.8", + "pyasn1-modules>=0.2.8", + "pycparser>=2.20", + "pycrypto>=2.6.1", + "pygobject>=3.22.0", + "pyproj>=2.6.1.post1", + "python-dateutil>=2.8.1", + "pytz>=2020.1", + "pyxdg>=0.25", + "requests>=2.24.0", + "rsa>=4.6", + "scipy>=1.4.1", + "SecretStorage>=2.3.1", + "Shapely>=1.7.0", + "six>=1.10.0", + "toolz>=0.10.0", + "uritemplate>=3.0.1", + "urllib3>=1.25.10", + "xarray>=0.13.0", + "geojson>=2.5.0", + ], + # zip_safe=False +) diff --git a/modules/data.remote/inst/download_SMAP_gee2pecan.R b/modules/data.remote/inst/download_SMAP_gee2pecan.R new file mode 100644 index 00000000000..90bb9408aa0 --- /dev/null +++ b/modules/data.remote/inst/download_SMAP_gee2pecan.R @@ -0,0 +1,107 @@ +##'@name download_SMAP_gee2pecan +##'@description: +##'Download SMAP data from GEE by date and site location +##' +##'Requires python3 and earthengine-api. +##'Untill 'gee2pecan_smap' is integrated into PEcAn workflow, +##'follow GEE registration 'Installation Instructions' here: +##'https://github.com/PecanProject/pecan/pull/2645 +##' +##'@param start start date as YYYY-mm-dd (chr) +##'@param end end date YYYY-mm-dd (chr) +##'@param site_id Bety site location id number(s) +##'@param geoJSON_outdir directory to store site GeoJSON, must be the location same as 'gee2pecan_smap.py' +##'@param smap_outdir directory to store netCDF file of SMAP data, if directory folder does not exist it will be created +##'@return data.frame of SMAP data w/ Date, NA's filling missing data +##' +##' +##'@authors Juliette Bateman, Ayush Prasad (gee2pecan_smap.py) +##' +##'@examples +##'\dontrun{ +##'test <- download_SMAP_gee2pecan( +##' start = "2019-11-01", +##' end = "2019-11-10", +##' site_id = 676, +##' geoJSON_outdir = "/fs/data3/jbateman/pecan/modules/data.remote/inst", +##' smap_outdir = "/fs/data3/jbateman/pecan/modules/data.remote/inst") +##'} + + +download_SMAP_gee2pecan <- function(start, end, + site_id, + geoJSON_outdir, smap_outdir) { + + + #################### Connect to BETY #################### + + bety <- list(user='bety', password='bety', host='localhost', + dbname='bety', driver='PostgreSQL',write=TRUE) + con <- PEcAn.DB::db.open(bety) + bety$con <- con + site_ID <- as.character(site_id) + suppressWarnings(site_qry <- glue::glue_sql("SELECT *, ST_X(ST_CENTROID(geometry)) AS lon, + ST_Y(ST_CENTROID(geometry)) AS lat FROM sites WHERE id IN ({ids*})", + ids = site_ID, .con = con)) + suppressWarnings(qry_results <- DBI::dbSendQuery(con,site_qry)) + suppressWarnings(qry_results <- DBI::dbFetch(qry_results)) + site_info <- list(site_id=qry_results$id, site_name=qry_results$sitename, lat=qry_results$lat, + lon=qry_results$lon, time_zone=qry_results$time_zone) + + + #################### Begin Data Extraction #################### + + # Create geoJSON file for site + site_GeoJSON <- data.frame(site_info$lon, site_info$lat) %>% + setNames(c("lon","lat")) %>% + leafletR::toGeoJSON(name = site_info$site_name, dest = geoJSON_outdir, overwrite = TRUE) %>% + rgdal::readOGR() + site_GeoJSON$name = site_info$site_name + site_GeoJSON = site_GeoJSON[-1] %>% + leafletR::toGeoJSON(name = site_info$site_name, dest = geoJSON_outdir, overwrite = TRUE) + + # Locate gee2pecan_smap.py function and load into R + script.path = file.path(system.file("gee2pecan_smap.py", package = "PEcAn.data.remote")) + reticulate::source_python(script.path) + + # Run gee2pecan_smap function + smap.out = gee2pecan_smap(geofile = site_GeoJSON, outdir = smap_outdir, start = start, end = end, var = var) + output = ncdf4::nc_open(paste0(site_info$site_name,"_smap", ".nc")) + smap.data = cbind((ncdf4::ncvar_get(output, "date")), ncdf4::ncvar_get(output, "ssm"), ncdf4::ncvar_get(output,"susm"), ncdf4::ncvar_get(output, "smp"), ncdf4::ncvar_get(output, "ssma"), ncdf4::ncvar_get(output,"susma")) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + setNames(c("Date", "ssm", "susm", "smp", "ssma", "susma")) %>% + dplyr::mutate(Date = as.Date(Date)) %>% + dplyr::mutate_if(is.character, as.numeric) %>% + tidyr::complete(Date = seq.Date(as.Date(start), as.Date(end), by="day")) + + + + #################### Convert to % Soil Moisture #################### + + ## If variable is ssm or susm, must convert unit from mm --> % + # SSM (surface soil moisture) represents top 0-5cm (50mm) of soil + smap.data$ssm.vol = unlist((smap.data[,2] / 50) * 100) %>% as.numeric() + # SUSM (subsurface soil moisture) represents top 0-100 cm (1000mm) of soil + smap.data$susm.vol = unlist((smap.data[,2] / 1000) * 100) %>% as.numeric() + + + + #################### Date Entry Parameter Check #################### + + ## Check if there is data for the date range entered + if (all(is.na(smap.data[-1])) == TRUE) { + + PEcAn.logger::logger.error( + "There are no SMAP data observations for this date range (", start, " to ", end, + "), Please choose another date range. (SMAP data is not available before 2015-04-01.)") + + } else if (any(is.na(smap.data)) == TRUE) { + + ## NOTE: SMAP collects data every ~2-3 days. Missing observations are expected. + PEcAn.logger::logger.warn( + "WARNING: There are some missing SMAP observations during this date range (", start, " to ", end, ").") + + return(smap.data) } + +} + diff --git a/modules/data.remote/inst/registration/register.APPEEARS.xml b/modules/data.remote/inst/registration/register.APPEEARS.xml new file mode 100644 index 00000000000..69bace69d80 --- /dev/null +++ b/modules/data.remote/inst/registration/register.APPEEARS.xml @@ -0,0 +1,12 @@ + + + + polygon + point + + + + + application/x-netcdf + + diff --git a/modules/data.remote/inst/registration/register.GEE.xml b/modules/data.remote/inst/registration/register.GEE.xml new file mode 100644 index 00000000000..680d1b0100e --- /dev/null +++ b/modules/data.remote/inst/registration/register.GEE.xml @@ -0,0 +1,51 @@ + + + + COPERNICUS/S2_SR + s2 + + polygon + point + + 10 + 1 + + 1000000129 + Remote_generic + application/x-netcdf + + + 1000000129 + Remote_generic + application/x-netcdf + + + + LANDSAT/LC08/C01/T1_SR + l8 + 30 + 1 + + polygon + point + + + + + application/x-netcdf + + + + NASA_USDA/HSL/SMAP_soil_moisture + smap + + polygon + point + + + + + application/x-netcdf + + + diff --git a/modules/data.remote/inst/test.geojson b/modules/data.remote/inst/test.geojson new file mode 100644 index 00000000000..9a890595d4c --- /dev/null +++ b/modules/data.remote/inst/test.geojson @@ -0,0 +1,38 @@ +{ + "type": "FeatureCollection", + "features": [ + { + "type": "Feature", + "properties": { + "name": "Reykjavik" + }, + "geometry": { + "type": "Polygon", + "coordinates": [ + [ + [ + -21.788935661315918, + 64.04460250271562 + ], + [ + -21.786317825317383, + 64.04460250271562 + ], + [ + -21.786317825317383, + 64.04537258754581 + ], + [ + -21.788935661315918, + 64.04537258754581 + ], + [ + -21.788935661315918, + 64.04460250271562 + ] + ] + ] + } + } + ] +} diff --git a/modules/data.remote/man/call_MODIS.Rd b/modules/data.remote/man/call_MODIS.Rd index 834e4069151..52fc0422110 100644 --- a/modules/data.remote/man/call_MODIS.Rd +++ b/modules/data.remote/man/call_MODIS.Rd @@ -4,34 +4,52 @@ \alias{call_MODIS} \title{call_MODIS} \usage{ -call_MODIS(outfolder = ".", start_date, end_date, lat, lon, size = 0, - product, band, band_qc = "", band_sd = "", - package_method = "MODISTools") +call_MODIS( + var, + product, + band, + site_info, + product_dates, + outdir = NULL, + run_parallel = FALSE, + ncores = NULL, + package_method = "MODISTools", + QC_filter = FALSE, + progress = FALSE +) } \arguments{ -\item{outfolder}{where the output file will be stored} +\item{var}{the simple name of the modis dataset variable (e.g. lai)} -\item{start_date}{string value for beginning of date range for download in unambiguous date format (YYYYJJJ)} +\item{product}{string value for MODIS product number} -\item{end_date}{string value for end of date range for download in unambiguous date format (YYYYJJJ)} +\item{band}{string value for which measurement to extract} -\item{lat}{Latitude of the pixel} +\item{site_info}{Bety list of site info for parsing MODIS data: list(site_id, site_name, lat, +lon, time_zone)} -\item{lon}{Longitude of the pixel} +\item{product_dates}{a character vector of the start and end date of the data in YYYYJJJ} -\item{size}{kmAboveBelow and kmLeftRight distance in km to be included} +\item{outdir}{where the output file will be stored. Default is NULL and in this case only values are returned. When path is provided values are returned and written to disk.} -\item{product}{string value for MODIS product number} +\item{run_parallel}{optional method to download data paralleize. Only works if more than 1 +site is needed and there are >1 CPUs available.} -\item{band}{string value for which measurement to extract} +\item{ncores}{number of cpus to use if run_parallel is set to TRUE. If you do not know the +number of CPU's available, enter NULL.} -\item{band_qc}{string value for which quality control band, or use "NA" if you do not know or do not need QC information (optional)} +\item{package_method}{string value to inform function of which package method to use to download +modis data. Either "MODISTools" or "reticulate" (optional)} -\item{band_sd}{string value for which standard deviation band, or use "NA" if you do not know or do not need StdDev information (optional)} +\item{QC_filter}{Converts QC values of band and keeps only data values that are excellent or good +(as described by MODIS documentation), and removes all bad values. qc_band must be supplied for this +parameter to work. Default is False. Only MODISTools option.} -\item{package_method}{string value to inform function of which package method to use to download modis data. Either "MODISTools" or "reticulate" (optional) +\item{progress}{TRUE reports the download progress bar of the dataset, FALSE omits the download +progress bar. Default is TRUE. Only MODISTools option. -depends on a number of Python libraries. sudo -H pip install numpy suds netCDF4 json +Requires Python3 for reticulate method option. There are a number of required python libraries. +sudo -H pip install numpy suds netCDF4 json depends on the MODISTools package version 1.1.0} } \description{ @@ -39,11 +57,25 @@ Get MODIS data by date and location } \examples{ \dontrun{ -test_modistools <- call_MODIS(product = "MOD15A2H", band = "Lai_500m", start_date = "2004300", end_date = "2004365", lat = 38, lon = -123, size = 0, band_qc = "FparLai_QC", band_sd = "LaiStdDev_500m", package_method = "MODISTools") -plot(lubridate::yday(test_modistools$calendar_date), test_modistools$data, type = 'l', xlab = "day of year", ylab = test_modistools$band[1]) -test_reticulate <- call_MODIS(product = "MOD15A2H", band = "Lai_500m", start_date = "2004300", end_date = "2004365", lat = 38, lon = -123, size = 0, band_qc = "",band_sd = "", package_method = "reticulate") +site_info <- list( + site_id = 1, + site_name = "test", + lat = 44, + lon = 90, + time_zone = "UTC") +test_modistools <- call_MODIS( + var = "lai", + product = "MOD15A2H", + band = "Lai_500m", + site_info = site_info, + product_dates = c("2001150", "2001365"), + outdir = NULL, + run_parallel = TRUE, + ncores = NULL, + package_method = "MODISTools", + QC_filter = TRUE, + progress = FALSE) } - } \author{ Bailey Morrison diff --git a/modules/data.remote/man/construct_remotedata_filename.Rd b/modules/data.remote/man/construct_remotedata_filename.Rd new file mode 100644 index 00000000000..ae8149535cc --- /dev/null +++ b/modules/data.remote/man/construct_remotedata_filename.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remote_process.R +\name{construct_remotedata_filename} +\alias{construct_remotedata_filename} +\title{construct_remotedata_filename} +\usage{ +construct_remotedata_filename( + source, + collection, + siteid, + scale = NULL, + projection = NULL, + qc = NULL, + algorithm = NULL, + out_process_data = NULL +) +} +\arguments{ +\item{source}{source} + +\item{collection}{collection or product requested from the source} + +\item{siteid}{shortform of siteid} + +\item{scale}{scale, NULL by default} + +\item{projection}{projection, NULL by default} + +\item{qc}{qc_parameter, NULL by default} + +\item{algorithm}{algorithm name to process data, NULL by default} + +\item{out_process_data}{variable name requested for the processed file, NULL by default} +} +\value{ +remotedata_file_names +} +\description{ +construct remotedata module file names +} +\examples{ +\dontrun{ +remotedata_file_names <- construct_remotedata_filename( + source="gee", + collection="s2", + siteid="0-721", + scale=10.0 + projection=NULL + qc=1.0, + algorithm="snap", + out_process_data="lai") +} +} +\author{ +Ayush Prasad +} diff --git a/modules/data.remote/man/download.LandTrendr.AGB.Rd b/modules/data.remote/man/download.LandTrendr.AGB.Rd index dc5b0d1baf3..a1021f109b4 100644 --- a/modules/data.remote/man/download.LandTrendr.AGB.Rd +++ b/modules/data.remote/man/download.LandTrendr.AGB.Rd @@ -4,9 +4,16 @@ \alias{download.LandTrendr.AGB} \title{download.LandTrendr.AGB} \usage{ -download.LandTrendr.AGB(outdir, target_dataset = "biomass", - product_dates = NULL, product_version = "v1", con = NULL, - run_parallel = TRUE, ncores = NULL, overwrite = FALSE) +download.LandTrendr.AGB( + outdir, + target_dataset = "biomass", + product_dates = NULL, + product_version = "v1", + con = NULL, + run_parallel = TRUE, + ncores = NULL, + overwrite = FALSE +) } \arguments{ \item{outdir}{Where to place output} diff --git a/modules/data.remote/man/download.thredds.AGB.Rd b/modules/data.remote/man/download.thredds.AGB.Rd new file mode 100644 index 00000000000..79efcce9998 --- /dev/null +++ b/modules/data.remote/man/download.thredds.AGB.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download.thredds.R +\name{download.thredds.AGB} +\alias{download.thredds.AGB} +\title{download.thredds.AGB} +\usage{ +download.thredds.AGB( + outdir = NULL, + site_ids, + run_parallel = FALSE, + ncores = NULL +) +} +\arguments{ +\item{outdir}{Where to place output} + +\item{site_ids}{What locations to download data at?} + +\item{run_parallel}{Logical. Download and extract files in parallel?} + +\item{ncores}{Optional. If run_parallel=TRUE how many cores to use? If left as NULL will select max number -1} +} +\value{ +data.frame summarize the results of the function call +} +\description{ +download.thredds.AGB +} +\examples{ +\dontrun{ +outdir <- "~/scratch/abg_data/" +results <- PEcAn.data.remote::download.thredds.AGB(outdir=outdir, + site_ids = c(676, 678, 679, 755, 767, 1000000030, 1000000145, 1000025731), + run_parallel = TRUE, ncores = 8) +} +} +\author{ +Bailey Morrison +} diff --git a/modules/data.remote/man/extract.LandTrendr.AGB.Rd b/modules/data.remote/man/extract.LandTrendr.AGB.Rd index 6807af3ac88..69e946fd7a5 100644 --- a/modules/data.remote/man/extract.LandTrendr.AGB.Rd +++ b/modules/data.remote/man/extract.LandTrendr.AGB.Rd @@ -4,9 +4,16 @@ \alias{extract.LandTrendr.AGB} \title{extract.LandTrendr.AGB} \usage{ -extract.LandTrendr.AGB(site_info, dataset = "median", buffer = NULL, - fun = "mean", data_dir = NULL, product_dates = NULL, - output_file = NULL, ...) +extract.LandTrendr.AGB( + site_info, + dataset = "median", + buffer = NULL, + fun = "mean", + data_dir = NULL, + product_dates = NULL, + output_file = NULL, + ... +) } \arguments{ \item{site_info}{list of site info for parsing AGB data: list(site_id, site_name, lat, lon, time_zone)} @@ -28,8 +35,11 @@ output extraction list (see return)} \value{ list of two containing the median AGB values per pixel and the corresponding standard deviation values (uncertainties) - -##' @examples +} +\description{ +extract.LandTrendr.AGB +} +\examples{ \dontrun{ # Example 1 - using BETYdb site IDs to extract data @@ -53,9 +63,7 @@ results <- extract.LandTrendr.AGB(site_info, "median", buffer = NULL, fun = "mea data_dir, product_dates, output_file) } -} -\description{ -extract.LandTrendr.AGB + } \author{ Shawn Serbin, Alexey Shiklomanov diff --git a/modules/data.remote/man/extract_NLCD.Rd b/modules/data.remote/man/extract_NLCD.Rd index 34c85c46c9b..95036a6db4d 100644 --- a/modules/data.remote/man/extract_NLCD.Rd +++ b/modules/data.remote/man/extract_NLCD.Rd @@ -4,8 +4,7 @@ \alias{extract_NLCD} \title{extract.NLCD} \usage{ -extract_NLCD(buffer, coords, data_dir = NULL, con = NULL, - year = 2011) +extract_NLCD(buffer, coords, data_dir = NULL, con = NULL, year = 2011) } \arguments{ \item{buffer}{search radius (meters)} diff --git a/modules/data.remote/man/read_remote_registry.Rd b/modules/data.remote/man/read_remote_registry.Rd new file mode 100644 index 00000000000..a9668ab7b8a --- /dev/null +++ b/modules/data.remote/man/read_remote_registry.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remote_process.R +\name{read_remote_registry} +\alias{read_remote_registry} +\title{read_remote_registry} +\usage{ +read_remote_registry(source, collection) +} +\arguments{ +\item{source}{remote source, e.g gee or appeears} + +\item{collection}{collection or product name} +} +\value{ +list containing original_name, pecan_name, scale, qc, projection raw_mimetype, raw_formatname pro_mimetype, pro_formatname, coordtype +} +\description{ +read remote module registration files +} +\examples{ +\dontrun{ + read_remote_registry( + "gee", + "COPERNICUS/S2_SR") +} +} +\author{ +Istem Fer +} diff --git a/modules/data.remote/man/remote_process.Rd b/modules/data.remote/man/remote_process.Rd new file mode 100644 index 00000000000..5a1724f46f0 --- /dev/null +++ b/modules/data.remote/man/remote_process.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remote_process.R +\name{remote_process} +\alias{remote_process} +\title{remote_process} +\usage{ +remote_process(settings) +} +\arguments{ +\item{settings}{PEcAn settings list containing remotedata tags: source, collection, scale, projection, qc, algorithm, credfile, out_get_data, out_process_data, overwrite} +} +\description{ +call rp_control (from RpTools Python package) and store the output in BETY +} +\examples{ +\dontrun{ +remote_process(settings) +} +} +\author{ +Ayush Prasad, Istem Fer +} diff --git a/modules/data.remote/man/remotedata_db_check.Rd b/modules/data.remote/man/remotedata_db_check.Rd new file mode 100644 index 00000000000..c6b71d4861d --- /dev/null +++ b/modules/data.remote/man/remotedata_db_check.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remote_process.R +\name{remotedata_db_check} +\alias{remotedata_db_check} +\title{remotedata_db_check} +\usage{ +remotedata_db_check( + raw_file_name, + pro_file_name, + start, + end, + siteid, + siteid_short, + out_get_data, + algorithm, + out_process_data, + overwrite, + dbcon +) +} +\arguments{ +\item{raw_file_name}{raw_file_name} + +\item{pro_file_name}{pro_file_name} + +\item{start}{start date requested by user} + +\item{end}{end date requested by the user} + +\item{siteid}{siteid of the site} + +\item{siteid_short}{short form of the siteid} + +\item{out_get_data}{out_get_data} + +\item{algorithm}{algorithm} + +\item{out_process_data}{out_process_data} + +\item{overwrite}{overwrite} + +\item{dbcon}{BETYdb con} +} +\value{ +list containing remotefile_check_flag, start, end, stage_get_data, write_raw_start, write_raw_end, raw_merge, existing_raw_file_path, stage_process_data, write_pro_start, write_pro_end, pro_merge, input_file, existing_pro_file_path, raw_check, pro_check +} +\description{ +check the status of the requested data in the DB +} +\examples{ +\dontrun{ +dbstatus <- remotedata_db_check( + raw_file_name, + pro_file_name, + start, + end, + siteid, + siteid_short, + out_get_data, + algorithm, + out_process_data, + overwrite + dbcon) +} +} +\author{ +Ayush Prasad +} diff --git a/modules/data.remote/man/remotedata_db_insert.Rd b/modules/data.remote/man/remotedata_db_insert.Rd new file mode 100644 index 00000000000..6527a041a10 --- /dev/null +++ b/modules/data.remote/man/remotedata_db_insert.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remote_process.R +\name{remotedata_db_insert} +\alias{remotedata_db_insert} +\title{Insert the output data returned from rp_control into BETYdb} +\usage{ +remotedata_db_insert( + output, + remotefile_check_flag, + siteid, + out_get_data, + out_process_data, + write_raw_start, + write_raw_end, + write_pro_start, + write_pro_end, + raw_check, + pro_check, + raw_mimetype, + raw_formatname, + pro_mimetype, + pro_formatname, + dbcon +) +} +\arguments{ +\item{output}{output list from rp_control} + +\item{remotefile_check_flag}{remotefile_check_flag} + +\item{siteid}{siteid} + +\item{out_get_data}{out_get_data} + +\item{out_process_data}{out_process_data} + +\item{write_raw_start}{write_raw_start, start date of the raw file} + +\item{write_raw_end}{write_raw_end, end date of the raw file} + +\item{write_pro_start}{write_pro_start} + +\item{write_pro_end}{write_pro_end} + +\item{raw_check}{id, site_id, name, start_date, end_date, of the existing raw file from inputs table and file_path from dbfiles tables} + +\item{pro_check}{pro_check id, site_id, name, start_date, end_date, of the existing processed file from inputs table and file_path from dbfiles tables} + +\item{raw_mimetype}{raw_mimetype} + +\item{raw_formatname}{raw_formatname} + +\item{pro_mimetype}{pro_mimetype} + +\item{pro_formatname}{pro_formatname} + +\item{dbcon}{BETYdb con} +} +\value{ +list containing raw_id, raw_path, pro_id, pro_path +} +\description{ +Insert the output data returned from rp_control into BETYdb +} +\examples{ +\dontrun{ +db_out <- remotedata_db_insert( + output, + remotefile_check_flag, + siteid, + out_get_data, + out_process_data, + write_raw_start, + write_raw_end, + write_pro_start, + write_pro_end, + raw_check, + pro_check + raw_mimetype, + raw_formatname, + pro_mimetype, + pro_formatname, + dbcon) +} +} +\author{ +Ayush Prasad +} diff --git a/modules/data.remote/man/set_stage.Rd b/modules/data.remote/man/set_stage.Rd new file mode 100644 index 00000000000..23b787f4646 --- /dev/null +++ b/modules/data.remote/man/set_stage.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remote_process.R +\name{set_stage} +\alias{set_stage} +\title{set_stage} +\usage{ +set_stage(result, req_start, req_end, stage) +} +\arguments{ +\item{result}{dataframe containing id, site_id, name, start_date, end_date from inputs table and file_path from dbfiles table} + +\item{req_start}{start date requested by the user} + +\item{req_end}{end date requested by the user} + +\item{stage}{the stage which needs to be set, get_remote_data or process_remote_data} +} +\value{ +list containing req_start, req_end, stage, merge, write_start, write_end +} +\description{ +set dates, stage and merge status for remote data download +} +\examples{ +\dontrun{ +raw_check <- set_stage( + result, + req_start, + req_end, + get_remote_data) +} +} +\author{ +Ayush Prasad +} diff --git a/modules/data.remote/tests/Rcheck_reference.log b/modules/data.remote/tests/Rcheck_reference.log new file mode 100644 index 00000000000..9eb4315aaf8 --- /dev/null +++ b/modules/data.remote/tests/Rcheck_reference.log @@ -0,0 +1,113 @@ +* using log directory ‘/tmp/RtmpYVm4R4/PEcAn.data.remote.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.data.remote/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.data.remote’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.data.remote’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'::' or ':::' imports not declared from: + ‘DBI’ ‘doParallel’ ‘foreach’ ‘glue’ ‘lubridate’ ‘ncdf4’ ‘PEcAn.DB’ + ‘PEcAn.utils’ ‘purrr’ ‘raster’ ‘RCurl’ ‘sp’ +'library' or 'require' calls not declared from: + ‘doParallel’ ‘PEcAn.DB’ ‘raster’ +'library' or 'require' calls in package code: + ‘doParallel’ ‘PEcAn.DB’ ‘raster’ ‘rgdal’ + Please use :: or requireNamespace() instead. + See section 'Suggested packages' in the 'Writing R Extensions' manual. +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +call_MODIS: no visible global function definition for ‘write.csv’ +call_MODIS: no visible global function definition for + ‘extract_modis_data’ +download.LandTrendr.AGB: no visible binding for global variable ‘k’ +download.NLCD: no visible global function definition for ‘dbfile.check’ +download.NLCD: no visible global function definition for ‘db.query’ +download.NLCD: no visible global function definition for + ‘download.file’ +download.NLCD: no visible global function definition for + ‘dbfile.insert’ +download.thredds.AGB : get_data: no visible global function definition + for ‘write.csv’ +download.thredds.AGB: no visible global function definition for + ‘%dopar%’ +download.thredds.AGB: no visible global function definition for + ‘foreach’ +download.thredds.AGB: no visible global function definition for + ‘stopCluster’ +extract_NLCD: no visible global function definition for ‘dbfile.check’ +extract_NLCD: no visible global function definition for ‘db.query’ +extract_NLCD: no visible global function definition for ‘raster’ +extract_NLCD: no visible global function definition for ‘SpatialPoints’ +extract_NLCD: no visible global function definition for ‘CRS’ +extract_NLCD: no visible global function definition for ‘spTransform’ +extract_NLCD: no visible global function definition for ‘crs’ +extract_NLCD: no visible global function definition for ‘extract’ +Undefined global functions or variables: + %dopar% crs CRS db.query dbfile.check dbfile.insert download.file + extract extract_modis_data foreach k raster SpatialPoints spTransform + stopCluster write.csv +Consider adding + importFrom("utils", "download.file", "write.csv") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... NOTE +Rd file 'call_MODIS.Rd': + \examples lines wider than 100 characters: + test_modistools <- call_MODIS(product = "MOD15A2H", band = "Lai_500m", start_date = "2004300", end_date = "2004365", lat = 38, lon = -1 ... [TRUNCATED] + test_reticulate <- call_MODIS(product = "MOD15A2H", band = "Lai_500m", start_date = "2004300", end_date = "2004365", lat = 38, lon = -1 ... [TRUNCATED] + +These lines will be truncated in the PDF manual. +* checking Rd cross-references ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'extract.LandTrendr.AGB' + ‘...’ + +Undocumented arguments in documentation object 'extract_NLCD' + ‘year’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking examples ... OK +* DONE +Status: 2 WARNINGs, 3 NOTEs diff --git a/modules/emulator/DESCRIPTION b/modules/emulator/DESCRIPTION index 2faca7a3ef4..c5f5a4ad47a 100644 --- a/modules/emulator/DESCRIPTION +++ b/modules/emulator/DESCRIPTION @@ -1,22 +1,24 @@ Package: PEcAn.emulator Type: Package Title: Gausian Process emulator -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze")) Author: Michael Dietze Maintainer: Michael Dietze -Depends: - mvtnorm, - mlegp, - MCMCpack Imports: PEcAn.logger, + methods, + mvtnorm, + mlegp, coda (>= 0.18), - methods + MASS, + TruncatedNormal (>= 2.2), + lqmm, + MCMCpack Description: Implementation of a Gaussian Process model (both likelihood and bayesian approaches) for kriging and model emulation. Includes functions for sampling design and prediction. -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/emulator/NAMESPACE b/modules/emulator/NAMESPACE index 421d54566ae..17ac0da54c5 100644 --- a/modules/emulator/NAMESPACE +++ b/modules/emulator/NAMESPACE @@ -35,3 +35,5 @@ export(nderiv) export(p) export(plot.jump) export(summarize.GP) +exportClasses(jump) +exportClasses(mvjump) diff --git a/modules/emulator/R/GaussProcess.R b/modules/emulator/R/GaussProcess.R index b85eff81bf4..60555aece3d 100644 --- a/modules/emulator/R/GaussProcess.R +++ b/modules/emulator/R/GaussProcess.R @@ -24,9 +24,7 @@ GaussProcess <- function(x, y, isotropic = TRUE, nugget = TRUE, method = "bayes" ## isotropic <- FALSE;nugget<-FALSE;method='bayes';ngibbs <- 50; burnin <- 10;thin<- 1; ## jump.ic<-c(1.1,0.2); prior <- 'unif' - ## check for packages - library(mvtnorm) - library(MCMCpack) + ## library('dietze') if (burnin > ngibbs) { @@ -171,7 +169,7 @@ GaussProcess <- function(x, y, isotropic = TRUE, nugget = TRUE, method = "bayes" if (n.unique == n) { M <- solve(Tinv + Sinv) m <- Tinv %*% (y - mu) - W <- rmvnorm(1, M %*% m, M) + W <- mvtnorm::rmvnorm(1, M %*% m, M) W.full <- W } else { ##method 1, draw W's individually @@ -188,7 +186,7 @@ GaussProcess <- function(x, y, isotropic = TRUE, nugget = TRUE, method = "bayes" yagg <- tapply(y - mu, x.id, sum) M <- solve(id.count * diag(1 / tauv, n.unique) + Sinv) m <- diag(1 / tauv, n.unique) %*% yagg - W <- rmvnorm(1, M %*% m, M) + W <- mvtnorm::rmvnorm(1, M %*% m, M) W.full <- W[x.id] } } else { @@ -207,8 +205,8 @@ GaussProcess <- function(x, y, isotropic = TRUE, nugget = TRUE, method = "bayes" anum.p <- sum(ldinvgamma(psistar, ap, bp)) aden.p <- sum(ldinvgamma(psi, ap, bp)) } - anum.p <- try(dmvnorm(as.vector(W), rep(0, n.unique), Sstar, log = TRUE) + anum.p, TRUE) - aden.p <- dmvnorm(as.vector(W), rep(0, n.unique), S, log = TRUE) + aden.p + anum.p <- try(mvtnorm::dmvnorm(as.vector(W), rep(0, n.unique), Sstar, log = TRUE) + anum.p, TRUE) + aden.p <- mvtnorm::dmvnorm(as.vector(W), rep(0, n.unique), S, log = TRUE) + aden.p if (is.numeric(anum.p) && is.finite(anum.p) && exp(anum.p - aden.p) > runif(1) && @@ -229,8 +227,8 @@ GaussProcess <- function(x, y, isotropic = TRUE, nugget = TRUE, method = "bayes" anum.p <- sum(ldinvgamma(psistar, ap, bp)) aden.p <- sum(ldinvgamma(psi, ap, bp)) } - anum.p <- try(dmvnorm(as.vector(W), rep(0, n.unique), Sstar, log = TRUE) + anum.p, TRUE) - aden.p <- dmvnorm(as.vector(W), rep(0, n.unique), S, log = TRUE) + aden.p + anum.p <- try(mvtnorm::dmvnorm(as.vector(W), rep(0, n.unique), Sstar, log = TRUE) + anum.p, TRUE) + aden.p <- mvtnorm::dmvnorm(as.vector(W), rep(0, n.unique), S, log = TRUE) + aden.p if (is.numeric(anum.p) && is.finite(anum.p) && exp(anum.p - aden.p) > runif(1) && @@ -254,8 +252,8 @@ GaussProcess <- function(x, y, isotropic = TRUE, nugget = TRUE, method = "bayes" anum <- ldinvgamma(taustar, aw, bw) aden <- ldinvgamma(tauw, aw, bw) } - anum <- try(anum + dmvnorm(as.vector(W), rep(0, n.unique), Sstar, log = TRUE)) - aden <- aden + dmvnorm(as.vector(W), rep(0, n.unique), S, log = TRUE) + anum <- try(anum + mvtnorm::dmvnorm(as.vector(W), rep(0, n.unique), Sstar, log = TRUE)) + aden <- aden + mvtnorm::dmvnorm(as.vector(W), rep(0, n.unique), S, log = TRUE) if (is.numeric(anum) && is.finite(anum) && exp(anum - aden) > runif(1)) { diff --git a/modules/emulator/R/minimize.GP.R b/modules/emulator/R/minimize.GP.R index 71ce65ede3b..6e1c4508306 100644 --- a/modules/emulator/R/minimize.GP.R +++ b/modules/emulator/R/minimize.GP.R @@ -125,8 +125,10 @@ get_ss <- function(gp, xnew, pos.check) { for(igp in seq_along(gp)){ Y <- mlegp::predict.gp(gp[[igp]], newData = X[, 1:ncol(gp[[igp]]$X), drop=FALSE], se.fit = TRUE) + j <- (igp %% length(pos.check)) + if(j == 0) j <- length(pos.check) - if(pos.check[igp]){ + if(pos.check[j]){ if(Y$fit < 0){ return(-Inf) } @@ -177,16 +179,22 @@ is.accepted <- function(ycurr, ynew, format = "lin") { ##' @title mcmc.GP ##' @export ##' -##' @param gp -##' @param x0 -##' @param nmcmc -##' @param rng +##' @param gp Gaussian Process +##' @param x0 initial values +##' @param nmcmc number of iterations +##' @param rng range of knots ##' @param format lin = lnlike fcn, log = log(lnlike) ##' @param mix each = jump each dim. independently, joint = jump all at once -##' @param splinefcns -##' @param jmp0 -##' @param ar.target -##' @param priors +##' @param splinefcns spline functions, not used +##' @param jmp0 initial jump variances +##' @param ar.target acceptance rate target +##' @param settings PEcAn settings list +##' @param priors prior list +##' @param run.block is this a new run or making the previous chain longer +##' @param n.of.obs number of observations +##' @param llik.fn list that contains likelihood functions +##' @param hyper.pars hyper parameters +##' @param resume.list list of needed info if we are running the chain longer ##' ##' @author Michael Dietze mcmc.GP <- function(gp, x0, nmcmc, rng, format = "lin", mix = "joint", splinefcns = NULL, @@ -217,7 +225,7 @@ mcmc.GP <- function(gp, x0, nmcmc, rng, format = "lin", mix = "joint", splinefcn currllp <- pda.calc.llik.par(settings, n.of.obs, currSS, hyper.pars) pcurr <- unlist(sapply(currllp, `[[` , "par")) - xcurr <- x0 + xcurr <- unlist(x0) dim <- length(x0) samp <- matrix(NA, nmcmc, dim) par <- matrix(NA, nmcmc, length(pcurr), dimnames = list(NULL, names(pcurr))) # note: length(pcurr) can be 0 @@ -241,6 +249,8 @@ mcmc.GP <- function(gp, x0, nmcmc, rng, format = "lin", mix = "joint", splinefcn # jmp <- mvjump(ic=diag(jmp0),rate=ar.target, nc=dim) } + # make sure it is positive definite, see note below + jcov <- lqmm::make.positive.definite(jcov, tol=1e-12) for (g in start:nmcmc) { @@ -253,15 +263,15 @@ mcmc.GP <- function(gp, x0, nmcmc, rng, format = "lin", mix = "joint", splinefcn # accept.count <- round(jmp@arate[(g-1)/settings$assim.batch$jump$adapt]*100) jcov <- pda.adjust.jumps.bs(settings, jcov, accept.count, params.recent) accept.count <- 0 # Reset counter + + # make sure precision is not going to be an issue + # NOTE: for very small values this is going to be an issue + # maybe include a scaling somewhere while building the emulator + jcov <- lqmm::make.positive.definite(jcov, tol=1e-12) } ## propose new parameters - repeat { - xnew <- mvrnorm(1, unlist(xcurr), jcov) - if (bounded(xnew, rng)) { - break - } - } + xnew <- TruncatedNormal::rtmvnorm(1, mu = c(xcurr), sigma = jcov, lb = rng[,1], ub = rng[,2]) # if(bounded(xnew,rng)){ # re-predict SS @@ -272,15 +282,18 @@ mcmc.GP <- function(gp, x0, nmcmc, rng, format = "lin", mix = "joint", splinefcn # don't update the currllp ( = llik.par, e.g. tau) yet # calculate posterior with xcurr | currllp ycurr <- get_y(currSS, xcurr, llik.fn, priors, currllp) - + HRcurr <- TruncatedNormal::dtmvnorm(c(xnew), c(xcurr), jcov, + lb = rng[,1], ub = rng[,2], log = TRUE, B = 1e2) newSS <- get_ss(gp, xnew, pos.check) if(all(newSS != -Inf)){ newllp <- pda.calc.llik.par(settings, n.of.obs, newSS, hyper.pars) ynew <- get_y(newSS, xnew, llik.fn, priors, newllp) + HRnew <- TruncatedNormal::dtmvnorm(c(xcurr), c(xnew), jcov, + lb = rng[,1], ub = rng[,2], log = TRUE, B = 1e2) - if (is.accepted(ycurr, ynew)) { + if (is.accepted(ycurr+HRcurr, ynew+HRnew)) { xcurr <- xnew currSS <- newSS accept.count <- accept.count + 1 diff --git a/modules/emulator/R/zzz.R b/modules/emulator/R/zzz.R index 5e6efc9d62f..05e060a1c62 100644 --- a/modules/emulator/R/zzz.R +++ b/modules/emulator/R/zzz.R @@ -1,12 +1,8 @@ -##' @name jump -##' @title setClass jump +##' define a class for automatically tuning jump distributions +##' ##' @export ##' ##' @author Michael Dietze - -# .First.lib <- function(which.lib.loc, package){ - -## define a class for automatically tuning jump distributions methods::setClass("jump", methods::representation(history = "numeric", count = "numeric", target = "numeric", clen = "numeric", arate = "numeric"), prototype = list(history = vector("numeric", 0), count = 0, target = 0.4, @@ -15,9 +11,8 @@ methods::setClass("jump", methods::representation(history = "numeric", count = " ## target = target acceptance rate clen = update period (recompute when count > clen) methods::setIs("jump", "list") - -##' @name mvjump -##' @title setClass mvjump +##' multivariate version of jump class +##' ##' @export ##' methods::setClass("mvjump", methods::representation(history = "matrix", count = "numeric", target = "numeric", diff --git a/modules/emulator/man/GaussProcess.Rd b/modules/emulator/man/GaussProcess.Rd index 4755cf455ba..38637d45017 100644 --- a/modules/emulator/man/GaussProcess.Rd +++ b/modules/emulator/man/GaussProcess.Rd @@ -4,10 +4,23 @@ \alias{GaussProcess} \title{GaussProcess} \usage{ -GaussProcess(x, y, isotropic = TRUE, nugget = TRUE, method = "bayes", - ngibbs = 5000, burnin = 1000, thin = 1, jump.ic = c(1.1, 0.2), - prior = "IG", mix = "joint", psi = NULL, zeroMean = FALSE, - exclude = NULL, ...) +GaussProcess( + x, + y, + isotropic = TRUE, + nugget = TRUE, + method = "bayes", + ngibbs = 5000, + burnin = 1000, + thin = 1, + jump.ic = c(1.1, 0.2), + prior = "IG", + mix = "joint", + psi = NULL, + zeroMean = FALSE, + exclude = NULL, + ... +) } \arguments{ \item{nugget}{allows additional error in Y rather than fix interpolation to go through points} diff --git a/modules/emulator/man/jump-class.Rd b/modules/emulator/man/jump-class.Rd new file mode 100644 index 00000000000..838cb2938e5 --- /dev/null +++ b/modules/emulator/man/jump-class.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/zzz.R +\docType{class} +\name{jump-class} +\alias{jump-class} +\title{define a class for automatically tuning jump distributions} +\description{ +define a class for automatically tuning jump distributions +} +\author{ +Michael Dietze +} diff --git a/modules/emulator/man/jump.Rd b/modules/emulator/man/jump.Rd index 7e5f349416c..1e3b9d1515d 100644 --- a/modules/emulator/man/jump.Rd +++ b/modules/emulator/man/jump.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jump.R, R/zzz.R +% Please edit documentation in R/jump.R \name{jump} \alias{jump} \title{jump} @@ -11,11 +11,7 @@ jump(ic = 0, rate = 0.4, ...) } \description{ jump - -setClass jump } \author{ -Michael Dietze - Michael Dietze } diff --git a/modules/emulator/man/mcmc.GP.Rd b/modules/emulator/man/mcmc.GP.Rd index f16c8726a16..916df53e0b2 100644 --- a/modules/emulator/man/mcmc.GP.Rd +++ b/modules/emulator/man/mcmc.GP.Rd @@ -4,19 +4,57 @@ \alias{mcmc.GP} \title{mcmc.GP} \usage{ -mcmc.GP(gp, x0, nmcmc, rng, format = "lin", mix = "joint", - splinefcns = NULL, jmp0 = 0.35 * (rng[, 2] - rng[, 1]), - ar.target = 0.5, priors = NA, settings, run.block = TRUE, n.of.obs, - llik.fn, hyper.pars, resume.list = NULL) +mcmc.GP( + gp, + x0, + nmcmc, + rng, + format = "lin", + mix = "joint", + splinefcns = NULL, + jmp0 = 0.35 * (rng[, 2] - rng[, 1]), + ar.target = 0.5, + priors = NA, + settings, + run.block = TRUE, + n.of.obs, + llik.fn, + hyper.pars, + resume.list = NULL +) } \arguments{ -\item{x0}{} +\item{gp}{Gaussian Process} + +\item{x0}{initial values} + +\item{nmcmc}{number of iterations} + +\item{rng}{range of knots} \item{format}{lin = lnlike fcn, log = log(lnlike)} \item{mix}{each = jump each dim. independently, joint = jump all at once} -\item{priors}{} +\item{splinefcns}{spline functions, not used} + +\item{jmp0}{initial jump variances} + +\item{ar.target}{acceptance rate target} + +\item{priors}{prior list} + +\item{settings}{PEcAn settings list} + +\item{run.block}{is this a new run or making the previous chain longer} + +\item{n.of.obs}{number of observations} + +\item{llik.fn}{list that contains likelihood functions} + +\item{hyper.pars}{hyper parameters} + +\item{resume.list}{list of needed info if we are running the chain longer} } \description{ Function to sample from a GP model diff --git a/modules/emulator/man/mvjump-class.Rd b/modules/emulator/man/mvjump-class.Rd new file mode 100644 index 00000000000..69d86a77c42 --- /dev/null +++ b/modules/emulator/man/mvjump-class.Rd @@ -0,0 +1,9 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/zzz.R +\docType{class} +\name{mvjump-class} +\alias{mvjump-class} +\title{multivariate version of jump class} +\description{ +multivariate version of jump class +} diff --git a/modules/emulator/man/mvjump.Rd b/modules/emulator/man/mvjump.Rd index b8c81c08bbe..237232edc69 100644 --- a/modules/emulator/man/mvjump.Rd +++ b/modules/emulator/man/mvjump.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/jump.R, R/zzz.R +% Please edit documentation in R/jump.R \name{mvjump} \alias{mvjump} \title{mvjump} diff --git a/modules/emulator/man/predict.GP.Rd b/modules/emulator/man/predict.GP.Rd index 7ac8630fb7a..a5e936f5535 100644 --- a/modules/emulator/man/predict.GP.Rd +++ b/modules/emulator/man/predict.GP.Rd @@ -4,8 +4,7 @@ \alias{predict.GP} \title{predict.GP} \usage{ -\method{predict}{GP}(gp, xpred, cI = NULL, pI = NULL, - splinefcns = NULL) +\method{predict}{GP}(gp, xpred, cI = NULL, pI = NULL, splinefcns = NULL) } \arguments{ \item{cI}{credible interval} diff --git a/modules/emulator/tests/Rcheck_reference.log b/modules/emulator/tests/Rcheck_reference.log new file mode 100644 index 00000000000..6f1b743940a --- /dev/null +++ b/modules/emulator/tests/Rcheck_reference.log @@ -0,0 +1,317 @@ +* using log directory ‘/tmp/RtmpNwieb2/PEcAn.emulator.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.emulator/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.emulator’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.emulator’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'library' or 'require' call not declared from: ‘time’ +'library' or 'require' calls to packages already attached by Depends: + ‘MCMCpack’ ‘mvtnorm’ + Please remove these calls from your code. +'library' or 'require' call to ‘time’ in package code. + Please use :: or requireNamespace() instead. + See section 'Suggested packages' in the 'Writing R Extensions' manual. +Packages in Depends field not imported from: + ‘MCMCpack’ ‘mlegp’ ‘mvtnorm’ + These packages need to be imported from (in the NAMESPACE file) + for when this namespace is loaded but not attached. +* checking S3 generic/method consistency ... WARNING +calcSpatialCov: + function(x, ...) +calcSpatialCov.list: + function(d, psi, tau) + +calcSpatialCov: + function(x, ...) +calcSpatialCov.matrix: + function(d, psi, tau) + +p: + function(x, ...) +p.jump: + function(jmp) + +p: + function(x, ...) +p.mvjump: + function(jmp) + +plot: + function(x, ...) +plot.jump: + function(jmp) + +plot: + function(x, ...) +plot.mvjump: + function(jmp) + +predict: + function(object, ...) +predict.GP: + function(gp, xpred, cI, pI, splinefcns) + +predict: + function(object, ...) +predict.density: + function(den, xnew) + +update: + function(object, ...) +update.jump: + function(jmp, chain) + +update: + function(object, ...) +update.mvjump: + function(jmp, chain) + +See section ‘Generic functions and methods’ in the ‘Writing R +Extensions’ manual. + +Found the following apparent S3 methods exported but not registered: + plot.jump +See section ‘Registering S3 methods’ in the ‘Writing R Extensions’ +manual. +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +GaussProcess: no visible global function definition for ‘var’ +GaussProcess: no visible global function definition for ‘nlm’ +GaussProcess: no visible global function definition for ‘progressBar’ +GaussProcess: no visible global function definition for ‘rmvnorm’ +GaussProcess: no visible global function definition for ‘rnorm’ +GaussProcess: no visible global function definition for ‘dmvnorm’ +GaussProcess: no visible global function definition for ‘runif’ +GaussProcess: no visible global function definition for ‘update’ +GaussProcess: no visible global function definition for ‘rinvgamma’ +get_ss: no visible global function definition for ‘rnorm’ +get_y: no visible global function definition for ‘pda.calc.llik’ +gp_mle: no visible global function definition for ‘dmvnorm’ +gp_mle2: no visible global function definition for ‘dmvnorm’ +gpeval: no visible binding for global variable ‘splinefuns’ +gpeval : : no visible binding for global variable + ‘splinefuns’ +gpeval: no visible binding for global variable ‘ytrend’ +is.accepted: no visible global function definition for ‘runif’ +jump: no visible global function definition for ‘new’ +lhc: no visible global function definition for ‘runif’ +mcmc.GP: no visible global function definition for ‘pda.calc.llik.par’ +mcmc.GP: no visible global function definition for + ‘pda.adjust.jumps.bs’ +mcmc.GP: no visible global function definition for ‘mvrnorm’ +mcmc.GP: no visible global function definition for ‘rnorm’ +mcmc.GP: no visible binding for global variable ‘jmp’ +minimize.GP: no visible global function definition for ‘median’ +minimize.GP: no visible binding for global variable ‘median’ +minimize.GP: no visible global function definition for ‘nlm’ +minimize.GP: no visible binding for global variable ‘splinefcns’ +mvjump: no visible global function definition for ‘new’ +plot.jump: no visible global function definition for ‘par’ +plot.jump: no visible global function definition for ‘plot’ +plot.jump: no visible global function definition for ‘abline’ +plot.mvjump: no visible global function definition for ‘par’ +plot.mvjump: no visible global function definition for ‘plot’ +plot.mvjump: no visible global function definition for ‘abline’ +plot.mvjump: no visible global function definition for ‘text’ +predict.GP: no visible global function definition for ‘median’ +predict.GP: no visible binding for global variable ‘median’ +predict.GP: no visible binding for global variable ‘splinefuns’ +predict.GP: no visible global function definition for ‘progressBar’ +predict.GP: no visible global function definition for ‘rmvnorm’ +predict.GP: no visible global function definition for ‘rnorm’ +predict.GP: no visible binding for global variable ‘quantile’ +summarize.GP: no visible global function definition for ‘par’ +summarize.GP: no visible global function definition for ‘pdf’ +summarize.GP: no visible global function definition for ‘plot’ +summarize.GP: no visible global function definition for ‘title’ +summarize.GP: no visible global function definition for ‘lines’ +summarize.GP: no visible global function definition for ‘dev.off’ +Undefined global functions or variables: + abline dev.off dmvnorm jmp lines median mvrnorm new nlm par + pda.adjust.jumps.bs pda.calc.llik pda.calc.llik.par pdf plot + progressBar quantile rinvgamma rmvnorm rnorm runif splinefcns + splinefuns text title update var ytrend +Consider adding + importFrom("graphics", "abline", "lines", "par", "plot", "text", + "title") + importFrom("grDevices", "dev.off", "pdf") + importFrom("methods", "new") + importFrom("stats", "median", "nlm", "quantile", "rnorm", "runif", + "update", "var") +to your NAMESPACE file (and ensure that your DESCRIPTION Imports field +contains 'methods'). +* checking Rd files ... NOTE +prepare_Rd: emulator-package.Rd:27-29: Dropping empty section \references +prepare_Rd: emulator-package.Rd:31-32: Dropping empty section \seealso +prepare_Rd: emulator-package.Rd:33-34: Dropping empty section \examples +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'GaussProcess' + ‘x’ ‘y’ ‘isotropic’ ‘method’ ‘ngibbs’ ‘burnin’ ‘thin’ ‘jump.ic’ ‘psi’ + ‘zeroMean’ ‘...’ + +Undocumented arguments in documentation object 'arate' + ‘x’ + +Undocumented arguments in documentation object 'bounded' + ‘xnew’ ‘rng’ + +Undocumented arguments in documentation object 'calcSpatialCov' + ‘x’ ‘...’ + +Undocumented arguments in documentation object 'calculate.prior' + ‘samples’ ‘priors’ + +Undocumented arguments in documentation object 'ddist' + ‘x’ ‘prior’ + +Undocumented arguments in documentation object 'distance' + ‘x’ + +Undocumented arguments in documentation object 'distance.martix' + ‘x’ ‘power’ + +Undocumented arguments in documentation object 'distance12.martix' + ‘x’ ‘n1’ + +Undocumented arguments in documentation object 'get_ss' + ‘gp’ ‘xnew’ ‘pos.check’ + +Undocumented arguments in documentation object 'get_y' + ‘SSnew’ ‘xnew’ ‘llik.fn’ ‘priors’ ‘llik.par’ + +Undocumented arguments in documentation object 'gp_mle' + ‘theta’ ‘d’ ‘nugget’ ‘myY’ + +Undocumented arguments in documentation object 'gp_mle2' + ‘theta’ ‘d’ ‘nugget’ ‘myY’ ‘maxval’ + +Undocumented arguments in documentation object 'gpeval' + ‘xnew’ ‘k’ ‘mu’ ‘tau’ ‘psi’ ‘x’ + +Undocumented arguments in documentation object 'groupid' + ‘x’ + +Undocumented arguments in documentation object 'is.accepted' + ‘ycurr’ ‘ynew’ ‘format’ + +Undocumented arguments in documentation object 'jump' + ‘ic’ ‘...’ + +Undocumented arguments in documentation object 'ldinvgamma' + ‘x’ ‘shape’ + +Undocumented arguments in documentation object 'mcmc.GP' + ‘gp’ ‘nmcmc’ ‘rng’ ‘splinefcns’ ‘jmp0’ ‘ar.target’ ‘settings’ + ‘run.block’ ‘n.of.obs’ ‘llik.fn’ ‘hyper.pars’ ‘resume.list’ + +Undocumented arguments in documentation object 'minimize.GP' + ‘gp’ ‘rng’ + +Undocumented arguments in documentation object 'mvjump' + ‘ic’ ‘rate’ ‘nc’ ‘...’ + +Undocumented arguments in documentation object 'nderiv' + ‘x’ ‘y’ + +Undocumented arguments in documentation object 'p' + ‘x’ ‘...’ + +Undocumented arguments in documentation object 'predict.GP' + ‘gp’ ‘xpred’ ‘splinefcns’ + +Undocumented arguments in documentation object 'predict.density' + ‘den’ + +Undocumented arguments in documentation object 'summarize.GP' + ‘gp’ ‘pdf_file’ + +Undocumented arguments in documentation object 'update.mvjump' + ‘jmp’ ‘chain’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'GaussProcess': + ‘exclude’ + +Argument items with no description in Rd object 'distance': + ‘power’ + +Argument items with no description in Rd object 'distance.martix': + ‘dim’ + +Argument items with no description in Rd object 'distance12.martix': + ‘power’ + +Argument items with no description in Rd object 'gp_mle': + ‘maxval’ + +Argument items with no description in Rd object 'gpeval': + ‘splinefcns’ + +Argument items with no description in Rd object 'jump': + ‘rate’ + +Argument items with no description in Rd object 'ldinvgamma': + ‘scale’ + +Argument items with no description in Rd object 'mcmc.GP': + ‘x0’ ‘priors’ + +Argument items with no description in Rd object 'minimize.GP': + ‘x0’ ‘splinefuns’ + +Argument items with no description in Rd object 'plot.mvjump': + ‘jmp’ + +Argument items with no description in Rd object 'predict.density': + ‘xnew’ + +Argument items with no description in Rd object 'summarize.GP': + ‘txt_file’ + +* checking for unstated dependencies in examples ... OK +* checking examples ... NONE +* DONE +Status: 4 WARNINGs, 3 NOTEs diff --git a/modules/meta.analysis/DESCRIPTION b/modules/meta.analysis/DESCRIPTION index dc9189ed363..dca7f5f0874 100644 --- a/modules/meta.analysis/DESCRIPTION +++ b/modules/meta.analysis/DESCRIPTION @@ -1,18 +1,16 @@ Package: PEcAn.MA Type: Package Title: PEcAn functions used for meta-analysis -Version: 1.7.1 -Date: 2019-09-05 -Authors@R: c(person("Mike","Dietze"), - person("David","LeBauer"), - person("Xiaohui", "Feng"), - person("Dan"," Wang"), - person("Carl", "Davidson"), - person("Rob","Kooper"), - person("Shawn", "Serbin")) -Author: David LeBauer, Mike Dietze, Xiaohui Feng, Dan Wang, Carl - Davidson, Rob Kooper, Shawn Serbin -Maintainer: David LeBauer +Version: 1.7.2 +Date: 2021-10-04 +Authors@R: c(person("Mike","Dietze", role = c("aut")), + person("David", "LeBauer", role = c("aut", "cre"), email = "dlebauer@email.arizona.edu"), + person("Xiaohui", "Feng", role = c("aut")), + person("Dan"," Wang", role = c("aut")), + person("Carl", "Davidson", role = c("aut")), + person("Rob","Kooper", role = c("aut")), + person("Shawn", "Serbin", role = c("aut")), + person("Shashank", "Singh", role = c("aut"))) Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific workflow management tool that is designed to simplify the management of model parameterization, execution, and analysis. The goal of PECAn is to @@ -31,12 +29,11 @@ Imports: PEcAn.settings, rjags Suggests: - testthat (>= 1.0.2), - PEcAn.priors + testthat (>= 1.0.2) SystemRequirements: JAGS -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 Roxygen: list(markdown = TRUE) diff --git a/modules/meta.analysis/NAMESPACE b/modules/meta.analysis/NAMESPACE index 1d376bbdfe7..8702ae5460e 100644 --- a/modules/meta.analysis/NAMESPACE +++ b/modules/meta.analysis/NAMESPACE @@ -5,6 +5,7 @@ export(jagify) export(p.point.in.prior) export(pecan.ma) export(pecan.ma.summary) +export(rename_jags_columns) export(run.meta.analysis) export(runModule.run.meta.analysis) export(single.MA) diff --git a/modules/meta.analysis/R/jagify.R b/modules/meta.analysis/R/jagify.R index cf17f00c6e8..ab8c1dd0d86 100644 --- a/modules/meta.analysis/R/jagify.R +++ b/modules/meta.analysis/R/jagify.R @@ -20,10 +20,10 @@ jagify <- function(result, use_ghs = TRUE) { - ## Rename 'name' column from 'treatment' table to trt_id. Remove NAs. Assign treatments. + ## Create new column "trt_id" from column 'name'. Remove NAs. Assign treatments. ## Finally, summarize the results by calculating summary statistics from experimental replicates r <- result[!is.na(result$mean), ] - colnames(r)[colnames(r) == "name"] <- "trt_id" + r$trt_id <- r$name r <- transform.nas(r) # exclude greenhouse data unless requested otherwise @@ -39,8 +39,20 @@ jagify <- function(result, use_ghs = TRUE) { site_id = as.integer(factor(site_id, unique(site_id))), greenhouse = as.integer(factor(greenhouse, unique(greenhouse))), mean = mean, - citation_id = citation_id), - select = c("stat", "n", "site_id", "trt_id", "mean", "citation_id", "greenhouse")) + citation_id = citation_id, + ghs = greenhouse, + site = site_id, + trt_name = name), + select = c("stat", "n", "site_id", "trt_id", "mean", "citation_id", "greenhouse", + "ghs", "treatment_id", "site", "trt_name")) # original versions of greenhouse, treatment_id, site_id, and name + + #order by site_id and trt_id, but make sure "control" is the first trt of each site + uniq <- setdiff(unique(r$trt_id), "control") + r$trt_id <- factor(r$trt_id, levels = c("control", uniq[order(uniq)])) + r <- r[order(r$site_id, r$trt_id), ] + + #add beta.trt index associated with each trt_id (performed in single.MA, replicated here for matching purposes) + r$trt_num <- as.integer(factor(r$trt_id, levels = unique(r$trt_id))) if (length(r$stat[!is.na(r$stat) & r$stat <= 0]) > 0) { varswithbadstats <- unique(result$vname[which(r$stat <= 0)]) @@ -53,7 +65,7 @@ jagify <- function(result, use_ghs = TRUE) { r$stat[r$stat <= 0] <- NA } - PEcAn.DB::rename_jags_columns(r) + rename_jags_columns(r) } # jagify # ==================================================================================================# diff --git a/modules/meta.analysis/R/meta.analysis.R b/modules/meta.analysis/R/meta.analysis.R index 113c6e4b757..6a55f5d35b1 100644 --- a/modules/meta.analysis/R/meta.analysis.R +++ b/modules/meta.analysis/R/meta.analysis.R @@ -34,8 +34,6 @@ ##' @param logfile Path to file for sinking meta analysis output. If ##' `NULL`, only print output to console. ##' @param verbose Logical. If `TRUE` (default), print progress messages. -##' @param madata_file Path to file for storing copy of data used in -##' meta-analysis. If `NULL`, don't store at all. ##' @return four chains with 5000 total samples from posterior ##' @author David LeBauer, Michael C. Dietze, Alexey Shiklomanov ##' @export @@ -67,13 +65,8 @@ pecan.ma <- function(trait.data, prior.distns, outdir, random = FALSE, overdispersed = TRUE, logfile = file.path(outdir, "meta-analysis.log)"), - verbose = TRUE, - madata_file = file.path(outdir, "madata.Rdata")) { + verbose = TRUE) { - if (!is.null(madata_file)) { - madata <- list() - } - ## Meta-analysis for each trait mcmc.object <- list() # initialize output list of mcmc objects for each trait mcmc.mat <- list() @@ -103,17 +96,17 @@ pecan.ma <- function(trait.data, prior.distns, writeLines(paste("------------------------------------------------")) } data <- trait.data[[trait.name]] - data <- data[, which(!colnames(data) %in% c("cite", "trait_id", "se"))] ## remove citation and other unneeded columns - data <- data[order(data[["site"]], data[["trt"]]), ] # not sure why, but required for JAGS model + data <- data[, which(!colnames(data) %in% c("cite", "trait_id", "se", + "greenhouse", "site_id", "treatment_id", "trt_name", "trt_num"))] ## remove citation and other unneeded columns + ## check for excess missing data if (all(is.na(data[["obs.prec"]]))) { - if (verbose) { - writeLines("NO ERROR STATS PROVIDED, DROPPING RANDOM EFFECTS") - } - data$site <- rep(1, nrow(data)) - data$trt <- rep(0, nrow(data)) + PEcAn.logger::logger.warn("NO ERROR STATS PROVIDED\n Check meta-analysis Model Convergence", + "and consider turning off Random Effects by", + "setting FALSE", + "in your pecan.xml settings file ") } if (!random) { @@ -140,9 +133,6 @@ pecan.ma <- function(trait.data, prior.distns, } } - if (!is.null(madata)) { - madata[[trait.name]] <- data - } jag.model.file <- file.path(outdir, paste0(trait.name, ".model.bug")) # file to store model ## run the meta-analysis in JAGS @@ -166,8 +156,6 @@ pecan.ma <- function(trait.data, prior.distns, mcmc.object[[trait.name]] <- jags.out.trunc } - if (!is.null(madata_file)) { - save(madata, file = madata_file) - } + return(mcmc.object) } # pecan.ma diff --git a/modules/meta.analysis/R/meta.analysis.summary.R b/modules/meta.analysis/R/meta.analysis.summary.R index 5e7ee78088f..1004c7fa686 100644 --- a/modules/meta.analysis/R/meta.analysis.summary.R +++ b/modules/meta.analysis/R/meta.analysis.summary.R @@ -55,11 +55,11 @@ pecan.ma.summary <- function(mcmc.object, pft, outdir, threshold = 1.2, gg = FAL ## plots for mcmc diagnosis pdf(file.path(outdir, paste0("ma.summaryplots.", trait, ".pdf"))) - + for (i in maparms) { - plot(mcmc.object[[trait]][, i], + plot(mcmc.object[[trait]][, i], trace = FALSE, - density = TRUE, + density = TRUE, main = paste("summary plots of", i, "for", pft, trait)) box(lwd = 2) plot(mcmc.object[[trait]][, i], density = FALSE) @@ -71,7 +71,7 @@ pecan.ma.summary <- function(mcmc.object, pft, outdir, threshold = 1.2, gg = FAL lattice::densityplot(mcmc.object[[trait]]) coda::acfplot(mcmc.object[[trait]]) dev.off() - + ## G-R diagnostics to ensure convergence gd <- coda::gelman.diag(mcmc.object[[trait]]) mpsrf <- round(gd$mpsrf, digits = 3) diff --git a/modules/meta.analysis/R/rename_jags_columns.R b/modules/meta.analysis/R/rename_jags_columns.R new file mode 100644 index 00000000000..d18fc5bb453 --- /dev/null +++ b/modules/meta.analysis/R/rename_jags_columns.R @@ -0,0 +1,43 @@ +#------------------------------------------------------------------------------- +# Copyright (c) 2012 University of Illinois, NCSA. +# All rights reserved. This program and the accompanying materials +# are made available under the terms of the +# University of Illinois/NCSA Open Source License +# which accompanies this distribution, and is available at +# http://opensource.ncsa.illinois.edu/license.html +#------------------------------------------------------------------------------- + +##-----------------------------------------------------------------------------# +##' renames the variables within output data frame trait.data +##' +##' @param data data frame to with variables to rename +##' +##' @seealso used with \code{\link[PEcAn.MA]{jagify}}; +##' @export +##' @author David LeBauer +rename_jags_columns <- function(data) { + + # Change variable names and calculate obs.prec within data frame + # Swap column names; needed for downstream function pecan.ma() + colnames(data)[colnames(data) %in% c("greenhouse", "ghs")] <- c("ghs", "greenhouse") + colnames(data)[colnames(data) %in% c("site_id", "site")] <- c("site", "site_id") + + stat <- NULL + n <- NULL + trt_id <- NULL + citation_id <- NULL + transformed <- transform(data, + Y = mean, + se = stat, + obs.prec = 1 / (sqrt(n) * stat) ^2, + trt = trt_id, + cite = citation_id) + + # Subset data frame + selected <- subset(transformed, select = c('Y', 'n', 'site', 'trt', 'ghs', 'obs.prec', + 'se', 'cite', + "greenhouse", "site_id", "treatment_id", "trt_name", "trt_num")) # add original # original versions of greenhouse, site_id, treatment_id, trt_name + # Return subset data frame + return(selected) +} +##=============================================================================# diff --git a/modules/meta.analysis/R/run.meta.analysis.R b/modules/meta.analysis/R/run.meta.analysis.R index e28db78b081..308d668d8ad 100644 --- a/modules/meta.analysis/R/run.meta.analysis.R +++ b/modules/meta.analysis/R/run.meta.analysis.R @@ -58,6 +58,10 @@ run.meta.analysis.pft <- function(pft, iterations, random = TRUE, threshold = 1. ## Convert data to format expected by pecan.ma jagged.data <- lapply(trait.data, PEcAn.MA::jagify, use_ghs = use_ghs) + ## Save the jagged.data object, replaces previous madata.Rdata object + ## First 6 columns are equivalent and direct inputs into the meta-analysis + save(jagged.data, file = file.path(pft$outdir, "jagged.data.Rdata")) + if(!use_ghs){ # check if any data left after excluding greenhouse all_trait_check <- sapply(jagged.data, nrow) @@ -159,10 +163,7 @@ run.meta.analysis.pft <- function(pft, iterations, random = TRUE, threshold = 1. ##--------------------------------------------------------------------------------------------------## ##' Run meta analysis -##' -##' @name run.meta.analysis ##' -##' @title Invoke PEcAn meta.analysis ##' This will use the following items from setings: ##' - settings$pfts ##' - settings$database$bety @@ -178,14 +179,14 @@ run.meta.analysis.pft <- function(pft, iterations, random = TRUE, threshold = 1. ##' \code{\link{pecan.ma.summary}} ##' @return nothing, as side effect saves \code{trait.mcmc} created by ##' \code{\link{pecan.ma}} and post.distns created by -##' \code{\link{approx.posterior}(trait.mcmc, ...)} to trait.mcmc.Rdata \ -##' and post.distns.Rdata, respectively +##' \code{\link{approx.posterior}(trait.mcmc, ...)} to trait.mcmc.Rdata +##' and post.distns.Rdata, respectively ##' @export ##' @author Shawn Serbin, David LeBauer run.meta.analysis <- function(pfts, iterations, random = TRUE, threshold = 1.2, dbfiles, database, use_ghs = TRUE) { # process all pfts dbcon <- db.open(database) - on.exit(db.close(dbcon)) + on.exit(db.close(dbcon), add = TRUE) result <- lapply(pfts, run.meta.analysis.pft, iterations = iterations, random = random, threshold = threshold, dbfiles = dbfiles, dbcon = dbcon, use_ghs = use_ghs) diff --git a/modules/meta.analysis/R/single.MA.R b/modules/meta.analysis/R/single.MA.R index a98040526db..5e5aeb035e8 100644 --- a/modules/meta.analysis/R/single.MA.R +++ b/modules/meta.analysis/R/single.MA.R @@ -43,6 +43,10 @@ single.MA <- function(data, j.chains, j.iter, tauA, tauB, prior, jag.model.file, site = "beta.site[site[k]]", trt = "beta.trt[trt[k]]") + # making sure ghs and trt are factor + data$ghs <- as.factor(data$ghs) + data$trt <- as.factor(data$trt) + if (sum(model.parms > 1) == 0) { reg.model <- "" } else { diff --git a/modules/meta.analysis/man/approx.posterior.Rd b/modules/meta.analysis/man/approx.posterior.Rd index 2b123a5241b..96798c590f3 100644 --- a/modules/meta.analysis/man/approx.posterior.Rd +++ b/modules/meta.analysis/man/approx.posterior.Rd @@ -4,8 +4,13 @@ \alias{approx.posterior} \title{Approximate posterior} \usage{ -approx.posterior(trait.mcmc, priors, trait.data = NULL, outdir = NULL, - filename.flag = "") +approx.posterior( + trait.mcmc, + priors, + trait.data = NULL, + outdir = NULL, + filename.flag = "" +) } \arguments{ \item{trait.mcmc}{meta analysis outputs} diff --git a/modules/meta.analysis/man/pecan.ma.Rd b/modules/meta.analysis/man/pecan.ma.Rd index c03d3415fc3..d97a3146386 100644 --- a/modules/meta.analysis/man/pecan.ma.Rd +++ b/modules/meta.analysis/man/pecan.ma.Rd @@ -4,10 +4,17 @@ \alias{pecan.ma} \title{Trait Meta-analysis} \usage{ -pecan.ma(trait.data, prior.distns, taupriors, j.iter, outdir, - random = FALSE, overdispersed = TRUE, logfile = file.path(outdir, - "meta-analysis.log)"), verbose = TRUE, - madata_file = file.path(outdir, "madata.Rdata")) +pecan.ma( + trait.data, + prior.distns, + taupriors, + j.iter, + outdir, + random = FALSE, + overdispersed = TRUE, + logfile = file.path(outdir, "meta-analysis.log)"), + verbose = TRUE +) } \arguments{ \item{trait.data}{list of \code{data.frame}s, one per trait for which @@ -31,9 +38,6 @@ by call to \code{\link[PEcAn.DB:query.priors]{PEcAn.DB::query.priors()}}} \code{NULL}, only print output to console.} \item{verbose}{Logical. If \code{TRUE} (default), print progress messages.} - -\item{madata_file}{Path to file for storing copy of data used in -meta-analysis. If \code{NULL}, don't store at all.} } \value{ four chains with 5000 total samples from posterior diff --git a/base/db/man/rename_jags_columns.Rd b/modules/meta.analysis/man/rename_jags_columns.Rd similarity index 88% rename from base/db/man/rename_jags_columns.Rd rename to modules/meta.analysis/man/rename_jags_columns.Rd index da89de92e8d..5a53963c293 100644 --- a/base/db/man/rename_jags_columns.Rd +++ b/modules/meta.analysis/man/rename_jags_columns.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/query.trait.data.R +% Please edit documentation in R/rename_jags_columns.R \name{rename_jags_columns} \alias{rename_jags_columns} \title{renames the variables within output data frame trait.data} diff --git a/modules/meta.analysis/man/run.meta.analysis.Rd b/modules/meta.analysis/man/run.meta.analysis.Rd index b842c24a231..5db4f76be57 100644 --- a/modules/meta.analysis/man/run.meta.analysis.Rd +++ b/modules/meta.analysis/man/run.meta.analysis.Rd @@ -2,17 +2,17 @@ % Please edit documentation in R/run.meta.analysis.R \name{run.meta.analysis} \alias{run.meta.analysis} -\title{Invoke PEcAn meta.analysis -This will use the following items from setings: -\itemize{ -\item settings$pfts -\item settings$database$bety -\item settings$database$dbfiles -\item settings$meta.analysis$update -}} +\title{Run meta analysis} \usage{ -run.meta.analysis(pfts, iterations, random = TRUE, threshold = 1.2, - dbfiles, database, use_ghs = TRUE) +run.meta.analysis( + pfts, + iterations, + random = TRUE, + threshold = 1.2, + dbfiles, + database, + use_ghs = TRUE +) } \arguments{ \item{pfts}{the list of pfts to get traits for} @@ -33,11 +33,17 @@ run.meta.analysis(pfts, iterations, random = TRUE, threshold = 1.2, \value{ nothing, as side effect saves \code{trait.mcmc} created by \code{\link{pecan.ma}} and post.distns created by -\code{\link{approx.posterior}(trait.mcmc, ...)} to trait.mcmc.Rdata +\code{\link{approx.posterior}(trait.mcmc, ...)} to trait.mcmc.Rdata and post.distns.Rdata, respectively } \description{ -Run meta analysis +This will use the following items from setings: +\itemize{ +\item settings$pfts +\item settings$database$bety +\item settings$database$dbfiles +\item settings$meta.analysis$update +} } \author{ Shawn Serbin, David LeBauer diff --git a/modules/meta.analysis/man/single.MA.Rd b/modules/meta.analysis/man/single.MA.Rd index 9784f5a3253..7b729767110 100644 --- a/modules/meta.analysis/man/single.MA.Rd +++ b/modules/meta.analysis/man/single.MA.Rd @@ -4,8 +4,16 @@ \alias{single.MA} \title{Single MA} \usage{ -single.MA(data, j.chains, j.iter, tauA, tauB, prior, jag.model.file, - overdispersed = TRUE) +single.MA( + data, + j.chains, + j.iter, + tauA, + tauB, + prior, + jag.model.file, + overdispersed = TRUE +) } \arguments{ \item{j.chains}{number of chains in meta-analysis} diff --git a/modules/meta.analysis/man/write.ma.model.Rd b/modules/meta.analysis/man/write.ma.model.Rd index 3769f618cb3..dec1ec1ee23 100644 --- a/modules/meta.analysis/man/write.ma.model.Rd +++ b/modules/meta.analysis/man/write.ma.model.Rd @@ -4,8 +4,20 @@ \alias{write.ma.model} \title{write.ma.model} \usage{ -write.ma.model(modelfile, outfile, reg.model, pr.dist, pr.param.a, - pr.param.b, n, trt.n, site.n, ghs.n, tauA, tauB) +write.ma.model( + modelfile, + outfile, + reg.model, + pr.dist, + pr.param.a, + pr.param.b, + n, + trt.n, + site.n, + ghs.n, + tauA, + tauB +) } \arguments{ \item{modelfile}{model template file (ma.model.template.R)} diff --git a/modules/meta.analysis/tests/Rcheck_reference.log b/modules/meta.analysis/tests/Rcheck_reference.log new file mode 100644 index 00000000000..b488b3828f2 --- /dev/null +++ b/modules/meta.analysis/tests/Rcheck_reference.log @@ -0,0 +1,147 @@ +* using log directory ‘/tmp/RtmpgQ8jGx/PEcAn.MA.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.MA/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.MA’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.MA’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'library' or 'require' call not declared from: ‘ggmcmc’ +'library' or 'require' call to ‘ggmcmc’ in package code. + Please use :: or requireNamespace() instead. + See section 'Suggested packages' in the 'Writing R Extensions' manual. +Packages in Depends field not imported from: + ‘lattice’ ‘MASS’ ‘PEcAn.DB’ ‘PEcAn.utils’ ‘XML’ + These packages need to be imported from (in the NAMESPACE file) + for when this namespace is loaded but not attached. +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +.dens_plot: no visible global function definition for ‘plot’ +.dens_plot: no visible global function definition for ‘density’ +.dens_plot: no visible global function definition for ‘rug’ +.dens_plot: no visible global function definition for ‘lines’ +.dens_plot: no visible global function definition for ‘legend’ +approx.posterior: no visible global function definition for ‘pdf’ +approx.posterior: no visible global function definition for ‘var’ +approx.posterior: no visible global function definition for ‘plot’ +approx.posterior: no visible global function definition for ‘density’ +approx.posterior: no visible global function definition for ‘rug’ +approx.posterior: no visible global function definition for ‘lines’ +approx.posterior: no visible global function definition for ‘dbeta’ +approx.posterior: no visible global function definition for ‘legend’ +approx.posterior: no visible binding for global variable ‘AIC’ +approx.posterior: no visible global function definition for ‘sd’ +approx.posterior: no visible global function definition for ‘dev.off’ +jagify: no visible binding for global variable ‘stat’ +jagify: no visible binding for global variable ‘n’ +jagify: no visible binding for global variable ‘site_id’ +jagify: no visible binding for global variable ‘greenhouse’ +jagify: no visible binding for global variable ‘citation_id’ +jagify: no visible binding for global variable ‘name’ +pecan.ma: no visible global function definition for ‘stem’ +pecan.ma: no visible global function definition for ‘window’ +pecan.ma.summary: no visible global function definition for + ‘is.mcmc.list’ +pecan.ma.summary: no visible global function definition for ‘theme_set’ +pecan.ma.summary: no visible global function definition for ‘theme_bw’ +pecan.ma.summary: no visible global function definition for ‘ggmcmc’ +pecan.ma.summary: no visible global function definition for ‘ggs’ +pecan.ma.summary: no visible global function definition for ‘pdf’ +pecan.ma.summary: no visible global function definition for ‘plot’ +pecan.ma.summary: no visible global function definition for ‘box’ +pecan.ma.summary: no visible global function definition for ‘dev.off’ +run.meta.analysis: no visible global function definition for ‘db.open’ +run.meta.analysis: no visible global function definition for ‘db.close’ +run.meta.analysis.pft: no visible binding for global variable + ‘settings’ +run.meta.analysis.pft: no visible binding for global variable + ‘trait.data’ +run.meta.analysis.pft: no visible global function definition for + ‘median’ +run.meta.analysis.pft: no visible binding for global variable + ‘prior.distns’ +run.meta.analysis.pft: no visible global function definition for + ‘dbfile.insert’ +Undefined global functions or variables: + AIC box citation_id db.close db.open dbeta dbfile.insert density + dev.off ggmcmc ggs greenhouse is.mcmc.list legend lines median n pdf + plot prior.distns rug sd settings site_id stat stem theme_bw + theme_set trait.data var window +Consider adding + importFrom("graphics", "box", "legend", "lines", "plot", "rug", "stem") + importFrom("grDevices", "dev.off", "pdf") + importFrom("stats", "AIC", "dbeta", "density", "median", "sd", "var", + "window") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... NOTE +Package unavailable to check Rd xrefs: ‘R2WinBUGS’ +* checking for missing documentation entries ... WARNING +Undocumented code objects: + ‘runModule.run.meta.analysis’ +Undocumented data sets: + ‘ma.testdata’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'single.MA' + ‘data’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'p.point.in.prior': + ‘point’ + +* checking for unstated dependencies in examples ... OK +* checking contents of ‘data’ directory ... OK +* checking data for non-ASCII characters ... OK +* checking data for ASCII and uncompressed saves ... OK +* checking files in ‘vignettes’ ... WARNING +Files in the 'vignettes' directory but no files in 'inst/doc': + ‘single.MA_demo.Rmd’ +Package has no Sweave vignette sources and no VignetteBuilder field. +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 5 WARNINGs, 3 NOTEs diff --git a/modules/meta.analysis/tests/testthat/test.run.meta.analysis.R b/modules/meta.analysis/tests/testthat/test.run.meta.analysis.R index 2d174d948e1..cc6f464e593 100644 --- a/modules/meta.analysis/tests/testthat/test.run.meta.analysis.R +++ b/modules/meta.analysis/tests/testthat/test.run.meta.analysis.R @@ -22,4 +22,29 @@ test_that("singleMA gives expected result for example inputs",{ ## need to calculate x ## x <- singleMA(....) #expect_equal(round(summary(x)$statistics["beta.o", "Mean"]), 5) -}) \ No newline at end of file +}) + +test_that("jagify correctly assigns treatment index of 1 to all control treatments, regardless of alphabetical order", { + ## generate test data; controls assigned to early alphabet and late alphabet trt names + testresult <- data.frame(citation_id = 1, + site_id = rep(1:2, each = 5), + name = rep(letters[1:5],2), + trt_id = as.character(rep(letters[1:5],2)), + control = c(1, rep(0,8), 1), + greenhouse = c(rep(0,5), rep(1,5)), + date = 1, + time = NA, + cultivar_id = 1, + specie_id = 1, + n = 2, + mean = sqrt(1:10), + stat = 1, + statname = "SE", + treatment_id = 1:10 + ) + i <- sapply(testresult, is.factor) + testresult[i] <- lapply(testresult[i], as.character) + + jagged.data <- jagify(testresult) + expect_equal(jagged.data$trt_num[jagged.data$trt == "control"], c(1, 1)) +}) diff --git a/modules/photosynthesis/DESCRIPTION b/modules/photosynthesis/DESCRIPTION index 0308730a6d3..2c0c90bed75 100644 --- a/modules/photosynthesis/DESCRIPTION +++ b/modules/photosynthesis/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAn.photosynthesis Type: Package Title: PEcAn functions used for leaf-level photosynthesis calculations -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("Xiaohui", "Feng"), person("Shawn", "Serbin")) @@ -18,10 +18,9 @@ Description: The Predictive Ecosystem Carbon Analyzer (PEcAn) is a scientific Depends: rjags Imports: - PEcAn.logger, coda (>= 0.18) SystemRequirements: JAGS2.2.0 -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE @@ -30,4 +29,4 @@ Collate: Licor.QC.R plots.R Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/photosynthesis/R/fitA.R b/modules/photosynthesis/R/fitA.R index 35aee63f879..53c73077a25 100644 --- a/modules/photosynthesis/R/fitA.R +++ b/modules/photosynthesis/R/fitA.R @@ -167,9 +167,16 @@ To <- 35 ## Representative value, would benifit from spp calibration! ## prep data sel <- seq_len(nrow(dat)) #which(dat$spp == s) -if (!any(names(dat) == "Tleaf")) { - dat$Tleaf <- rep(25 + 273.15, nrow(dat)) ## if leaf temperature is absent, assume 25C +if("Tleaf" %in% names(dat)){ + if(max(dat$Tleaf) < 100){ # if Tleaf in C, convert to K + dat$Tleaf <- dat$Tleaf + 273.15 + } +} else if (!"Tleaf" %in% names(dat)) { + dat$Tleaf <- 25 + 273.15 ## if no Tleaf, assume 25C in Kelvin + warning("No Leaf Temperature provided, setting to 25C\n", + "To change add a column named Tleaf to flux.data data frame") } + mydat <- list(an = dat$Photo[sel], pi = dat$Ci[sel], q = dat$PARi[sel], @@ -213,7 +220,7 @@ if ("leaf" %in% V.random) { if (!is.null(XV)) { Vnames <- gsub(" ", "_", colnames(XV)) Vformula <- paste(Vformula, - paste0("+ betaV", Vnames, "*XV[rep[i],", seq_along(XV), "]", collapse = " ")) + paste0("+ betaV", Vnames, "*XV[rep[i],", seq_len(ncol(XV)), "]", collapse = " ")) Vpriors <- paste0(" betaV", Vnames, "~dnorm(0,0.001)", collapse = "\n") my.model <- sub(pattern = "## Vcmax BETAS", Vpriors, my.model) mydat[["XV"]] <- XV diff --git a/modules/photosynthesis/code/Sunny.preliminary.code/C3 Species.csv b/modules/photosynthesis/code/Sunny.preliminary.code/C3_Species.csv similarity index 100% rename from modules/photosynthesis/code/Sunny.preliminary.code/C3 Species.csv rename to modules/photosynthesis/code/Sunny.preliminary.code/C3_Species.csv diff --git a/modules/photosynthesis/code/Sunny.preliminary.code/C3 photomodel.r b/modules/photosynthesis/code/Sunny.preliminary.code/C3_photomodel.r similarity index 99% rename from modules/photosynthesis/code/Sunny.preliminary.code/C3 photomodel.r rename to modules/photosynthesis/code/Sunny.preliminary.code/C3_photomodel.r index 4de0f8024ed..595061b960f 100644 --- a/modules/photosynthesis/code/Sunny.preliminary.code/C3 photomodel.r +++ b/modules/photosynthesis/code/Sunny.preliminary.code/C3_photomodel.r @@ -1,6 +1,6 @@ library(R2WinBUGS) library(BRugs) -dat=read.csv("C3 Species.csv",header=T) +dat=read.csv("C3_Species.csv",header=T) #dat2=read.csv('c3covariates.csv',header=T) my.model = function(){ diff --git a/modules/photosynthesis/man/plot_photo.Rd b/modules/photosynthesis/man/plot_photo.Rd index 8513b5642ea..7adde53bf3d 100644 --- a/modules/photosynthesis/man/plot_photo.Rd +++ b/modules/photosynthesis/man/plot_photo.Rd @@ -4,8 +4,7 @@ \alias{plot_photo} \title{plot_photo} \usage{ -plot_photo(data, out, curve = c("ACi", "AQ"), tol = 0.05, - byLeaf = TRUE) +plot_photo(data, out, curve = c("ACi", "AQ"), tol = 0.05, byLeaf = TRUE) } \description{ plot_photo diff --git a/modules/photosynthesis/tests/Rcheck_reference.log b/modules/photosynthesis/tests/Rcheck_reference.log new file mode 100644 index 00000000000..8ba8dd03acb --- /dev/null +++ b/modules/photosynthesis/tests/Rcheck_reference.log @@ -0,0 +1,106 @@ +* using log directory ‘/tmp/RtmpPffpxB/PEcAn.photosynthesis.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.photosynthesis/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.photosynthesis’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.photosynthesis’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... NOTE +Non-standard file/directory found at top level: + ‘code’ +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... NOTE +'library' or 'require' call to ‘rjags’ which was already attached by Depends. + Please remove these calls from your code. +Package in Depends field not imported from: ‘rjags’ + These packages need to be imported from (in the NAMESPACE file) + for when this namespace is loaded but not attached. +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +ciEnvelope: no visible global function definition for ‘polygon’ +estimate_mode: no visible global function definition for ‘density’ +fitA: no visible global function definition for ‘jags.model’ +fitA: no visible global function definition for ‘coda.samples’ +Licor_QC: no visible global function definition for ‘plot’ +Licor_QC: no visible global function definition for ‘points’ +Licor_QC: no visible global function definition for ‘text’ +Licor_QC: no visible global function definition for ‘legend’ +Licor_QC: no visible global function definition for ‘identify’ +mat2mcmc.list: no visible global function definition for ‘as.mcmc’ +mat2mcmc.list: no visible global function definition for ‘as.mcmc.list’ +plot_photo: no visible binding for global variable ‘quantile’ +plot_photo: no visible global function definition for ‘plot’ +plot_photo: no visible global function definition for ‘lines’ +plot_photo: no visible global function definition for ‘points’ +plot_photo: no visible global function definition for ‘legend’ +read_Licor: no visible global function definition for ‘tail’ +read_Licor: no visible global function definition for ‘read.table’ +Undefined global functions or variables: + as.mcmc as.mcmc.list coda.samples density identify jags.model legend + lines plot points polygon quantile read.table tail text +Consider adding + importFrom("graphics", "identify", "legend", "lines", "plot", "points", + "polygon", "text") + importFrom("stats", "density", "quantile") + importFrom("utils", "read.table", "tail") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'ciEnvelope' + ‘x’ ‘ylo’ ‘yhi’ ‘col’ ‘...’ + +Undocumented arguments in documentation object 'estimate_mode' + ‘x’ ‘adjust’ + +Undocumented arguments in documentation object 'plot_photo' + ‘data’ ‘out’ ‘curve’ ‘tol’ ‘byLeaf’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking files in ‘vignettes’ ... WARNING +Files in the 'vignettes' directory but no files in 'inst/doc': + ‘ResponseCurves.Rmd’ +Package has no Sweave vignette sources and no VignetteBuilder field. +* checking examples ... NONE +* DONE +Status: 2 WARNINGs, 4 NOTEs diff --git a/modules/priors/DESCRIPTION b/modules/priors/DESCRIPTION index 4bb1c436701..f23d5070849 100644 --- a/modules/priors/DESCRIPTION +++ b/modules/priors/DESCRIPTION @@ -1,13 +1,13 @@ Package: PEcAn.priors Type: Package Title: PEcAn functions used to estimate priors from data -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("David","LeBauer")) Author: David LeBauer Maintainer: David LeBauer Description: Functions to estimate priors from data. -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE @@ -15,8 +15,11 @@ Depends: PEcAn.utils Imports: PEcAn.logger, - ggplot2 + PEcAn.MA, + ggplot2, + MASS Suggests: + PEcAn.visualization, testthat Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/priors/NAMESPACE b/modules/priors/NAMESPACE index b4c0e4c2ae6..02383a261ca 100644 --- a/modules/priors/NAMESPACE +++ b/modules/priors/NAMESPACE @@ -1,23 +1,27 @@ # Generated by roxygen2: do not edit by hand -S3method(plot,posterior.density) -S3method(plot,prior.density) -S3method(plot,trait) export(create.density.df) export(fit.dist) export(get.quantiles.from.density) export(get.sample) +export(plot_densities) +export(plot_posterior.density) +export(plot_prior.density) +export(plot_trait) export(pr.dens) export(pr.samp) export(prior.fn) +export(priorfig) importFrom(ggplot2,aes) importFrom(ggplot2,element_blank) importFrom(ggplot2,element_text) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_rug) +importFrom(ggplot2,geom_segment) importFrom(ggplot2,ggplot) importFrom(ggplot2,labs) importFrom(ggplot2,scale_x_continuous) importFrom(ggplot2,scale_y_continuous) +importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) diff --git a/modules/priors/R/plots.R b/modules/priors/R/plots.R index 9e571bf8353..6146b6a5e40 100644 --- a/modules/priors/R/plots.R +++ b/modules/priors/R/plots.R @@ -1,65 +1,64 @@ ##--------------------------------------------------------------------------------------------------# -##' Plots a prior density from a parameterized probability distribution +##' Plots a prior density from a parameterized probability distribution ##' -##' @name plot.prior.density -##' @title Add Prior Density -##' @param prior.density -##' @param base.plot a ggplot object (grob), created by \code{\link{create.base.plot}} if none provided +##' @param prior.density data frame containing columns x and y +##' @param base.plot a ggplot object (grob), created if none provided ##' @param prior.color color of line to be plotted ##' @return plot with prior density added ##' @seealso \code{\link{pr.dens}} ##' @author David LeBauer ##' @export +##' @aliases plot.prior.density ##' @examples ##' \dontrun{ -##' plot.prior.density(pr.dens('norm', 0, 1)) +##' plot_prior.density(pr.dens('norm', 0, 1)) ##' } -plot.prior.density <- function(prior.density, base.plot = NULL, prior.color = "black") { +plot_prior.density <- function(prior.density, base.plot = NULL, prior.color = "black") { if (is.null(base.plot)) { - base.plot <- create.base.plot() + base.plot <- ggplot2::ggplot() } new.plot <- base.plot + geom_line(data = prior.density, aes(x = x, y = y), color = prior.color) return(new.plot) -} # plot.prior.density +} # plot_prior.density ##--------------------------------------------------------------------------------------------------# ##' Add posterior density to a plot ##' -##' @name plot.posterior.density -##' @title Add posterior density. -##' @param posterior.density -##' @param base.plot a ggplot object (grob), created by \code{\link{create.base.plot}} if none provided +##' @param posterior.density data frame containing columns x and y +##' @param base.plot a ggplot object (grob), created if none provided ##' @return plot with posterior density line added +##' @aliases plot.posterior.density ##' @export ##' @importFrom ggplot2 geom_line aes ##' @author David LeBauer -plot.posterior.density <- function(posterior.density, base.plot = NULL) { +plot_posterior.density <- function(posterior.density, base.plot = NULL) { if (is.null(base.plot)) { - base.plot <- create.base.plot() + base.plot <- ggplot2::ggplot() } new.plot <- base.plot + geom_line(data = posterior.density, aes(x = x, y = y)) return(new.plot) -} # plot.posterior.density +} # plot_posterior.density ##--------------------------------------------------------------------------------------------------# ##' Plot prior density and data ##' ##' @name priorfig -##' @title Prior Figure +##' @title Prior Figure ##' @param priordata observations to be plotted as points ##' @param priordensity density of prior distribution, calculated by \code{\link{prior.density}} ##' @param trait name of trait ##' @param xlim limits for x axis ##' @author David LeBauer -##' @return plot / grob of prior distribution with data used to inform the distribution +##' @return plot / grob of prior distribution with data used to inform the distribution +##' @export ##' @importFrom ggplot2 ggplot aes theme_bw scale_x_continuous scale_y_continuous element_blank element_text geom_rug geom_line geom_point priorfig <- function(priordata = NA, priordensity = NA, trait = "", xlim = "auto", fontsize = 18) { if (is.data.frame(priordata)) { colnames(priordata) <- "x" } - + if (isTRUE(xlim == "auto")) { x.breaks <- pretty(c(signif(priordensity$x, 2)), 4) xlim <- range(x.breaks) @@ -67,27 +66,27 @@ priorfig <- function(priordata = NA, priordensity = NA, trait = "", xlim = "auto x.breaks <- pretty(signif(xlim, 2), 4) xlim <- range(c(x.breaks, xlim)) } - - priorfigure <- ggplot() + theme_bw() + - scale_x_continuous(limits = xlim, breaks = x.breaks, name = trait.lookup(trait)$units) + - scale_y_continuous(breaks = NULL) + - labs(title = trait.lookup(trait)$figid) + + + priorfigure <- ggplot() + theme_bw() + + scale_x_continuous(limits = xlim, breaks = x.breaks, name = PEcAn.utils::trait.lookup(trait)$units) + + scale_y_continuous(breaks = NULL) + + labs(title = PEcAn.utils::trait.lookup(trait)$figid) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), axis.text.y = element_blank(), ## hide y axis label axis.text.x = element_text(size = fontsize), axis.title.y = element_blank(), ## hide y axis label - axis.title.x = element_text(size = fontsize * 0.9), + axis.title.x = element_text(size = fontsize * 0.9), plot.title = element_text(size = fontsize * 1.1)) - + if (is.data.frame(priordata)) { priordata <- subset(priordata, subset = !is.na(x)) dx <- with(priordata, min(abs(diff(x)[diff(x) != 0]))) - ## add jitter to separate equal values + ## add jitter to separate equal values priordata <- transform(priordata, x = x + runif(length(x), -dx / 2, dx / 2)) rug <- geom_rug(data = priordata, aes(x)) priorfigure <- priorfigure + rug - } + } if (is.data.frame(priordensity[1])) { dens.line <- geom_line(data = priordensity, aes(x, y)) qpts <- get.quantiles.from.density(priordensity) @@ -101,28 +100,30 @@ priorfig <- function(priordata = NA, priordensity = NA, trait = "", xlim = "auto ##--------------------------------------------------------------------------------------------------# ##' Plot trait density and data ##' -##' @name plot.trait -##' @title Plot trait density ##' @param trait character, name of trait to be plotted ##' @param prior named distribution with parameters -##' @param posterior.sample -##' @param trait.data -##' @param fontsize +##' @param posterior.sample samples from posterior distribution +##' whose density should be plotted +##' @param trait.df data to be plotted, in a format accepted by +##' \code{\link[PEcAn.MA]{jagify}} +##' @param fontsize,x.lim,y.lim,logx passed on to ggplot ##' @return plot (grob) object ##' @author David LeBauer -##' @importFrom ggplot2 theme_bw aes scale_x_continuous labs element_text element_blank -##' @export +##' @importFrom ggplot2 aes labs element_text element_blank geom_segment +##' scale_x_continuous theme theme_bw +##' @export plot_trait +##' @aliases plot.trait ##' @examples ##' \dontrun{ ##' prior1 <- data.frame(distn = 'norm', ##' parama = 20, ##' paramb = 5) ##' data1 <- data.frame(Y = c(19, 21), se = c(1,1)) -##' plot.trait(trait = 'Vcmax', +##' plot_trait(trait = 'Vcmax', ##' prior = prior1, ##' trait.df = data1) ##' } -plot.trait <- function(trait, +plot_trait <- function(trait, prior = NULL, posterior.sample = NULL, trait.df = NULL, @@ -130,31 +131,37 @@ plot.trait <- function(trait, x.lim = NULL, y.lim = NULL, logx = FALSE) { - + + if (!requireNamespace("PEcAn.visualization", quietly = TRUE)) { + PEcAn.logger::logger.severe( + "plot_trait requires package `PEcAn.visualization`,", + "but it is not installed. Please install it and try again.") + } + ## Determine plot components - plot.posterior <- !is.null(posterior.sample) - plot.prior <- !is.null(prior) - plot.data <- !is.null(trait.df) - + plot_posterior <- !is.null(posterior.sample) + plot_prior <- !is.null(prior) + plot_data <- !is.null(trait.df) + ## get units for plot title - units <- trait.lookup(trait)$units - - if(plot.data) trait.df <- jagify(trait.df) - - if (plot.prior) { - prior.color <- ifelse(plot.posterior, "grey", "black") + units <- PEcAn.utils::trait.lookup(trait)$units + + if(plot_data) trait.df <- PEcAn.MA::jagify(trait.df) + + if (plot_prior) { + prior.color <- ifelse(plot_posterior, "grey", "black") prior.density <- create.density.df(distribution = prior) prior.density <- prior.density[prior.density$x > 0, ] } else { prior.density <- data.frame(x = NA, y = NA) } - if (plot.posterior) { + if (plot_posterior) { posterior.density <- create.density.df(samps = posterior.sample) posterior.density <- posterior.density[posterior.density$x > 0, ] } else { posterior.density <- data.frame(x = NA, y = NA) } - + if (is.null(x.lim)) { if (!is.null(trait.df)) { data.range <- max(c(trait.df$Y, trait.df$Y + trait.df$se), na.rm = TRUE) @@ -166,63 +173,64 @@ plot.trait <- function(trait, if (is.null(y.lim)) { y.lim <- range(posterior.density$y, prior.density$y, na.rm = TRUE) } - - x.ticks <<- pretty(c(0, x.lim[2])) - - base.plot <- create.base.plot() + theme_bw() - if (plot.prior) { - base.plot <- plot.prior.density(prior.density, base.plot = base.plot, prior.color = prior.color) + + x.ticks <- pretty(c(0, x.lim[2])) + + base.plot <- ggplot2::ggplot() + theme_bw() + if (plot_prior) { + base.plot <- plot_prior.density(prior.density, base.plot = base.plot, prior.color = prior.color) } - if (plot.posterior) { - base.plot <- plot.posterior.density(posterior.density, base.plot = base.plot) + if (plot_posterior) { + base.plot <- plot_posterior.density(posterior.density, base.plot = base.plot) } - if (plot.data) { - base.plot <- plot_data(trait.df, base.plot = base.plot, ymax = y.lim[2]) + if (plot_data) { + base.plot <- PEcAn.visualization::plot_data(trait.df, base.plot = base.plot, ymax = y.lim[2]) } - - trait.plot <- base.plot + - geom_segment(aes(x = min(x.ticks), xend = last(x.ticks), y = 0, yend = 0)) + - scale_x_continuous(limits = range(x.ticks), breaks = x.ticks, name = trait.lookup(trait)$units) + - labs(title = trait.lookup(trait)$figid) + - theme(axis.text.x = element_text(size = fontsize$axis), - axis.text.y = element_blank(), - axis.title.x = element_text(size = fontsize$axis), - axis.title.y = element_blank(), - axis.ticks.y = element_blank(), - axis.line.y = element_blank(), - legend.position = "none", - plot.title = element_text(size = fontsize$title), - panel.grid.major = element_blank(), - panel.grid.minor = element_blank(), + + trait.plot <- base.plot + + geom_segment(aes(x = min(x.ticks), xend = last(x.ticks), y = 0, yend = 0)) + + scale_x_continuous(limits = range(x.ticks), breaks = x.ticks, name = PEcAn.utils::trait.lookup(trait)$units) + + labs(title = PEcAn.utils::trait.lookup(trait)$figid) + + theme(axis.text.x = element_text(size = fontsize$axis), + axis.text.y = element_blank(), + axis.title.x = element_text(size = fontsize$axis), + axis.title.y = element_blank(), + axis.ticks.y = element_blank(), + axis.line.y = element_blank(), + legend.position = "none", + plot.title = element_text(size = fontsize$title), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), panel.border = element_blank()) return(trait.plot) -} # plot.trait +} # plot_trait ##--------------------------------------------------------------------------------------------------# ##' Plot probability density and data ##' -##' @name plot.densities -##' @title Plot Trait Probability Densities -##' @param sensitivity.results list containing sa.samples and sa.splines -##' @param outdir directory in which to generate figure as pdf +##' @export +##' @aliases plot.densities +##' @param density.plot_inputs list containing trait.samples and trait.df +##' @param ... passed on to plot_density +##' @param outdir directory in which to generate figure as pdf ##' @author David LeBauer -##' @return outputs plots in outdir/sensitivity.analysis.pdf file -plot.densities <- function(density.plot.inputs, outdir, ...) { - trait.samples <- density.plot.inputs$trait.samples - trait.df <- density.plot.inputs$trait.df - prior.trait.samples <- density.plot.inputs$trait.df - +##' @return outputs plots in outdir/sensitivity.analysis.pdf file +plot_densities <- function(density.plot_inputs, outdir, ...) { + trait.samples <- density.plot_inputs$trait.samples + trait.df <- density.plot_inputs$trait.df + prior.trait.samples <- density.plot_inputs$trait.df + traits <- names(trait.samples) - pdf(paste0(outdir, "trait.densities.pdf"), height = 12, width = 20) - + grDevices::pdf(paste0(outdir, "trait.densities.pdf"), height = 12, width = 20) + for (trait in traits) { - density.plot <- plot.density(trait.sample = trait.samples[, trait], + density.plot <- plot_density(trait.sample = trait.samples[, trait], trait.df = trait.df[[trait]], ...) - print(sensitivity.plot) + print(density.plot) } - dev.off() -} # plot.densities + grDevices::dev.off() +} # plot_densities ##--------------------------------------------------------------------------------------------------# @@ -233,7 +241,7 @@ plot.densities <- function(density.plot.inputs, outdir, ...) { ##' @param priordensity density dataframe generated by \code{\link{create.density.df}} ##' @param quantiles default is the median and 95\% CI; ##' @author David LeBauer -##' @export +##' @export get.quantiles.from.density ##' @examples ##' prior.df <- create.density.df(distribution = list('norm',0,1)) ##' get.quantiles.from.density(prior.df) diff --git a/modules/priors/R/priors.R b/modules/priors/R/priors.R index 2cd8e0473dd..406b31cad6b 100644 --- a/modules/priors/R/priors.R +++ b/modules/priors/R/priors.R @@ -19,33 +19,33 @@ fit.dist <- function(trait.data, trait = colnames(trait.data), dists = c("weibull", "lognormal", "gamma"), n = NULL) { - if (class(trait.data) == "data.frame") { + if (inherits(trait.data, "data.frame")) { trait.data <- trait.data[, 1] } ## warning(immediate. = TRUE) nostart.dists <- dists[dists %in% c("weibull", "lognormal", "gamma", "normal")] - a <- lapply(nostart.dists, function(x) suppressWarnings(fitdistr(trait.data, x))) + a <- lapply(nostart.dists, function(x) suppressWarnings(MASS::fitdistr(trait.data, x))) names(a) <- nostart.dists if ("f" %in% dists) { print(trait) if (trait == "tt") { - a[["f"]] <- suppressWarnings(fitdistr(trait.data, "f", + a[["f"]] <- suppressWarnings(MASS::fitdistr(trait.data, "f", start = list(df1 = 100, df2 = 200))) } else if (trait == "sla") { - a[["f"]] <- suppressWarnings(fitdistr(trait.data, "f", + a[["f"]] <- suppressWarnings(MASS::fitdistr(trait.data, "f", start = list(df1 = 6, df2 = 1))) } else if (trait == "rrr") { - a[["f"]] <- suppressWarnings(fitdistr(trait.data, "f", + a[["f"]] <- suppressWarnings(MASS::fitdistr(trait.data, "f", start = list(df1 = 6, df2 = 1))) } else if (trait == "q") { - a[["f"]] <- suppressWarnings(fitdistr(trait.data, "f", + a[["f"]] <- suppressWarnings(MASS::fitdistr(trait.data, "f", start = list(df1 = 1, df2 = 2))) } else { PEcAn.logger::logger.severe(paste(trait, "not supported!")) } } if ("beta" %in% dists) { - a[["beta"]] <- suppressWarnings(fitdistr(trait.data, "beta", + a[["beta"]] <- suppressWarnings(MASS::fitdistr(trait.data, "beta", start = list(shape1 = 2, shape2 = 1))) } aicvalues <- lapply(a, AIC) @@ -182,14 +182,37 @@ pr.samp <- function(distn, parama, paramb, n) { #--------------------------------------------------------------------------------------------------# ##' Take n random samples from prior ##' -##' Like pr.samp, with prior as a single input +##' Similar to the prior sample function \link{pr.samp}, except 1) it takes the prior as a named dataframe +##' or list and it can return either a random sample of length n OR a sample from a quantile specified as p ##' @title Get Samples -##' @param prior data.frame with distn, parama, paramb -##' @param n number of samples to return +##' @param prior data.frame with distn, parama, and optionally paramb. +##' @param n number of samples to return from a random sample of the rdistn family of functions (e.g. rnorm) +##' @param p vector of quantiles from which to sample the distribution; typically pre-generated upstream +##' in the workflow to be used by the qdistn family of functions (e.g. qnorm) ##' @return vector with n random samples from prior ##' @seealso \link{pr.samp} +##' @examples +##' \dontrun{ +##' # return 1st through 99th quantile of standard normal distribution: +##' PEcAn.priors::get.sample( +##' prior = data.frame(distn = 'norm', parama = 0, paramb = 1), +##' p = 1:99/100) +##' # return 100 random samples from standard normal distribution: +##' PEcAn.priors::get.sample( +##' prior = data.frame(distn = 'norm', parama = 0, paramb = 1), +##' n = 100) +##' } ##' @export -get.sample <- function(prior, n) { +get.sample <- function(prior, n = NULL, p = NULL) { + if(!is.null(p)){ + if (as.character(prior$distn) %in% c("exp", "pois", "geom")) { + ## one parameter distributions + return(do.call(paste0("q", prior$distn), list(p, prior$parama))) + } else { + ## two parameter distributions + return(do.call(paste0("q", prior$distn), list(p, prior$parama, prior$paramb))) + } + } if (as.character(prior$distn) %in% c("exp", "pois", "geom")) { ## one parameter distributions return(do.call(paste0("r", prior$distn), list(n, prior$parama))) diff --git a/modules/priors/man/create.density.df.Rd b/modules/priors/man/create.density.df.Rd index 019e94588d5..e75896b36b7 100644 --- a/modules/priors/man/create.density.df.Rd +++ b/modules/priors/man/create.density.df.Rd @@ -4,8 +4,13 @@ \alias{create.density.df} \title{Create Density Data Frame from Sample} \usage{ -create.density.df(samps = NULL, zero.bounded = FALSE, - distribution = NULL, n = 1000, ...) +create.density.df( + samps = NULL, + zero.bounded = FALSE, + distribution = NULL, + n = 1000, + ... +) } \arguments{ \item{samps}{a vector of samples from a distribution} diff --git a/modules/priors/man/fit.dist.Rd b/modules/priors/man/fit.dist.Rd index 2df8e8c93d9..3f7e518743a 100644 --- a/modules/priors/man/fit.dist.Rd +++ b/modules/priors/man/fit.dist.Rd @@ -4,8 +4,12 @@ \alias{fit.dist} \title{Fit distribution to data} \usage{ -fit.dist(trait.data, trait = colnames(trait.data), dists = c("weibull", - "lognormal", "gamma"), n = NULL) +fit.dist( + trait.data, + trait = colnames(trait.data), + dists = c("weibull", "lognormal", "gamma"), + n = NULL +) } \arguments{ \item{trait.data}{data for distribution} diff --git a/modules/priors/man/get.sample.Rd b/modules/priors/man/get.sample.Rd index c62f5dea45f..c3dc313f4ef 100644 --- a/modules/priors/man/get.sample.Rd +++ b/modules/priors/man/get.sample.Rd @@ -4,12 +4,15 @@ \alias{get.sample} \title{Get Samples} \usage{ -get.sample(prior, n) +get.sample(prior, n = NULL, p = NULL) } \arguments{ -\item{prior}{data.frame with distn, parama, paramb} +\item{prior}{data.frame with distn, parama, and optionally paramb.} -\item{n}{number of samples to return} +\item{n}{number of samples to return from a random sample of the rdistn family of functions (e.g. rnorm)} + +\item{p}{vector of quantiles from which to sample the distribution; typically pre-generated upstream +in the workflow to be used by the qdistn family of functions (e.g. qnorm)} } \value{ vector with n random samples from prior @@ -18,7 +21,20 @@ vector with n random samples from prior Take n random samples from prior } \details{ -Like pr.samp, with prior as a single input +Similar to the prior sample function \link{pr.samp}, except 1) it takes the prior as a named dataframe +or list and it can return either a random sample of length n OR a sample from a quantile specified as p +} +\examples{ +\dontrun{ +# return 1st through 99th quantile of standard normal distribution: +PEcAn.priors::get.sample( + prior = data.frame(distn = 'norm', parama = 0, paramb = 1), + p = 1:99/100) +# return 100 random samples from standard normal distribution: +PEcAn.priors::get.sample( + prior = data.frame(distn = 'norm', parama = 0, paramb = 1), + n = 100) +} } \seealso{ \link{pr.samp} diff --git a/modules/priors/man/plot.posterior.density.Rd b/modules/priors/man/plot.posterior.density.Rd deleted file mode 100644 index 7a7608b8fed..00000000000 --- a/modules/priors/man/plot.posterior.density.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plots.R -\name{plot.posterior.density} -\alias{plot.posterior.density} -\title{Add posterior density.} -\usage{ -\method{plot}{posterior.density}(posterior.density, base.plot = NULL) -} -\arguments{ -\item{posterior.density}{} - -\item{base.plot}{a ggplot object (grob), created by \code{\link{create.base.plot}} if none provided} -} -\value{ -plot with posterior density line added -} -\description{ -Add posterior density to a plot -} -\author{ -David LeBauer -} diff --git a/modules/priors/man/plot.densities.Rd b/modules/priors/man/plot_densities.Rd similarity index 57% rename from modules/priors/man/plot.densities.Rd rename to modules/priors/man/plot_densities.Rd index f36c6882532..53a5cd7b6d6 100644 --- a/modules/priors/man/plot.densities.Rd +++ b/modules/priors/man/plot_densities.Rd @@ -1,15 +1,18 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plots.R -\name{plot.densities} +\name{plot_densities} +\alias{plot_densities} \alias{plot.densities} -\title{Plot Trait Probability Densities} +\title{Plot probability density and data} \usage{ -\method{plot}{densities}(density.plot.inputs, outdir, ...) +plot_densities(density.plot_inputs, outdir, ...) } \arguments{ +\item{density.plot_inputs}{list containing trait.samples and trait.df} + \item{outdir}{directory in which to generate figure as pdf} -\item{sensitivity.results}{list containing sa.samples and sa.splines} +\item{...}{passed on to plot_density} } \value{ outputs plots in outdir/sensitivity.analysis.pdf file diff --git a/modules/priors/man/plot_posterior.density.Rd b/modules/priors/man/plot_posterior.density.Rd new file mode 100644 index 00000000000..baad7ef7beb --- /dev/null +++ b/modules/priors/man/plot_posterior.density.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plots.R +\name{plot_posterior.density} +\alias{plot_posterior.density} +\alias{plot.posterior.density} +\title{Add posterior density to a plot} +\usage{ +plot_posterior.density(posterior.density, base.plot = NULL) +} +\arguments{ +\item{posterior.density}{data frame containing columns x and y} + +\item{base.plot}{a ggplot object (grob), created if none provided} +} +\value{ +plot with posterior density line added +} +\description{ +Add posterior density to a plot +} +\author{ +David LeBauer +} diff --git a/modules/priors/man/plot.prior.density.Rd b/modules/priors/man/plot_prior.density.Rd similarity index 51% rename from modules/priors/man/plot.prior.density.Rd rename to modules/priors/man/plot_prior.density.Rd index 71b09823ca3..cc1e841c1f3 100644 --- a/modules/priors/man/plot.prior.density.Rd +++ b/modules/priors/man/plot_prior.density.Rd @@ -1,16 +1,16 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plots.R -\name{plot.prior.density} +\name{plot_prior.density} +\alias{plot_prior.density} \alias{plot.prior.density} -\title{Add Prior Density} +\title{Plots a prior density from a parameterized probability distribution} \usage{ -\method{plot}{prior.density}(prior.density, base.plot = NULL, - prior.color = "black") +plot_prior.density(prior.density, base.plot = NULL, prior.color = "black") } \arguments{ -\item{prior.density}{} +\item{prior.density}{data frame containing columns x and y} -\item{base.plot}{a ggplot object (grob), created by \code{\link{create.base.plot}} if none provided} +\item{base.plot}{a ggplot object (grob), created if none provided} \item{prior.color}{color of line to be plotted} } @@ -22,7 +22,7 @@ Plots a prior density from a parameterized probability distribution } \examples{ \dontrun{ -plot.prior.density(pr.dens('norm', 0, 1)) +plot_prior.density(pr.dens('norm', 0, 1)) } } \seealso{ diff --git a/modules/priors/man/plot.trait.Rd b/modules/priors/man/plot_trait.Rd similarity index 52% rename from modules/priors/man/plot.trait.Rd rename to modules/priors/man/plot_trait.Rd index ba36d3ae116..3ba950c0720 100644 --- a/modules/priors/man/plot.trait.Rd +++ b/modules/priors/man/plot_trait.Rd @@ -1,23 +1,33 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plots.R -\name{plot.trait} +\name{plot_trait} +\alias{plot_trait} \alias{plot.trait} -\title{Plot trait density} +\title{Plot trait density and data} \usage{ -\method{plot}{trait}(trait, prior = NULL, posterior.sample = NULL, - trait.df = NULL, fontsize = list(title = 18, axis = 14), - x.lim = NULL, y.lim = NULL, logx = FALSE) +plot_trait( + trait, + prior = NULL, + posterior.sample = NULL, + trait.df = NULL, + fontsize = list(title = 18, axis = 14), + x.lim = NULL, + y.lim = NULL, + logx = FALSE +) } \arguments{ \item{trait}{character, name of trait to be plotted} \item{prior}{named distribution with parameters} -\item{posterior.sample}{} +\item{posterior.sample}{samples from posterior distribution +whose density should be plotted} -\item{fontsize}{} +\item{trait.df}{data to be plotted, in a format accepted by +\code{\link[PEcAn.MA]{jagify}}} -\item{trait.data}{} +\item{fontsize, x.lim, y.lim, logx}{passed on to ggplot} } \value{ plot (grob) object @@ -31,7 +41,7 @@ prior1 <- data.frame(distn = 'norm', parama = 20, paramb = 5) data1 <- data.frame(Y = c(19, 21), se = c(1,1)) -plot.trait(trait = 'Vcmax', +plot_trait(trait = 'Vcmax', prior = prior1, trait.df = data1) } diff --git a/modules/priors/man/priorfig.Rd b/modules/priors/man/priorfig.Rd index 0f703484cba..ff502cbd956 100644 --- a/modules/priors/man/priorfig.Rd +++ b/modules/priors/man/priorfig.Rd @@ -4,8 +4,13 @@ \alias{priorfig} \title{Prior Figure} \usage{ -priorfig(priordata = NA, priordensity = NA, trait = "", - xlim = "auto", fontsize = 18) +priorfig( + priordata = NA, + priordensity = NA, + trait = "", + xlim = "auto", + fontsize = 18 +) } \arguments{ \item{priordata}{observations to be plotted as points} diff --git a/modules/priors/tests/Rcheck_reference.log b/modules/priors/tests/Rcheck_reference.log new file mode 100644 index 00000000000..44d5de3d27b --- /dev/null +++ b/modules/priors/tests/Rcheck_reference.log @@ -0,0 +1,137 @@ +* using log directory ‘/tmp/RtmprUKFes/PEcAn.priors.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.priors/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.priors’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.priors’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... NOTE +Package in Depends field not imported from: ‘PEcAn.utils’ + These packages need to be imported from (in the NAMESPACE file) + for when this namespace is loaded but not attached. +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +create.density.df: no visible global function definition for + ‘zero.bounded.density’ +create.density.df: no visible global function definition for ‘density’ +fit.dist : : no visible global function definition for + ‘fitdistr’ +fit.dist: no visible global function definition for ‘fitdistr’ +fit.dist: no visible binding for global variable ‘AIC’ +fit.dist : : no visible global function definition for + ‘tabnum’ +fit.dist: no visible global function definition for ‘tabnum’ +plot_densities: no visible global function definition for + ‘plot_density’ +plot_posterior.density: no visible binding for global variable ‘x’ +plot_posterior.density: no visible binding for global variable ‘y’ +plot_prior.density: no visible binding for global variable ‘x’ +plot_prior.density: no visible binding for global variable ‘y’ +plot_trait: no visible global function definition for ‘last’ +prior.fn: no visible global function definition for ‘qnorm’ +prior.fn: no visible global function definition for ‘qlnorm’ +prior.fn: no visible global function definition for ‘qgamma’ +prior.fn: no visible global function definition for ‘qweibull’ +prior.fn: no visible global function definition for ‘qbeta’ +priorfig: no visible global function definition for ‘theme’ +priorfig: no visible binding for global variable ‘x’ +priorfig: no visible global function definition for ‘runif’ +priorfig: no visible binding for global variable ‘y’ +Undefined global functions or variables: + AIC density fitdistr + last plot_density qbeta qgamma qlnorm qnorm qweibull + runif sensitivity.plot tabnum theme x y + zero.bounded.density +Consider adding + importFrom("stats", "AIC", "density", "qbeta", "qgamma", "qlnorm", + "qnorm", "qweibull", "runif") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... WARNING +Missing link or links in documentation object 'create.density.df.Rd': + ‘stats::density’ + +Missing link or links in documentation object 'prior.fn.Rd': + ‘DEoptim’ + +Missing link or links in documentation object 'priorfig.Rd': + ‘prior.density’ + +See section 'Cross-references' in the 'Writing R Extensions' manual. + +* checking for missing documentation entries ... OK +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'create.density.df' + ‘n’ ‘...’ + +Undocumented arguments in documentation object 'fit.dist' + ‘trait’ ‘n’ + +Undocumented arguments in documentation object 'get.quantiles.from.density' + ‘density.df’ +Documented arguments not in \usage in documentation object 'get.quantiles.from.density': + ‘priordensity’ + +Undocumented arguments in documentation object 'priorfig' + ‘fontsize’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'create.density.df': + ‘zero.bounded’ + +Argument items with no description in Rd object 'plot_trait': + ‘posterior.sample’ ‘trait.df’ + +Argument items with no description in Rd object 'pr.samp': + ‘distn’ ‘parama’ ‘paramb’ + +* checking for unstated dependencies in examples ... OK +* checking files in ‘vignettes’ ... WARNING +Files in the 'vignettes' directory but no files in 'inst/doc': + ‘priors_demo.Rmd’ +Package has no Sweave vignette sources and no VignetteBuilder field. +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 5 WARNINGs, 3 NOTEs diff --git a/modules/priors/tests/testthat/test.priors.R b/modules/priors/tests/testthat/test.priors.R index b1aeadc2e10..2519e62e18c 100644 --- a/modules/priors/tests/testthat/test.priors.R +++ b/modules/priors/tests/testthat/test.priors.R @@ -40,6 +40,6 @@ test_that("get.quantiles.from.density works", { expect_equal(dim(test.q), c(3,2)) }) -test_that("plot.prior.density returns ggplot object",{ - expect_is(plot.prior.density(pr.dens('norm', 0, 1)), "ggplot") +test_that("plot_prior.density returns ggplot object",{ + expect_is(plot_prior.density(pr.dens('norm', 0, 1)), "ggplot") }) diff --git a/modules/priors/vignettes/priors_demo.Rmd b/modules/priors/vignettes/priors_demo.Rmd index 01f79928493..b54ddbb2ef8 100644 --- a/modules/priors/vignettes/priors_demo.Rmd +++ b/modules/priors/vignettes/priors_demo.Rmd @@ -6,9 +6,14 @@ Fitting priors to data (point estimates, all grass species in GLOPNET). ------------------------- ### Example: Specific Leaf Area based on all grasses + +First we are going to set up initial values. + ```{r echo=FALSE, warning=FALSE, results='hide', message=FALSE} library(PEcAn.priors) library(DEoptim) +library(dplyr) + set.seed(1) iter <-10000 #jags chain and misc simulation length; 1k for test, 10k for real inits <- list(list(.RNG.seed = 1, @@ -24,17 +29,32 @@ inits <- list(list(.RNG.seed = 1, ### MLE Fit to glopnet Specific Leaf Area data -fit.dist function is in `PEcAn.priors::fit.dist` (See source code: https://github.com/PecanProject/pecan/blob/master/modules/priors/R/priors.R) +The [`PEcAn.priors::fit.dist`](https://github.com/PecanProject/pecan/blob/master/modules/priors/R/priors.R) helps to choose the best fit parameter distribution given some sample datasets. ```r devtools::install_github("pecanproject/pecan/modules/priors") ``` -```{r echo=FALSE, warning=FALSE, results='hide', message=FALSE, cache=TRUE} +```{r echo=FALSE, warning=FALSE, results='hide', message=FALSE, cache=TRUE, fig.width=8} # devtools::install("pecanproject/pecan/modules/priors") -glopnet.data <- read.csv('inst/extdata/glopnet.csv') # Wright et. al. 2004 supplementary file +glopnet.data <- read.csv(system.file('extdata/glopnet.csv', package = 'PEcAn.priors')) # Wright et. al. 2004 supplementary file + +library(ggplot2) +ggplot(glopnet.data, aes(color = GF)) + + geom_boxplot(aes(x = BIOME, y = 1000/10^log.LMA)) + + ylab("Specific Leaf Area") + + theme_bw() +ggplot(glopnet.data %>% subset(GF == 'G'),aes(x = BIOME, y = 1000/10^log.LMA)) + + geom_boxplot() + + geom_point(alpha = 0.25) + + ylab("Specific Leaf Area") + + theme_bw() +``` + + +```{r} glopnet.grass <- glopnet.data[which(glopnet.data$GF == 'G'), ] # GF = growth form; G=grass ## turnover time (tt) @@ -44,52 +64,46 @@ ttdata <- data.frame(tt = glopnet.grass$tt[!is.na(glopnet.grass$tt)]) ##glopnet.grass$sla <- 1000/ (0.48 * 10^glopnet.grass$log.LMA) glopnet.grass$sla <- 1000/ (10^glopnet.grass$log.LMA) sladata <- data.frame(sla = glopnet.grass$sla[!is.na(glopnet.grass$sla)]) - - -dists <- c('gamma', 'lognormal','weibull', 'f') -fit.dist <- PEcAn.priors::fit.dist -prior.dists <- rbind('SLA' = fit.dist(sladata, dists ), - 'leaf_turnover_rate' = fit.dist(ttdata, dists)) - -slaprior <- with(prior.dists['SLA',], prior.density(distribution, a, b)) -ttprior <- with(prior.dists['leaf_turnover_rate',], prior.density(distribution, a, b)) - -prior.figures[['SLA']] <- priorfig(priordata = sladata, - priordensity = slaprior, - trait = 'SLA') -prior.figures[['leaf_turnover_rate']] <- priorfig(priordata = ttdata, - priordensity = ttprior, - trait = 'leaf_turnover_rate') ``` + The `fit.dist` function takes a vector of point estimates (in this case 125 observations of Specific Leaf Area from GLOPNET database are stored in `sladata`. First, it prints out the fits of a subset of distributions (the 'f' distribution could not be fit). Second, it prints the ```{r} -dists = c('gamma', 'lognormal','weibull', 'f') +dists <- c('gamma', 'lognormal','weibull', 'f') +library(fitdistrplus) fit.dist(sladata, dists ) +``` +```{r} + +prior.dists <- rbind('SLA' = fit.dist(sladata, dists ), + 'leaf_turnover_rate' = fit.dist(ttdata, dists)) + +slaprior <- with(prior.dists['SLA',], pr.dens(distribution, a, b)) +ttprior <- with(prior.dists['leaf_turnover_rate',], pr.dens(distribution, a, b)) ``` + The `priorfig` function visualizes the chosen prior (line), with its mean and 95\%CI (dots) as well as the data used to generate the figure. +```{r} +prior.figures <- list() +prior.figures[['SLA']] <- priorfig(priordata = sladata, + priordensity = slaprior, + trait = 'SLA') +prior.figures[['leaf_turnover_rate']] <- priorfig(priordata = ttdata, + priordensity = ttprior, + trait = 'leaf_turnover_rate') -```{r fig.width=7, fig.height=3, results='markup'} -## priorfig(priordata = sladata, -## priordensity = slaprior, -## trait = 'SLA') -print(prior.figures$SLA) +prior.figures ``` - Fitting priors to data with uncertainty estimates (generating posterior predictive distribution of an unobserved C4 grass species based on values collected from many PFTs. ------------------------- ### Vcmax data from Wullschleger (1993) -```{r} -wullschleger.data <- read.csv('inst/extdata/wullschleger1993updated.csv') -``` - ### Classify Wullschleger Data into Functional Types ########### #### 1. query functional types from BETY @@ -108,7 +122,9 @@ write.csv(functional.data, 'inst/extdata/wullschleger_join_usdaplants.csv') Picking up with the Wullschleger dataset joined to USDA Plants functional type classifications ... ```{r pft_wullschleger} -functional.data <- read.csv('inst/extdata/wullschleger_join_usdaplants.csv') + +wullschleger.data <- read.csv(system.file('extdata/wullschleger1993updated.csv', package = 'PEcAn.priors')) +functional.data <- read.csv(system.file('extdata/wullschleger_join_usdaplants.csv', package = 'PEcAn.priors')) subshrubs <- rownames(wullschleger.data) %in% c(grep('Shrub',wullschleger.data$GrowthHabit), grep('Subshrub', wullschleger.data$GrowthHabit)) ########## 2. Merge functional type information into Wullschleger data @@ -160,13 +176,13 @@ wullschleger.data <- data.frame(Y = wullschleger.data$corrected.vcmax, ft = wullschleger.data$functional.type, n = wullschleger.data$neff) ## Summarize data by species -wullschleger.vcmax <- ddply(wullschleger.data, - .(sp), - summarise, - Y = mean(Y), - obs.prec = 1/sqrt(sum((1/obs.prec)^2)), - ft = mean(ft), # identity - n = sum(n)) [,-1] +wullschleger.vcmax <- wullschleger.data %>% + group_by(sp) %>% + summarise(Y = mean(Y), + obs.prec = 1/sqrt(sum((1/obs.prec)^2)), + ft = mean(ft), # identity + n = sum(n)) %>% + dplyr::select(-sp) ``` @@ -223,7 +239,13 @@ all.vcmax.data <- rbind(wullschleger.vcmax, ##### take a look at the raw data by functional type: ```{r} -qplot(data = all.vcmax.data, x = factor(ft), y = Y, geom = 'boxplot') + +ggplot(data = all.vcmax.data, aes(factor(ft), Y)) + + geom_boxplot() + + geom_point() + + xlab('Plant Functional Type') + + ylab('Vcmax') + + theme_bw() ``` ##### Add unobserved C4 species so JAGS calculates posterior predictive distribution ```{r} @@ -254,6 +276,7 @@ writeLines(con = "vcmax.prior.bug", diff <- beta.ft[1] - beta.ft[2] }") +library(rjags) j.model <- jags.model(file = "vcmax.prior.bug", data = vcmax.data, n.adapt = 500, @@ -267,7 +290,7 @@ pi.pavi <- data.frame(vcmax = unlist(mcmc.o[,'pi.pavi'])) vcmax.dist <- fit.dist(pi.pavi, n = sum(!is.na(vcmax.data$Y))) prior.dists <- rbind(prior.dists, 'Vcmax' = vcmax.dist) -vcmax.density <- with(vcmax.dist, prior.density(distribution, a, b), xlim = c(0,50)) +vcmax.density <- with(vcmax.dist, pr.dens(distribution, a, b), xlim = c(0,50)) ######### Vcmax Prior Plot vcmax.c4 <- all.vcmax.data$ft == 2 @@ -299,19 +322,13 @@ print(prior.figures[['Vcmax']]) ``` -Fitting priors to expert constraint (). -------------------------- -### Example: Minimum temperature of Photosynthesis - -```{r } -TBD -``` +Fitting priors to expert constraint. ## Other Examples / Approaches ### Examples -* Estimating priors for the DALEC model in [models/dalec/inst/DALEC_priors.R](https://github.com/PecanProject/pecan/blob/master/models/dalec/inst/DALEC_priors.R +* Estimating priors for the DALEC model in [models/dalec/inst/DALEC_priors.R](https://github.com/PecanProject/pecan/blob/master/models/dalec/inst/DALEC_priors.R) ### Package `rriskDistributions` diff --git a/modules/rtm/DESCRIPTION b/modules/rtm/DESCRIPTION index 26854e480e0..5006b51c480 100644 --- a/modules/rtm/DESCRIPTION +++ b/modules/rtm/DESCRIPTION @@ -1,8 +1,8 @@ Package: PEcAnRTM Type: Package Title: PEcAn functions used for radiative transfer modeling -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("Shawn", "Serbin"), person("Alexey", "Shiklomanov")) @@ -29,11 +29,11 @@ Suggests: knitr, pwr OS_type: unix -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 VignetteBuilder: knitr Roxygen: list(markdown = TRUE) -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/rtm/R/bayestools.R b/modules/rtm/R/bayestools.R index 974f3e33da6..2730dc8020d 100644 --- a/modules/rtm/R/bayestools.R +++ b/modules/rtm/R/bayestools.R @@ -38,7 +38,7 @@ rtm_loglike <- function(nparams, model, observed, lag.max = NULL, verbose = TRUE bt_check_convergence <- function(samples, threshold = 1.1, use_CI = TRUE, use_mpsrf = TRUE) { i <- ifelse(use_CI, 2, 1) gelman <- try(BayesianTools::gelmanDiagnostics(samples)) - if (class(gelman) == 'try-error') { + if (inherits(gelman, "try-error")) { message('Error trying to calculate gelman diagnostic. Assuming no convergence') return(FALSE) } @@ -171,7 +171,7 @@ invert_bt <- function(observed, model, prior, custom_settings = list(), loglike # `file.create` returns FALSE if target directory doesn't exist. stopifnot(file.create(save_progress)) } - stopifnot('prior' %in% class(prior)) + stopifnot(inherits(prior, "prior")) test_samp <- prior$sampler() param_names <- names(test_samp) if (is.null(param_names)) { diff --git a/modules/rtm/R/check.convergence.R b/modules/rtm/R/check.convergence.R index d1f8c4001de..4ab6a543e62 100644 --- a/modules/rtm/R/check.convergence.R +++ b/modules/rtm/R/check.convergence.R @@ -20,7 +20,7 @@ check.convergence <- function(jags_out, stop("Input needs to be of class 'mcmc.list'") } gd <- try(coda::gelman.diag(jags_out, ...)) - if (class(gd) == "try-error") { + if (inherits(gd, "try-error")) { warning("Could not calculate Gelman diag. Assuming no convergence.") converged <- FALSE diagnostics <- NULL diff --git a/modules/rtm/R/edr.wrapper.R b/modules/rtm/R/edr.wrapper.R index fe092782063..c0465956533 100644 --- a/modules/rtm/R/edr.wrapper.R +++ b/modules/rtm/R/edr.wrapper.R @@ -145,7 +145,7 @@ EDR <- function(img_path, oldwd <- getwd() setwd(output.path) - on.exit(setwd(oldwd)) + on.exit(setwd(oldwd), add = TRUE) if (!is.null(img_path)) { ex <- PEcAn.ED2::run_ed_singularity( diff --git a/modules/rtm/R/fortran.datamodule.R b/modules/rtm/R/fortran.datamodule.R index 1941641830c..2e6eb1bd6ee 100644 --- a/modules/rtm/R/fortran.datamodule.R +++ b/modules/rtm/R/fortran.datamodule.R @@ -22,14 +22,16 @@ #' z <- seq(exp(1), pi, length.out=42) #' l <- list(x=x, y=y, z=z) ## NOTE that names must be explicitly declared #' l.types <- c('real','integer', 'real*4', 'real*8') -#' fortran_data_module(l, l.types, 'testmod') -#' +#' fortran_data_module(l, l.types, 'testmod', +#' file.path(tempdir(), "testmod.f90")) +#' #' x <- runif(10) #' y <- rnorm(10) #' z <- rgamma(10, 3) #' d <- data.frame(x,y,z) ## NOTE that data.frames are just named lists #' d.types <- rep('real*8', ncol(d)) -#' fortran_data_module(d, d.types, 'random') +#' fortran_data_module(d, d.types, 'random', +#' file.path(tempdir(), "random.f90")) #' @export fortran_data_module <- function(dat, types, modname, fname = paste0(modname, ".f90")) { if (!is.list(dat)) { diff --git a/modules/rtm/R/invert.auto.R b/modules/rtm/R/invert.auto.R index d27508e8150..87968717ac7 100644 --- a/modules/rtm/R/invert.auto.R +++ b/modules/rtm/R/invert.auto.R @@ -135,7 +135,7 @@ invert.auto <- function(observed, invert.options, } } cl <- parallel::makeCluster(parallel.cores, "FORK", outfile = parallel.output) - on.exit(parallel::stopCluster(cl)) + on.exit(parallel::stopCluster(cl), add = TRUE) # Initialize random seeds on cluster. # Otherwise, chains may start on same seed and end up identical. diff --git a/modules/rtm/R/invert.custom.R b/modules/rtm/R/invert.custom.R index c19507e43db..2eef1dfa089 100644 --- a/modules/rtm/R/invert.custom.R +++ b/modules/rtm/R/invert.custom.R @@ -253,7 +253,7 @@ invert.custom <- function(observed, invert.options, if (samp) { if (catch_error) { TrySpec <- try(model(tvec, runID)) - if (class(TrySpec) == "try-error") { + if (inherits(TrySpec, "try-error")) { warning("Model hit an error. Skipping to next iteration") samp <- FALSE } diff --git a/modules/rtm/man/EDR.Rd b/modules/rtm/man/EDR.Rd index 68d65608f36..2bcb2daa470 100644 --- a/modules/rtm/man/EDR.Rd +++ b/modules/rtm/man/EDR.Rd @@ -4,15 +4,26 @@ \alias{EDR} \title{ED radiative transfer module (EDR) wrapper function} \usage{ -EDR(img_path, ed2in_path, spectra_list, trait.values, - soil_reflect_path = system.file("extdata", "soil_reflect_par.dat", - package = "PEcAnRTM"), wood_reflect_path = system.file("extdata", - "wood_reflect_par.dat", package = "PEcAnRTM"), par.wl = 400:2499, - nir.wl = 2500, edr_exe_path = NULL, +EDR( + img_path, + ed2in_path, + spectra_list, + trait.values, + soil_reflect_path = system.file("extdata", "soil_reflect_par.dat", package = + "PEcAnRTM"), + wood_reflect_path = system.file("extdata", "wood_reflect_par.dat", package = + "PEcAnRTM"), + par.wl = 400:2499, + nir.wl = 2500, + edr_exe_path = NULL, output.path = dirname(normalizePath(ed2in_path, mustWork = TRUE)), settings = list(model = list(revision = "git", config.header = NULL)), - singularity_args = list(), clean = FALSE, stderr = TRUE, - verbose_error = TRUE, ...) + singularity_args = list(), + clean = FALSE, + stderr = TRUE, + verbose_error = TRUE, + ... +) } \arguments{ \item{img_path}{Path to Singularity container (usually a \code{.simg} file)} @@ -49,7 +60,7 @@ executable. Ignored otherwise.} \item{settings}{PEcAn settings list. Default is \code{list(model = list(revision = "git", config.header = NULL))}.} -\item{singularity_args}{Additional arguments to be passed to \code{singularity run} (before)} +\item{singularity_args}{Additional arguments to be passed to \verb{singularity run} (before)} \item{clean}{Logical. If \code{TRUE}, remove all files generated by this function (e.g. cloned history file, ED2IN, output HDF files).} diff --git a/modules/rtm/man/EDR.preprocess.history.Rd b/modules/rtm/man/EDR.preprocess.history.Rd index d8514993eee..5647c2bac2e 100644 --- a/modules/rtm/man/EDR.preprocess.history.Rd +++ b/modules/rtm/man/EDR.preprocess.history.Rd @@ -4,8 +4,12 @@ \alias{EDR.preprocess.history} \title{Preprocess history file for EDR} \usage{ -EDR.preprocess.history(history.path, output.path, datetime, - history.prefix = "history") +EDR.preprocess.history( + history.path, + output.path, + datetime, + history.prefix = "history" +) } \arguments{ \item{history.path}{Path to directory containing history file.} diff --git a/modules/rtm/man/bt_check_convergence.Rd b/modules/rtm/man/bt_check_convergence.Rd index 8e68a505e6f..94ead56755e 100644 --- a/modules/rtm/man/bt_check_convergence.Rd +++ b/modules/rtm/man/bt_check_convergence.Rd @@ -4,8 +4,7 @@ \alias{bt_check_convergence} \title{Check convergence of BayesianTools output} \usage{ -bt_check_convergence(samples, threshold = 1.1, use_CI = TRUE, - use_mpsrf = TRUE) +bt_check_convergence(samples, threshold = 1.1, use_CI = TRUE, use_mpsrf = TRUE) } \description{ Check convergence of BayesianTools output diff --git a/modules/rtm/man/burnin.thin.Rd b/modules/rtm/man/burnin.thin.Rd index cb0a511b00c..4e8eaecb111 100644 --- a/modules/rtm/man/burnin.thin.Rd +++ b/modules/rtm/man/burnin.thin.Rd @@ -4,8 +4,14 @@ \alias{burnin.thin} \title{Burn-in and thinning of MCMC samples} \usage{ -burnin.thin(samples, target = 5000, burnin.ratio = 2, auto = TRUE, - burnin = NULL, thin = NULL) +burnin.thin( + samples, + target = 5000, + burnin.ratio = 2, + auto = TRUE, + burnin = NULL, + thin = NULL +) } \arguments{ \item{samples}{Matrix of MCMC samples} diff --git a/modules/rtm/man/fortran_data_module.Rd b/modules/rtm/man/fortran_data_module.Rd index 9773257181e..31b9abc88d7 100644 --- a/modules/rtm/man/fortran_data_module.Rd +++ b/modules/rtm/man/fortran_data_module.Rd @@ -17,7 +17,7 @@ to initialize FORTRAN variabiles.} \item{fname}{Output file name. Defaults to 'yourmodname.f90'} } \description{ -Convert R list to a Fortran \code{/data/} module block +Convert R list to a Fortran \verb{/data/} module block } \details{ For models with large constants (e.g. absorption features in the @@ -36,14 +36,16 @@ Currently, only numeric data are supported (i.e. no characters). z <- seq(exp(1), pi, length.out=42) l <- list(x=x, y=y, z=z) ## NOTE that names must be explicitly declared l.types <- c('real','integer', 'real*4', 'real*8') - fortran_data_module(l, l.types, 'testmod') - + fortran_data_module(l, l.types, 'testmod', + file.path(tempdir(), "testmod.f90")) + x <- runif(10) y <- rnorm(10) z <- rgamma(10, 3) d <- data.frame(x,y,z) ## NOTE that data.frames are just named lists d.types <- rep('real*8', ncol(d)) - fortran_data_module(d, d.types, 'random') + fortran_data_module(d, d.types, 'random', + file.path(tempdir(), "random.f90")) } \author{ Alexey Shiklomanov diff --git a/modules/rtm/man/invert.auto.Rd b/modules/rtm/man/invert.auto.Rd index 7250dcb3797..26d9f378db7 100644 --- a/modules/rtm/man/invert.auto.Rd +++ b/modules/rtm/man/invert.auto.Rd @@ -4,9 +4,16 @@ \alias{invert.auto} \title{Inversion with automatic convergence checking} \usage{ -invert.auto(observed, invert.options, return.samples = TRUE, - save.samples = NULL, quiet = FALSE, parallel = TRUE, - parallel.cores = NULL, parallel.output = "/dev/null") +invert.auto( + observed, + invert.options, + return.samples = TRUE, + save.samples = NULL, + quiet = FALSE, + parallel = TRUE, + parallel.cores = NULL, + parallel.output = "/dev/null" +) } \arguments{ \item{observed}{Vector, matrix, or data frame (coerced to matrix) of diff --git a/modules/rtm/man/invert.custom.Rd b/modules/rtm/man/invert.custom.Rd index f5158f34d63..c402dbc6b62 100644 --- a/modules/rtm/man/invert.custom.Rd +++ b/modules/rtm/man/invert.custom.Rd @@ -4,8 +4,13 @@ \alias{invert.custom} \title{Bayesian inversion of a model} \usage{ -invert.custom(observed, invert.options, quiet = FALSE, - return.resume = FALSE, runID = NULL) +invert.custom( + observed, + invert.options, + quiet = FALSE, + return.resume = FALSE, + runID = NULL +) } \arguments{ \item{observed}{Vector, matrix, or data frame (coerced to matrix) of diff --git a/modules/rtm/man/invert_bt.Rd b/modules/rtm/man/invert_bt.Rd index d2d79e7cfef..89f2d1e8e0d 100644 --- a/modules/rtm/man/invert_bt.Rd +++ b/modules/rtm/man/invert_bt.Rd @@ -4,13 +4,12 @@ \alias{invert_bt} \title{Perform Bayesian inversion using BayesianTools package} \usage{ -invert_bt(observed, model, prior, custom_settings = list(), - loglike = NULL) +invert_bt(observed, model, prior, custom_settings = list(), loglike = NULL) } \arguments{ \item{observed}{Vector of observations. Ignored if \code{loglike} is not \code{NULL}.} -\item{model}{Function called by log-likelihood. Must be \code{function(params)} +\item{model}{Function called by log-likelihood. Must be \verb{function(params)} and return a vector equal to \code{length(observed)} or \code{nrow(observed)}. Ignored if \code{loglike} is not \code{NULL}.} diff --git a/modules/rtm/man/rtm_loglike.Rd b/modules/rtm/man/rtm_loglike.Rd index ef823b53020..1096808b354 100644 --- a/modules/rtm/man/rtm_loglike.Rd +++ b/modules/rtm/man/rtm_loglike.Rd @@ -4,8 +4,7 @@ \alias{rtm_loglike} \title{Generic log-likelihood generator for RTMs} \usage{ -rtm_loglike(nparams, model, observed, lag.max = NULL, verbose = TRUE, - ...) +rtm_loglike(nparams, model, observed, lag.max = NULL, verbose = TRUE, ...) } \description{ Generic log-likelihood generator for RTMs diff --git a/modules/rtm/man/setup_edr.Rd b/modules/rtm/man/setup_edr.Rd index e9311393a53..d01da52fac0 100644 --- a/modules/rtm/man/setup_edr.Rd +++ b/modules/rtm/man/setup_edr.Rd @@ -4,8 +4,13 @@ \alias{setup_edr} \title{Setup EDR run} \usage{ -setup_edr(ed2in, output_dir, datetime = ISOdatetime(ed2in[["IYEARA"]], - ed2in[["IMONTHA"]], ed2in[["IDATEA"]], 12, 0, 0, tz = "UTC"), ...) +setup_edr( + ed2in, + output_dir, + datetime = ISOdatetime(ed2in[["IYEARA"]], ed2in[["IMONTHA"]], ed2in[["IDATEA"]], 12, + 0, 0, tz = "UTC"), + ... +) } \arguments{ \item{ed2in}{ED2IN list object (see \link[PEcAn.ED2:read_ed2in]{PEcAn.ED2::read_ed2in}).} diff --git a/modules/rtm/man/sub-.spectra.Rd b/modules/rtm/man/sub-.spectra.Rd index 05ab584eb18..6200b4301b2 100644 --- a/modules/rtm/man/sub-.spectra.Rd +++ b/modules/rtm/man/sub-.spectra.Rd @@ -13,9 +13,9 @@ indices specifying elements to extract or replace. Indices are \code{numeric} or \code{character} vectors or empty (missing) or \code{NULL}. Numeric values are coerced to integer as by - \code{\link{as.integer}} (and hence truncated towards zero). - Character vectors will be matched to the \code{\link{names}} of the - object (or for matrices/arrays, the \code{\link{dimnames}}): + \code{\link[base]{as.integer}} (and hence truncated towards zero). + Character vectors will be matched to the \code{\link[base]{names}} of the + object (or for matrices/arrays, the \code{\link[base]{dimnames}}): see \sQuote{Character indices} below for further details. For \code{[}-indexing only: \code{i}, \code{j}, \code{\dots} can be @@ -36,9 +36,9 @@ indices specifying elements to extract or replace. Indices are \code{numeric} or \code{character} vectors or empty (missing) or \code{NULL}. Numeric values are coerced to integer as by - \code{\link{as.integer}} (and hence truncated towards zero). - Character vectors will be matched to the \code{\link{names}} of the - object (or for matrices/arrays, the \code{\link{dimnames}}): + \code{\link[base]{as.integer}} (and hence truncated towards zero). + Character vectors will be matched to the \code{\link[base]{names}} of the + object (or for matrices/arrays, the \code{\link[base]{dimnames}}): see \sQuote{Character indices} below for further details. For \code{[}-indexing only: \code{i}, \code{j}, \code{\dots} can be @@ -58,7 +58,7 @@ \item{drop}{For matrices and arrays. If \code{TRUE} the result is coerced to the lowest possible dimension (see the examples). This only works for extracting elements, not for the replacement. See - \code{\link{drop}} for further details. + \code{\link[base]{drop}} for further details. } } \description{ diff --git a/modules/rtm/man/sub-sub-.spectra.Rd b/modules/rtm/man/sub-sub-.spectra.Rd index 3059476fc99..b2d77eff43e 100644 --- a/modules/rtm/man/sub-sub-.spectra.Rd +++ b/modules/rtm/man/sub-sub-.spectra.Rd @@ -15,9 +15,9 @@ indices specifying elements to extract or replace. Indices are \code{numeric} or \code{character} vectors or empty (missing) or \code{NULL}. Numeric values are coerced to integer as by - \code{\link{as.integer}} (and hence truncated towards zero). - Character vectors will be matched to the \code{\link{names}} of the - object (or for matrices/arrays, the \code{\link{dimnames}}): + \code{\link[base]{as.integer}} (and hence truncated towards zero). + Character vectors will be matched to the \code{\link[base]{names}} of the + object (or for matrices/arrays, the \code{\link[base]{dimnames}}): see \sQuote{Character indices} below for further details. For \code{[}-indexing only: \code{i}, \code{j}, \code{\dots} can be diff --git a/modules/rtm/man/sub-subset-.spectra.Rd b/modules/rtm/man/sub-subset-.spectra.Rd index d92f421bdaf..07c59596e39 100644 --- a/modules/rtm/man/sub-subset-.spectra.Rd +++ b/modules/rtm/man/sub-subset-.spectra.Rd @@ -15,9 +15,9 @@ indices specifying elements to extract or replace. Indices are \code{numeric} or \code{character} vectors or empty (missing) or \code{NULL}. Numeric values are coerced to integer as by - \code{\link{as.integer}} (and hence truncated towards zero). - Character vectors will be matched to the \code{\link{names}} of the - object (or for matrices/arrays, the \code{\link{dimnames}}): + \code{\link[base]{as.integer}} (and hence truncated towards zero). + Character vectors will be matched to the \code{\link[base]{names}} of the + object (or for matrices/arrays, the \code{\link[base]{dimnames}}): see \sQuote{Character indices} below for further details. For \code{[}-indexing only: \code{i}, \code{j}, \code{\dots} can be diff --git a/modules/rtm/tests/Rcheck_reference.log b/modules/rtm/tests/Rcheck_reference.log new file mode 100644 index 00000000000..a1efe382219 --- /dev/null +++ b/modules/rtm/tests/Rcheck_reference.log @@ -0,0 +1,260 @@ +* using log directory ‘/tmp/RtmpPkD9Bk/PEcAnRTM.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAnRTM/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAnRTM’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAnRTM’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +Unexported object imported by a ':::' call: ‘stats:::C_acf’ + See the note in ?`:::` about the use of this operator. + Including base/recommended package(s): + ‘stats’ +* checking S3 generic/method consistency ... WARNING +neff: + function(x, ...) +neff.default: + function(x, lag.max, min_rho) + +print: + function(x, ...) +print.spectra: + function(spectra, n, ...) + +plot: + function(x, ...) +plot.spectra: + function(spectra, type, ...) + +str: + function(object, ...) +str.spectra: + function(spectra, ...) + +See section ‘Generic functions and methods’ in the ‘Writing R +Extensions’ manual. +* checking replacement functions ... WARNING + ‘[[<-.spectra’ +The argument of a replacement function which corresponds to the right +hand side must be named ‘value’. +* checking foreign function calls ... WARNING +Foreign function call to a base package: + .Call(stats:::C_acf, ...) +Packages should not make .C/.Call/.External/.Fortran calls to a base +package. They are not part of the API, for use only by R itself and +subject to change without notice. +* checking R code for possible problems ... NOTE +defparam: no visible global function definition for ‘data’ +dtnorm: no visible global function definition for ‘dnorm’ +dtnorm: no visible global function definition for ‘pnorm’ +EDR: no visible global function definition for ‘data’ +EDR: no visible binding for global variable ‘pftmapping’ +generate.noise: no visible global function definition for ‘dnorm’ +generate.noise: no visible global function definition for ‘median’ +generate.noise: no visible global function definition for ‘rnorm’ +generate.rsr.all: no visible global function definition for ‘data’ +generate.rsr.all: no visible binding for global variable + ‘raw.sensor.data’ +generate.rsr.all: no visible binding for global variable + ‘fwhm.aviris.ng’ +generate.rsr.all: no visible binding for global variable + ‘fwhm.aviris.classic’ +generate.rsr.all: no visible binding for global variable + ‘fwhm.hyperion’ +generate.rsr.all: no visible binding for global variable + ‘bandwidth.chrisproba’ +get.EDR.output: no visible global function definition for ‘read.table’ +interpolate.rsr: no visible global function definition for ‘splinefun’ +invert_bt: no visible global function definition for ‘modifyList’ +invert_bt: no visible binding for global variable ‘sampler’ +invert.custom: no visible global function definition for + ‘txtProgressBar’ +invert.custom: no visible global function definition for + ‘setTxtProgressBar’ +invert.custom: no visible binding for global variable ‘sd’ +invert.custom: no visible global function definition for ‘cor’ +invert.custom: no visible global function definition for ‘runif’ +invert.custom: no visible global function definition for ‘rgamma’ +plot.spectra: no visible global function definition for ‘plot’ +print.spectra: no visible global function definition for ‘head’ +print.spectra: no visible global function definition for ‘tail’ +priorfunc.prospect : prior: no visible global function definition for + ‘dlnorm’ +process_output: no visible global function definition for ‘window’ +process.licor.rsr: no visible global function definition for ‘read.csv’ +process.licor.rsr: no visible global function definition for + ‘complete.cases’ +prospect_bt_prior: no visible global function definition for + ‘modifyList’ +read.rsr.folder: no visible global function definition for ‘read.csv’ +resample.default: no visible global function definition for ‘approxfun’ +resample.default: no visible global function definition for ‘splinefun’ +rsr.from.fwhm: no visible global function definition for ‘qnorm’ +rsr.from.fwhm: no visible binding for global variable ‘dnorm’ +rtnorm: no visible global function definition for ‘rnorm’ +rtnorm: no visible global function definition for ‘qnorm’ +rtnorm: no visible global function definition for ‘runif’ +rtnorm: no visible global function definition for ‘pnorm’ +spectral.response: no visible binding for global variable ‘sensor.rsr’ +summary_simple: no visible binding for global variable ‘sd’ +summary_simple: no visible binding for global variable ‘quantile’ +summary_simple: no visible binding for global variable ‘median’ +Undefined global functions or variables: + approxfun bandwidth.chrisproba complete.cases cor data dlnorm dnorm + fwhm.aviris.classic fwhm.aviris.ng fwhm.hyperion head median + modifyList pftmapping plot pnorm qnorm quantile raw.sensor.data + read.csv read.table rgamma rnorm runif sampler sd sensor.rsr + setTxtProgressBar splinefun tail txtProgressBar window +Consider adding + importFrom("graphics", "plot") + importFrom("stats", "approxfun", "complete.cases", "cor", "dlnorm", + "dnorm", "median", "pnorm", "qnorm", "quantile", "rgamma", + "rnorm", "runif", "sd", "splinefun", "window") + importFrom("utils", "data", "head", "modifyList", "read.csv", + "read.table", "setTxtProgressBar", "tail", "txtProgressBar") +to your NAMESPACE file. + +Found the following calls to data() loading into the global environment: +File ‘PEcAnRTM/R/defparam.R’: + data(model.list) +File ‘PEcAnRTM/R/edr.wrapper.R’: + data(pftmapping, package = "PEcAn.ED2") +File ‘PEcAnRTM/R/generate-rsr.R’: + data(raw.sensor.data) +See section ‘Good practice’ in ‘?data’. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... OK +* checking Rd cross-references ... OK +* checking for missing documentation entries ... WARNING +Undocumented data sets: + ‘dataSpec_prospectd’ ‘model.list’ ‘bandwidth.chrisproba’ + ‘fwhm.aviris.classic’ ‘fwhm.aviris.ng’ ‘fwhm.hyperion’ ‘rsr.avhrr’ + ‘rsr.landsat5’ ‘rsr.landsat7’ ‘rsr.landsat8’ ‘rsr.modis’ ‘rsr.viirs’ + ‘sensor.rsr’ ‘testspec_ACRU’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... WARNING +Codoc mismatches from documentation object '[[<-.spectra': +[[<-.spectra + Code: function(spectra, wavelength, j, values) + Docs: function(spectra, wavelength, j, values, value) + Argument names in docs not in code: + value + +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'EDR.preprocess.history' + ‘output.path’ + +Undocumented arguments in documentation object 'bt_check_convergence' + ‘samples’ ‘threshold’ ‘use_CI’ ‘use_mpsrf’ + +Undocumented arguments in documentation object 'corr_max_lag' + ‘nx’ ‘r’ ‘sig.level’ ‘power’ ‘...’ + +Undocumented arguments in documentation object 'generate.rsr.all' + ‘path.to.licor’ + +Undocumented arguments in documentation object 'invert.lsq' + ‘upper’ +Documented arguments not in \usage in documentation object 'invert.lsq': + ‘uppper’ + +Undocumented arguments in documentation object 'matplot' + ‘...’ + +Undocumented arguments in documentation object 'matplot.default' + ‘...’ + +Undocumented arguments in documentation object 'neff' + ‘...’ + +Undocumented arguments in documentation object 'plot.spectra' + ‘type’ + +Undocumented arguments in documentation object 'rtm_loglike' + ‘nparams’ ‘model’ ‘observed’ ‘lag.max’ ‘verbose’ ‘...’ + +Undocumented arguments in documentation object 'setup_edr' + ‘...’ + +Undocumented arguments in documentation object 'str.spectra' + ‘...’ + +Undocumented arguments in documentation object '[[<-.spectra' + ‘value’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... OK +* checking for unstated dependencies in examples ... OK +* checking contents of ‘data’ directory ... OK +* checking data for non-ASCII characters ... OK +* checking data for ASCII and uncompressed saves ... WARNING + + Note: significantly better compression could be obtained + by using R CMD build --resave-data + old_size new_size compress + dataSpec_prospectd.RData 36Kb 22Kb xz + raw.sensor.data.RData 109Kb 82Kb xz + sensor.rsr.RData 2.3Mb 1.9Mb xz + testspec.RData 1.2Mb 956Kb xz +* checking line endings in C/C++/Fortran sources/headers ... OK +* checking line endings in Makefiles ... OK +* checking compilation flags in Makevars ... OK +* checking for GNU extensions in Makefiles ... OK +* checking for portable use of $(BLAS_LIBS) and $(LAPACK_LIBS) ... OK +* checking pragmas in C/C++ headers and code ... OK +* checking compilation flags used ... OK +* checking compiled code ... NOTE +File ‘PEcAnRTM/libs/PEcAnRTM.so’: + Found no calls to: ‘R_registerRoutines’, ‘R_useDynamicSymbols’ + +It is good practice to register native routines and to disable symbol +search. + +See ‘Writing portable packages’ in the ‘Writing R Extensions’ manual. +* checking files in ‘vignettes’ ... WARNING +Files in the 'vignettes' directory but no files in 'inst/doc': + ‘edr.sensitivity.R’, ‘invert.edr.R’, ‘pecanrtm.vignette.Rmd’, + ‘test.edr.R’ +Files named as vignettes but with no recognized vignette engine: + ‘vignettes/pecanrtm.vignette.Rmd’ +(Is a VignetteBuilder field missing?) +* checking examples ... OK +* DONE +Status: 9 WARNINGs, 3 NOTEs diff --git a/modules/rtm/tests/testthat/test.2s.R b/modules/rtm/tests/testthat/test.2s.R index e88c7188d24..d6adfe58da0 100644 --- a/modules/rtm/tests/testthat/test.2s.R +++ b/modules/rtm/tests/testthat/test.2s.R @@ -1,4 +1,3 @@ -library(PEcAnRTM) context("Two stream model") p4.pars <- defparam("prospect_4") diff --git a/modules/rtm/tests/testthat/test.gpm.R b/modules/rtm/tests/testthat/test.gpm.R index 3e846453235..bee5f098bbf 100644 --- a/modules/rtm/tests/testthat/test.gpm.R +++ b/modules/rtm/tests/testthat/test.gpm.R @@ -1,5 +1,3 @@ -library(PEcAnRTM) -library(testthat) context("Generalized plate model") data(dataSpec_prospectd) diff --git a/modules/rtm/tests/testthat/test.invert_bayestools.R b/modules/rtm/tests/testthat/test.invert_bayestools.R index 63570ba97b6..f49c5103866 100644 --- a/modules/rtm/tests/testthat/test.invert_bayestools.R +++ b/modules/rtm/tests/testthat/test.invert_bayestools.R @@ -1,6 +1,4 @@ # devtools::load_all('.') -library(PEcAnRTM) -library(testthat) context('Inversion using BayesianTools') skip_on_travis() diff --git a/modules/rtm/tests/testthat/test.prospect.R b/modules/rtm/tests/testthat/test.prospect.R index 3399fa53a91..cfc2295e96a 100644 --- a/modules/rtm/tests/testthat/test.prospect.R +++ b/modules/rtm/tests/testthat/test.prospect.R @@ -1,6 +1,4 @@ #' Tests of radiative transfer models -library(PEcAnRTM) -library(testthat) context("PROSPECT models") p4 <- c("N"=1.4, "Cab"=30, "Cw"=0.004, "Cm"=0.003) diff --git a/modules/rtm/tests/testthat/test.resample.R b/modules/rtm/tests/testthat/test.resample.R index 8fdf755cd33..231a0fa97e9 100644 --- a/modules/rtm/tests/testthat/test.resample.R +++ b/modules/rtm/tests/testthat/test.resample.R @@ -1,5 +1,3 @@ -library(testthat) -library(PEcAnRTM) context("Resampling functions") test_that( diff --git a/modules/rtm/tests/testthat/test.sail.R b/modules/rtm/tests/testthat/test.sail.R index 6079faab72c..1000c3522cd 100644 --- a/modules/rtm/tests/testthat/test.sail.R +++ b/modules/rtm/tests/testthat/test.sail.R @@ -1,5 +1,4 @@ #' Tests of radiative transfer models -library(PEcAnRTM) context("SAIL models") p <- defparam("pro4sail") diff --git a/modules/rtm/tests/testthat/test.spectra.R b/modules/rtm/tests/testthat/test.spectra.R index 37c85213651..a3e52606970 100644 --- a/modules/rtm/tests/testthat/test.spectra.R +++ b/modules/rtm/tests/testthat/test.spectra.R @@ -1,5 +1,3 @@ -library(PEcAnRTM) -library(testthat) context("Spectra S3 class") data(testspec, package = "PEcAnRTM") diff --git a/modules/uncertainty/DESCRIPTION b/modules/uncertainty/DESCRIPTION index 23f98c93351..f80eac06cc1 100644 --- a/modules/uncertainty/DESCRIPTION +++ b/modules/uncertainty/DESCRIPTION @@ -2,8 +2,8 @@ Package: PEcAn.uncertainty Type: Package Title: PEcAn functions used for ecological forecasts and reanalysis -Version: 1.7.1 -Date: 2019-09-05 +Version: 1.7.2 +Date: 2021-10-04 Authors@R: c(person("Mike","Dietze"), person("David","LeBauer"), person("Xiaohui", "Feng"), @@ -33,15 +33,16 @@ Imports: PEcAn.DB, PEcAn.emulator, PEcAn.logger, + PEcAn.settings, plyr (>= 1.8.4), purrr, randtoolbox, udunits2 Suggests: testthat (>= 1.0.2), -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Copyright: Authors LazyLoad: yes LazyData: FALSE Encoding: UTF-8 -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 diff --git a/modules/uncertainty/NAMESPACE b/modules/uncertainty/NAMESPACE index db2cf7d815e..648f2a61c4f 100644 --- a/modules/uncertainty/NAMESPACE +++ b/modules/uncertainty/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(ensemble.filename) export(ensemble.ts) export(flux.uncertainty) export(get.change) @@ -7,6 +8,7 @@ export(get.coef.var) export(get.elasticity) export(get.ensemble.samples) export(get.parameter.samples) +export(get.results) export(get.sensitivity) export(input.ens.gen) export(plot_flux_uncertainty) @@ -17,13 +19,17 @@ export(prep.data.assim) export(read.ameriflux.L2) export(read.ensemble.output) export(read.ensemble.ts) +export(read.sa.output) export(run.ensemble.analysis) export(run.sensitivity.analysis) +export(runModule.get.results) export(runModule.run.ensemble.analysis) export(runModule.run.sensitivity.analysis) export(sa.splinefun) export(sd.var) export(sensitivity.analysis) +export(sensitivity.filename) export(spline.truncate) export(write.ensemble.configs) +export(write.sa.configs) importFrom(dplyr,"%>%") diff --git a/modules/uncertainty/R/ensemble.R b/modules/uncertainty/R/ensemble.R index 58a1eb6dd1b..1cf32b71b70 100644 --- a/modules/uncertainty/R/ensemble.R +++ b/modules/uncertainty/R/ensemble.R @@ -111,7 +111,7 @@ get.ensemble.samples <- function(ensemble.size, pft.samples, env.samples, random.samples <- as.matrix(random.samples) } else if (method == "sobol") { PEcAn.logger::logger.info("Using ", method, "method for sampling") - random.samples <- randtoolbox::sobol(n = ensemble.size, dim = total.sample.num, ...) + random.samples <- randtoolbox::sobol(n = ensemble.size, dim = total.sample.num, scrambling = 3, ...) ## force as a matrix in case length(samples)=1 random.samples <- as.matrix(random.samples) } else if (method == "torus") { @@ -146,12 +146,22 @@ get.ensemble.samples <- function(ensemble.size, pft.samples, env.samples, # meaning we want to keep MCMC samples together if(length(pft.samples[[pft.i]])>0 & !is.null(param.names)){ - # TODO: for now we are sampling row numbers uniformly - # stop if other methods were requested - if(method != "uniform"){ - PEcAn.logger::logger.severe("Only uniform sampling is available for joint sampling at the moment. Other approaches are not implemented yet.") + if (method == "halton") { + same.i <- round(randtoolbox::halton(ensemble.size) * length(pft.samples[[pft.i]][[1]])) + } else if (method == "sobol") { + same.i <- round(randtoolbox::sobol(ensemble.size, scrambling = 3) * length(pft.samples[[pft.i]][[1]])) + } else if (method == "torus") { + same.i <- round(randtoolbox::torus(ensemble.size) * length(pft.samples[[pft.i]][[1]])) + } else if (method == "lhc") { + same.i <- round(c(PEcAn.emulator::lhc(t(matrix(0:1, ncol = 1, nrow = 2)), ensemble.size) * length(pft.samples[[pft.i]][[1]]))) + } else if (method == "uniform") { + same.i <- sample.int(length(pft.samples[[pft.i]][[1]]), ensemble.size) + } else { + PEcAn.logger::logger.info("Method ", method, " has not been implemented yet, using uniform random sampling") + # uniform random + same.i <- sample.int(length(pft.samples[[pft.i]][[1]]), ensemble.size) } - same.i <- sample.int(length(pft.samples[[pft.i]][[1]]), ensemble.size) + } for (trait.i in seq(pft.samples[[pft.i]])) { @@ -200,6 +210,7 @@ get.ensemble.samples <- function(ensemble.size, pft.samples, env.samples, write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, clean = FALSE, write.to.db = TRUE,restart=NULL) { + con <- NULL my.write.config <- paste("write.config.", model, sep = "") my.write_restart <- paste0("write_restart.", model) @@ -207,20 +218,26 @@ write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, return(list(runs = NULL, ensemble.id = NULL)) } - # Open connection to database so we can store all run/ensemble information + # See if we need to write to DB + write.to.db <- as.logical(settings$database$bety$write) + if (write.to.db) { - con <- try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) - if (inherits(con, "try-error")) { + # Open connection to database so we can store all run/ensemble information + con <- + try(PEcAn.DB::db.open(settings$database$bety)) + on.exit(try(PEcAn.DB::db.close(con), silent = TRUE), add = TRUE) + + # If we fail to connect to DB then we set to NULL + if (inherits(con, "try-error")) { con <- NULL - } else { - on.exit(PEcAn.DB::db.close(con)) + PEcAn.logger::logger.warn("We were not able to successfully establish a connection with Bety ") } - } else { - con <- NULL } + + # Get the workflow id - if ("workflow" %in% names(settings)) { + if (!is.null(settings$workflow$id)) { workflow.id <- settings$workflow$id } else { workflow.id <- -1 @@ -228,7 +245,7 @@ write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, #------------------------------------------------- if this is a new fresh run------------------ if (is.null(restart)){ # create an ensemble id - if (!is.null(con)) { + if (!is.null(con) && write.to.db) { # write ensemble first ensemble.id <- PEcAn.DB::db.query(paste0( "INSERT INTO ensembles (runtype, workflow_id) ", @@ -285,6 +302,7 @@ write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, if (is.null(samples[[r_tag]]) & r_tag!="parameters") samples[[r_tag]]$samples <<- rep(settings$run$inputs[[tolower(r_tag)]]$path[1], settings$ensemble$size) }) + # Let's find the PFT based on site location, if it was found I will subset the ensemble.samples otherwise we're not affecting anything if(!is.null(con)){ Pft_Site_df <- dplyr::tbl(con, "sites_cultivars")%>% @@ -299,19 +317,29 @@ write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, #-- if there is enough info to connect the site to pft #if ( nrow(Pft_Site_df) > 0 & all(site_pfts_names %in% names(ensemble.samples)) ) ensemble.samples <- ensemble.samples [Pft_Site$name %>% unlist() %>% as.character()] } + # Reading the site.pft specific tags from xml site.pfts.vec <- settings$run$site$site.pft %>% unlist %>% as.character - if(!is.null(site.pfts.vec)){ + if (!is.null(site.pfts.vec)) { # find the name of pfts defined in the body of pecan.xml - defined.pfts <- settings$pfts %>% purrr::map('name') %>% unlist %>% as.character + defined.pfts <- + settings$pfts %>% purrr::map('name') %>% unlist %>% as.character # subset ensemble samples based on the pfts that are specified in the site and they are also sampled from. - if (length(which(site.pfts.vec %in% defined.pfts)) > 0 ) - ensemble.samples <- ensemble.samples [site.pfts.vec[ which(site.pfts.vec %in% defined.pfts) ]] + if (length(which(site.pfts.vec %in% defined.pfts)) > 0) + ensemble.samples <- + ensemble.samples [site.pfts.vec[which(site.pfts.vec %in% defined.pfts)]] # warn if there is a pft specified in the site but it's not defined in the pecan xml. - if (length(which(!(site.pfts.vec %in% defined.pfts)))>0) - PEcAn.logger::logger.warn(paste0("The following pfts are specified for the siteid ", settings$run$site$id ," but they are not defined as a pft in pecan.xml:", - site.pfts.vec[which(!(site.pfts.vec %in% defined.pfts))])) + if (length(which(!(site.pfts.vec %in% defined.pfts))) > 0) + PEcAn.logger::logger.warn( + paste0( + "The following pfts are specified for the siteid ", + settings$run$site$id , + " but they are not defined as a pft in pecan.xml:", + site.pfts.vec[which(!(site.pfts.vec %in% defined.pfts))], + collapse = "," + ) + ) } # if no ensemble piece was in the xml I replicate n times the first element in params @@ -326,7 +354,7 @@ write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, # write configuration for each run of the ensemble runs <- data.frame() for (i in seq_len(settings$ensemble$size)) { - if (!is.null(con)) { + if (!is.null(con) && write.to.db) { paramlist <- paste("ensemble=", i, sep = "") # inserting this into the table and getting an id back run.id <- PEcAn.DB::db.query(paste0( @@ -465,35 +493,39 @@ write.ensemble.configs <- function(defaults, ensemble.samples, settings, model, #' #' @examples #' \dontrun{input.ens.gen(settings,"met","sampling")} -#' -input.ens.gen<-function(settings,input,method="sampling",parent_ids=NULL){ - +#' +input.ens.gen <- function(settings, input, method = "sampling", parent_ids = NULL) { + #-- reading the dots and exposing them to the inside of the function - samples<-list() - samples$ids<-c() + samples <- list() + samples$ids <- c() # if (is.null(method)) return(NULL) # parameter is exceptional it needs to be handled spearatly - if (input=="parameters") return(NULL) + if (input == "parameters") return(NULL) + #-- assing the sample ids based on different scenarios - if(!is.null(parent_ids)) { - samples$ids <- parent_ids$ids - out.of.sample.size <- length(samples$ids[samples$ids > settings$run$inputs[[tolower(input)]]$path %>% length]) + input_path <- settings$run$inputs[[tolower(input)]]$path + if (!is.null(parent_ids)) { + samples$ids <- parent_ids$ids + out.of.sample.size <- length(samples$ids[samples$ids > length(input_path)]) #sample for those that our outside the param size - forexample, parent id may send id number 200 but we have only100 sample for param - samples$ids[samples$ids%in%out.of.sample.size] <- sample(settings$run$inputs[[tolower(input)]]$path %>% seq_along(), - out.of.sample.size, - replace = T) - }else if( tolower(method)=="sampling") { - samples$ids <- sample(settings$run$inputs[[tolower(input)]]$path %>% seq_along(), - settings$ensemble$size, - replace = T) - }else if( tolower(method)=="looping"){ - samples$ids <- rep_len(settings$run$inputs[[tolower(input)]]$path %>% seq_along(), length.out=settings$ensemble$size) + samples$ids[samples$ids %in% out.of.sample.size] <- sample( + seq_along(input_path), + out.of.sample.size, + replace = TRUE) + } else if (tolower(method) == "sampling") { + samples$ids <- sample( + seq_along(input_path), + settings$ensemble$size, + replace = TRUE) + } else if (tolower(method) == "looping") { + samples$ids <- rep_len( + seq_along(input_path), + length.out = settings$ensemble$size) } #using the sample ids - samples$samples<-settings$run$inputs[[tolower(input)]]$path[samples$ids] - - - + samples$samples <- input_path[samples$ids] + return(samples) } diff --git a/base/utils/R/get.analysis.filenames.r b/modules/uncertainty/R/get.analysis.filenames.r similarity index 72% rename from base/utils/R/get.analysis.filenames.r rename to modules/uncertainty/R/get.analysis.filenames.r index b67afa272c6..621a58b525c 100644 --- a/base/utils/R/get.analysis.filenames.r +++ b/modules/uncertainty/R/get.analysis.filenames.r @@ -1,19 +1,37 @@ ##' Generate ensemble filenames -##' -##' @name ensemble.filename -##' @title Generate ensemble filenames -##' -##' @return a filename -##' @export ##' -##' @details Generally uses values in settings, but can be overwritten for manual uses +##' Generates a vector of filenames to be used for PEcAn ensemble output files. +##' All paths start from directory `settings$outdir`, +##' which will be created if it does not exist. +##' +##' Typically used by passing only a settings object, +##' but all values can be overridden for manual use. +##' +##' If only a single variable or a subset of years are needed, +##' the generated filename will identify these in the form +## `prefix.ensemble_id.variable.startyear.endyear.suffix` +##' If all vars and years are included, set `all.yr.var` to TRUE +##' to get a filename of the form `prefix.ensemble_id.suffix`. +##' All elements are recycled vectorwise. +##' @param settings list of PEcAn settings. +##' @param prefix string to appear at the beginning of the filename +##' @param suffix file extension: string to appear at the end of the filename +##' @param all.var.yr logical: does ensemble include all vars and years? +##' If FALSE, filename will include years and vars +##' @param ensemble.id ensemble ID(s) +##' @param variable variable(s) included in the ensemble. +##' @param start.year,end.year first and last year simulated. +##' +##' @return a vector of filenames, each in the form +##' `[settings$outdir]/[prefix].[ensemble.ID].[variable].[start.year].[end.year][suffix]`. +##' @export ##' @author Ryan Kelly -ensemble.filename <- function(settings, prefix = "ensemble.samples", suffix = "Rdata", - all.var.yr = TRUE, ensemble.id = settings$ensemble$ensemble.id, - variable = settings$ensemble$variable, - start.year = settings$ensemble$start.year, +ensemble.filename <- function(settings, prefix = "ensemble.samples", suffix = "Rdata", + all.var.yr = TRUE, ensemble.id = settings$ensemble$ensemble.id, + variable = settings$ensemble$variable, + start.year = settings$ensemble$start.year, end.year = settings$ensemble$end.year) { - + if (is.null(ensemble.id) || is.na(ensemble.id)) { # This shouldn't generally arise, as run.write.configs() appends ensemble.id to # settings. However,it will come up if running run.write.configs(..., write=F), @@ -22,42 +40,44 @@ ensemble.filename <- function(settings, prefix = "ensemble.samples", suffix = "R # run. ensemble.id <- "NOENSEMBLEID" } - + ensemble.dir <- settings$outdir - + dir.create(ensemble.dir, showWarnings = FALSE, recursive = TRUE) - + if (all.var.yr) { # All variables and years will be included; omit those from filename ensemble.file <- file.path(ensemble.dir, paste(prefix, ensemble.id, suffix, sep = ".")) } else { - ensemble.file <- file.path(ensemble.dir, paste(prefix, ensemble.id, variable, + ensemble.file <- file.path(ensemble.dir, paste(prefix, ensemble.id, variable, start.year, end.year, suffix, sep = ".")) } - + return(ensemble.file) } # ensemble.filename ##' Generate sensitivity analysis filenames -##' +##' ##' @name sensitivity.filename ##' @title Generate sensitivity analysis filenames -##' +##' @inheritParams ensemble.filename +##' @param pft name of PFT used for analysis. If NULL, assumes all +##' PFTs in run are used and does not add them to the filename ##' @return a filename ##' @export ##' ##' @details Generally uses values in settings, but can be overwritten for manual uses ##' @author Ryan Kelly -sensitivity.filename <- function(settings, - prefix = "sensitivity.samples", suffix = "Rdata", +sensitivity.filename <- function(settings, + prefix = "sensitivity.samples", suffix = "Rdata", all.var.yr = TRUE, pft = NULL, ensemble.id = settings$sensitivity.analysis$ensemble.id, variable = settings$sensitivity.analysis$variable, start.year = settings$sensitivity.analysis$start.year, end.year = settings$sensitivity.analysis$end.year) { - + if(is.null(ensemble.id) || is.na(ensemble.id)) { # This shouldn't generally arise, as run.write.configs() appends ensemble.id to settings. However,it will come up if running run.write.configs(..., write=F), because then no ensemble ID is created in the database. A simple workflow will still work in that case, but provenance will be lost if multiple ensembles are run. ensemble.id <- "NOENSEMBLEID" @@ -73,7 +93,7 @@ sensitivity.filename <- function(settings, if (is.null(end.year)) { end.year <- "NA" } - + if (is.null(pft)) { # Goes in main output directory. sensitivity.dir <- settings$outdir @@ -81,13 +101,13 @@ sensitivity.filename <- function(settings, ind <- which(sapply(settings$pfts, function(x) x$name) == pft) if (length(ind) == 0) { ## no match - PEcAn.logger::logger.warn("sensitivity.filename: unmatched PFT = ", pft, " not among ", + PEcAn.logger::logger.warn("sensitivity.filename: unmatched PFT = ", pft, " not among ", sapply(settings$pfts, function(x) x$name)) sensitivity.dir <- file.path(settings$outdir, "pfts", pft) } else { if (length(ind) > 1) { ## multiple matches - PEcAn.logger::logger.warn("sensitivity.filename: multiple matchs of PFT = ", pft, + PEcAn.logger::logger.warn("sensitivity.filename: multiple matchs of PFT = ", pft, " among ", sapply(settings$pfts, function(x) x$name), " USING") ind <- ind[1] } @@ -98,10 +118,10 @@ sensitivity.filename <- function(settings, sensitivity.dir <- settings$pfts[[ind]]$outdir } } - + dir.create(sensitivity.dir, showWarnings = FALSE, recursive = TRUE) if (!dir.exists(sensitivity.dir)) { - PEcAn.logger::logger.error("sensitivity.filename: could not create directory, please check permissions ", + PEcAn.logger::logger.error("sensitivity.filename: could not create directory, please check permissions ", sensitivity.dir, " will try ", settings$outdir) if (dir.exists(settings$outdir)) { sensitivity.dir <- settings$outdir @@ -109,15 +129,15 @@ sensitivity.filename <- function(settings, PEcAn.logger::logger.error("sensitivity.filename: no OUTDIR ", settings$outdir) } } - + if (all.var.yr) { # All variables and years will be included; omit those from filename sensitivity.file <- file.path(sensitivity.dir, paste(prefix, ensemble.id, suffix, sep = ".")) } else { - sensitivity.file <- file.path(sensitivity.dir, + sensitivity.file <- file.path(sensitivity.dir, paste(prefix, ensemble.id, variable, start.year, end.year, suffix, sep = ".")) } - + return(sensitivity.file) } # sensitivity.filename diff --git a/modules/uncertainty/R/get.parameter.samples.R b/modules/uncertainty/R/get.parameter.samples.R index c4a85117140..8371a1b2eb5 100644 --- a/modules/uncertainty/R/get.parameter.samples.R +++ b/modules/uncertainty/R/get.parameter.samples.R @@ -16,8 +16,14 @@ get.parameter.samples <- function(settings, pft.names <- list() outdirs <- list() ## Open database connection - con <- PEcAn.DB::db.open(settings$database$bety) - on.exit(PEcAn.DB::db.close(con)) + con <- try(PEcAn.DB::db.open(settings$database$bety)) + on.exit(try(PEcAn.DB::db.close(con), silent = TRUE), add = TRUE) + + # If we fail to connect to DB then we set to NULL + if (inherits(con, "try-error")) { + con <- NULL + PEcAn.logger::logger.warn("We were not able to successfully establish a connection with Bety ") + } for (i.pft in seq_along(pfts)) { pft.names[i.pft] <- settings$pfts[[i.pft]]$name @@ -46,6 +52,7 @@ get.parameter.samples <- function(settings, ## Load PFT priors and posteriors for (i in seq_along(pft.names)) { + rm(prior.distns, post.distns, trait.mcmc) ## Load posteriors if (!is.na(posterior.files[i])) { @@ -66,7 +73,7 @@ get.parameter.samples <- function(settings, } ### Load trait mcmc data (if exists, either from MA or PDA) - if (!is.null(settings$pfts[[i]]$posteriorid)) { # first check if there are any files associated with posterior ids + if (!is.null(settings$pfts[[i]]$posteriorid) && !inherits(con, "try-error")) {# first check if there are any files associated with posterior ids files <- PEcAn.DB::dbfile.check("Posterior", settings$pfts[[i]]$posteriorid, con, settings$host$name, return.all = TRUE) @@ -123,11 +130,30 @@ get.parameter.samples <- function(settings, } PEcAn.logger::logger.info("using ", samples.num, "samples per trait") + if (ens.sample.method == "halton") { + q_samples <- randtoolbox::halton(n = samples.num, dim = length(priors)) + } else if (ens.sample.method == "sobol") { + q_samples <- randtoolbox::sobol(n = samples.num, dim = length(priors), scrambling = 3) + } else if (ens.sample.method == "torus") { + q_samples <- randtoolbox::torus(n = samples.num, dim = length(priors)) + } else if (ens.sample.method == "lhc") { + q_samples <- PEcAn.emulator::lhc(t(matrix(0:1, ncol = length(priors), nrow = 2)), samples.num) + } else if (ens.sample.method == "uniform") { + q_samples <- matrix(stats::runif(samples.num * length(priors)), + samples.num, + length(priors)) + } else { + PEcAn.logger::logger.info("Method ", ens.sample.method, " has not been implemented yet, using uniform random sampling") + # uniform random + q_samples <- matrix(stats::runif(samples.num * length(priors)), + samples.num, + length(priors)) + } for (prior in priors) { if (prior %in% param.names[[i]]) { - samples <- as.matrix(trait.mcmc[[prior]][, "beta.o"]) + samples <- trait.mcmc[[prior]] %>% purrr::map(~ .x[,'beta.o']) %>% unlist() %>% as.matrix() } else { - samples <- PEcAn.priors::get.sample(prior.distns[prior, ], samples.num) + samples <- PEcAn.priors::get.sample(prior.distns[prior, ], samples.num, q_samples[ , priors==prior]) } trait.samples[[pft.name]][[prior]] <- samples } diff --git a/base/utils/R/get.results.R b/modules/uncertainty/R/get.results.R similarity index 56% rename from base/utils/R/get.results.R rename to modules/uncertainty/R/get.results.R index 3f9a1d279d4..80562a8a917 100644 --- a/base/utils/R/get.results.R +++ b/modules/uncertainty/R/get.results.R @@ -9,11 +9,16 @@ ##' Reads model output and runs sensitivity and ensemble analyses ##' -##' Output is placed in model output directory (settings$modeloutdir). -##' @name get.results -##' @title Generate model output for PEcAn analyses +##' Output is placed in model output directory (settings$outdir). ##' @export ##' @param settings list, read from settings file (xml) using \code{\link{read.settings}} +##' @param sa.ensemble.id,ens.ensemble.id ensemble IDs for the sensitivity +##' analysis and ensemble analysis. +##' If not provided, they are first looked up from `settings`, +##' then if not found they are not used and the most recent set of results +##' is read from \code{samples.Rdata} in directory \code{settings$outdir} +##' @param variable variables to retrieve, as vector of names or expressions +##' @param start.year,end.year first and last years to retrieve ##' @author David LeBauer, Shawn Serbin, Mike Dietze, Ryan Kelly get.results <- function(settings, sa.ensemble.id = NULL, ens.ensemble.id = NULL, variable = NULL, start.year = NULL, end.year = NULL) { @@ -76,59 +81,59 @@ get.results <- function(settings, sa.ensemble.id = NULL, ens.ensemble.id = NULL, end.year.sa <- NA } - variable.sa <- variable - if (is.null(variable.sa)) { + variables.sa <- variable + if (is.null(variables.sa)) { if ("variable" %in% names(settings$sensitivity.analysis)) { - variable.sa <- settings$sensitivity.analysis[names(settings$sensitivity.analysis) == "variable"] + variables.sa <- settings$sensitivity.analysis[names(settings$sensitivity.analysis) == "variable"] } else { PEcAn.logger::logger.severe("no variable defined for sensitivity analysis") } } # Only handling one variable at a time for now - if (length(variable.sa) > 1) { - variable.sa <- variable.sa[1] - PEcAn.logger::logger.warn(paste0("Currently performs sensitivity analysis on only one variable at a time. Using first (", - variable.sa, ")")) - } - - # if an expression is provided, convert.expr returns names of the variables accordingly - # if a derivation is not requested it returns the variable name as is - variables <- convert.expr(unlist(variable.sa)) - variable.sa <- variables$variable.eqn - variable.fn <- variables$variable.drv - - - for(pft.name in pft.names){ - quantiles <- rownames(sa.samples[[pft.name]]) - traits <- trait.names[[pft.name]] - - # when there is variable-per pft in the outputs, check for the tag for deciding SA per pft - per.pft <- ifelse(!is.null(settings$sensitivity.analysis$perpft), - as.logical(settings$sensitivity.analysis$perpft), FALSE) - sensitivity.output[[pft.name]] <- read.sa.output(traits = traits, - quantiles = quantiles, - pecandir = outdir, - outdir = settings$modeloutdir, - pft.name = pft.name, - start.year = start.year.sa, - end.year = end.year.sa, - variable = variable.sa, - sa.run.ids = sa.run.ids, - per.pft = per.pft) + if (length(variables.sa) >= 1) { + for(variable.sa in variables.sa){ + PEcAn.logger::logger.warn(paste0("Currently performing sensitivity analysis on variable ", + variable.sa, ")")) + + # if an expression is provided, convert.expr returns names of the variables accordingly + # if a derivation is not requested it returns the variable name as is + variables <- PEcAn.utils::convert.expr(unlist(variable.sa)) + variable.sa <- variables$variable.eqn + variable.fn <- variables$variable.drv + + for(pft.name in pft.names){ + quantiles <- rownames(sa.samples[[pft.name]]) + traits <- trait.names[[pft.name]] + + # when there is variable-per pft in the outputs, check for the tag for deciding SA per pft + per.pft <- ifelse(!is.null(settings$sensitivity.analysis$perpft), + as.logical(settings$sensitivity.analysis$perpft), FALSE) + sensitivity.output[[pft.name]] <- read.sa.output( + traits = traits, + quantiles = quantiles, + pecandir = outdir, + outdir = settings$modeloutdir, + pft.name = pft.name, + start.year = start.year.sa, + end.year = end.year.sa, + variable = variable.sa, + sa.run.ids = sa.run.ids, + per.pft = per.pft) + } + + # Save sensitivity output + + fname <- sensitivity.filename(settings, "sensitivity.output", "Rdata", + all.var.yr = FALSE, + pft = NULL, + ensemble.id = sa.ensemble.id, + variable = variable.fn, + start.year = start.year.sa, + end.year = end.year.sa) + save(sensitivity.output, file = fname) + } } - - # Save sensitivity output - - fname <- sensitivity.filename(settings, "sensitivity.output", "Rdata", - all.var.yr = FALSE, - pft = NULL, - ensemble.id = sa.ensemble.id, - variable = variable.fn, - start.year = start.year.sa, - end.year = end.year.sa) - save(sensitivity.output, file = fname) - } ensemble.output <- list() @@ -182,55 +187,59 @@ get.results <- function(settings, sa.ensemble.id = NULL, ens.ensemble.id = NULL, end.year.ens <- NA } - variable.ens <- variable - if (is.null(variable.ens)) { + variables.ens <- variable + if (is.null(variables.ens)) { if ("variable" %in% names(settings$ensemble)) { - var <- which(names(settings$ensemble) == "variable") - for (i in seq_along(var)) { - variable.ens[i] <- settings$ensemble[[var[i]]] + nc_var <- which(names(settings$ensemble) == "variable") + for (i in seq_along(nc_var)) { + variables.ens[i] <- settings$ensemble[[nc_var[i]]] } } } - if (is.null(variable.ens)) + if (is.null(variables.ens)) PEcAn.logger::logger.severe("No variables for ensemble analysis!") # Only handling one variable at a time for now - if (length(variable.ens) > 1) { - variable.ens <- variable.ens[1] - PEcAn.logger::logger.warn(paste0("Currently performs ensemble analysis on only one variable at a time. Using first (", - variable.ens, ")")) + if (length(variables.ens) >= 1) { + for(variable.ens in variables.ens){ + PEcAn.logger::logger.warn(paste0("Currently performing ensemble analysis on variable ", + variable.ens, ")")) + + # if an expression is provided, convert.expr returns names of the variables accordingly + # if a derivation is not requested it returns the variable name as is + variables <- PEcAn.utils::convert.expr(variable.ens) + variable.ens <- variables$variable.eqn + variable.fn <- variables$variable.drv + + ensemble.output <- PEcAn.uncertainty::read.ensemble.output( + settings$ensemble$size, + pecandir = outdir, + outdir = settings$modeloutdir, + start.year = start.year.ens, + end.year = end.year.ens, + variable = variable.ens, + ens.run.ids = ens.run.ids + ) + + # Save ensemble output + fname <- ensemble.filename(settings, "ensemble.output", "Rdata", + all.var.yr = FALSE, + ensemble.id = ens.ensemble.id, + variable = variable.fn, + start.year = start.year.ens, + end.year = end.year.ens) + save(ensemble.output, file = fname) + } } - - # if an expression is provided, convert.expr returns names of the variables accordingly - # if a derivation is not requested it returns the variable name as is - variables <- convert.expr(variable.ens) - variable.ens <- variables$variable.eqn - variable.fn <- variables$variable.drv - - ensemble.output <- PEcAn.uncertainty::read.ensemble.output( - settings$ensemble$size, - pecandir = outdir, - outdir = settings$modeloutdir, - start.year = start.year.ens, - end.year = end.year.ens, - variable = variable.ens, - ens.run.ids = ens.run.ids - ) - - # Save ensemble output - fname <- ensemble.filename(settings, "ensemble.output", "Rdata", - all.var.yr = FALSE, - ensemble.id = ens.ensemble.id, - variable = variable.fn, - start.year = start.year.ens, - end.year = end.year.ens) - save(ensemble.output, file = fname) } } # get.results - -##' @export +#' Apply get.results to each of a list of settings +#' +#' @param settings a PEcAn \code{Settings} or \code{MultiSettings} object +#' @seealso get.results +#' @export runModule.get.results <- function(settings) { if (PEcAn.settings::is.MultiSettings(settings)) { return(PEcAn.settings::papply(settings, runModule.get.results)) diff --git a/modules/uncertainty/R/plots.R b/modules/uncertainty/R/plots.R index 7c773e29ec9..029d9328b1a 100644 --- a/modules/uncertainty/R/plots.R +++ b/modules/uncertainty/R/plots.R @@ -8,26 +8,14 @@ #------------------------------------------------------------------------------- ##--------------------------------------------------------------------------------------------------# -##' Plot results of variance decomposition +##' Variance Decomposition Plots ##' ##' Plots variance decomposition tryptich ##' @name plot_variance_decomposition -##' @title Variance Decomposition Plots -##' @export plot_variance_decomposition +##' @export ##' @author David LeBauer, Carl Davidson -##' @param ... Output from any number of sensitivity analyses. Output must be of the form +##' @param plot.inputs Output from a sensitivity analysis. Output must be of the form ##' given by sensitivity.results$variance.decomposition.output in model output -##' @param all.plot.inputs Optional argument allowing output from sensitivity analyses to be specified in a list -##' @param exclude vector of strings specifying parameters to omit from the variance decomposition graph -##' @param convert.var function transforming variances to the value displayed in the graph -##' @param var.label label to displayed over variance column -##' @param order.plot.input Output from a sensitivity analysis that is to be used to order parameters. -##' Parameters are ordered by variance. Defaults to the first sensitivity analysis output given -##' @param ticks.plot.input Output from a sensitivity analysis that is to be used. -##' Defaults to the first sensitivity analysis output given -##' @param col Color of each sensitivity analysis. Equivalent to col parameter of the plot function. -##' @param pch Shape of each sensitivity analysis. Equivalent to pch parameter of the plot function. -##' @param main Plot title. Useful for multi-pft variance decompositions. ##' @param fontsize list specifying the font size of the titles and axes of the graph ##' @examples ##' x <- list(trait.labels = c('a', 'b', 'c'), diff --git a/modules/uncertainty/R/run.ensemble.analysis.R b/modules/uncertainty/R/run.ensemble.analysis.R index 2e42d9ec2bf..453232df8dd 100644 --- a/modules/uncertainty/R/run.ensemble.analysis.R +++ b/modules/uncertainty/R/run.ensemble.analysis.R @@ -56,95 +56,95 @@ run.ensemble.analysis <- function(settings, plot.timeseries = NA, ensemble.id = if (is.null(variable)) { PEcAn.logger::logger.severe("No variables for ensemble analysis!") } - - # Only handling one variable at a time for now - if (length(variable) > 1) { - variable <- variable[1] - PEcAn.logger::logger.warn(paste0("Currently performs ensemble analysis on only one variable at a time. Using first (", - variable, ")")) - } - - cflux <- c("GPP", "NPP", "NEE", "TotalResp", "AutoResp", "HeteroResp", "DOC_flux", "Fire_flux") #converted to gC/m2/s - wflux <- c("Evap", "TVeg", "Qs", "Qsb", "Rainf") #kgH20 m-2 s-1 - - - variables <- convert.expr(variable) - variable.ens <- variables$variable.eqn - variable.fn <- variables$variable.drv - - print(paste("----- Variable: ", variable.fn, sep = "")) - #units <- lapply(variable, function(x) { paste0(x, " (", mstmipvar(x, silent=TRUE)$units, ")") }) - units <- paste0(variable.fn, " (", mstmipvar(variable.fn, silent=TRUE)$units, ")") - - ### Load parsed model results - fname <- ensemble.filename(settings, "ensemble.output", "Rdata", all.var.yr = FALSE, - ensemble.id = ensemble.id, variable = variable.fn, start.year = start.year, end.year = end.year) - - load(fname) - - my.dat = unlist(ensemble.output) - if(is.null(my.dat) | all(is.na(my.dat))){ - PEcAn.logger::logger.warn("no data in ensemble.output") - return() - } - - ### ------------------- Start ensemble analysis ------------------- - ensemble.results <- list() - if (is.null(settings$run$site$name)) { - print("----- Running ensemble analysis -----") - } else { - print(paste("----- Running ensemble analysis for site: ", settings$run$site$name)) - } - - ## Generate ensemble figure - fname <- ensemble.filename(settings, "ensemble.analysis", "pdf", - all.var.yr = FALSE, - ensemble.id = ensemble.id, - variable = variable.fn, - start.year = start.year, - end.year = end.year) - - pdf(file = fname, width = 13, height = 6) - par(mfrow = c(1, 2), mar = c(4, 4.8, 1, 2)) # B, L, T, R - - hist(my.dat,xlab=units, - main="",cex.axis=1.1,cex.lab=1.4,col="grey85") - box(lwd = 2.2) - - boxplot(my.dat,ylab=units, - boxwex=0.6,col="grey85", cex.axis=1.1,range=2, - pch=21,cex=1.4, bg="black",cex.lab=1.5) - box(lwd=2.2) - - dev.off() - - print("----- Done!") - print(" ") - print("-----------------------------------------------") - print(" ") - print(" ") - - ### Plot ensemble time-series - if (!is.na(plot.timeseries)) { - fname <- ensemble.filename(settings, "ensemble.ts", "pdf", - all.var.yr = FALSE, - ensemble.id = ensemble.id, - variable = variable.fn, - start.year = start.year, - end.year = end.year) - - pdf(fname, width = 12, height = 9) - ensemble.ts.analysis <- ensemble.ts(read.ensemble.ts(settings), ...) - dev.off() - - fname <- ensemble.filename(settings, "ensemble.ts.analysis", "Rdata", - all.var.yr = FALSE, - ensemble.id = ensemble.id, - variable = variable.fn, - start.year = start.year, - end.year = end.year) - save(ensemble.ts.analysis, file = fname) + variables <- variable + if (length(variables) >= 1) { + for(variable in variables) { + PEcAn.logger::logger.warn(paste0("Currently performing ensemble analysis on variable ", + variable)) + + cflux <- c("GPP", "NPP", "NEE", "TotalResp", "AutoResp", "HeteroResp", "DOC_flux", "Fire_flux") #converted to gC/m2/s + wflux <- c("Evap", "TVeg", "Qs", "Qsb", "Rainf") #kgH20 m-2 s-1 + + variables <- PEcAn.utils::convert.expr(variable) + variable.ens <- variables$variable.eqn + variable.fn <- variables$variable.drv + + print(paste("----- Variable: ", variable.fn, sep = "")) + + #units <- lapply(variable, function(x) { paste0(x, " (", mstmipvar(x, silent=TRUE)$units, ")") }) + units <- paste0(variable.fn, " (", mstmipvar(variable.fn, silent=TRUE)$units, ")") + + ### Load parsed model results + fname <- ensemble.filename(settings, "ensemble.output", "Rdata", all.var.yr = FALSE, + ensemble.id = ensemble.id, variable = variable.fn, start.year = start.year, end.year = end.year) + + load(fname) + + my.dat = unlist(ensemble.output) + if(is.null(my.dat) | all(is.na(my.dat))){ + PEcAn.logger::logger.warn("no data in ensemble.output") + return() + } + + ### ------------------- Start ensemble analysis ------------------- + ensemble.results <- list() + if (is.null(settings$run$site$name)) { + print("----- Running ensemble analysis -----") + } else { + print(paste("----- Running ensemble analysis for site: ", settings$run$site$name)) + } + + ## Generate ensemble figure + fname <- ensemble.filename(settings, "ensemble.analysis", "pdf", + all.var.yr = FALSE, + ensemble.id = ensemble.id, + variable = variable.fn, + start.year = start.year, + end.year = end.year) + + pdf(file = fname, width = 13, height = 6) + par(mfrow = c(1, 2), mar = c(4, 4.8, 1, 2)) # B, L, T, R + + hist(my.dat,xlab=units, + main="",cex.axis=1.1,cex.lab=1.4,col="grey85") + box(lwd = 2.2) + + boxplot(my.dat,ylab=units, + boxwex=0.6,col="grey85", cex.axis=1.1,range=2, + pch=21,cex=1.4, bg="black",cex.lab=1.5) + box(lwd=2.2) + + dev.off() + + print("----- Done!") + print(" ") + print("-----------------------------------------------") + print(" ") + print(" ") + + ### Plot ensemble time-series + if (!is.na(plot.timeseries)) { + fname <- ensemble.filename(settings, "ensemble.ts", "pdf", + all.var.yr = FALSE, + ensemble.id = ensemble.id, + variable = variable.fn, + start.year = start.year, + end.year = end.year) + + pdf(fname, width = 12, height = 9) + ensemble.ts.analysis <- ensemble.ts(read.ensemble.ts(settings, variable = variable), ...) + dev.off() + + fname <- ensemble.filename(settings, "ensemble.ts.analysis", "Rdata", + all.var.yr = FALSE, + ensemble.id = ensemble.id, + variable = variable.fn, + start.year = start.year, + end.year = end.year) + save(ensemble.ts.analysis, file = fname) + } + } } } # run.ensemble.analysis @@ -186,30 +186,19 @@ read.ensemble.ts <- function(settings, ensemble.id = NULL, variable = NULL, if (is.null(start.year) | is.null(end.year)) { PEcAn.logger::logger.severe("No years given for ensemble analysis!") } - - if (is.null(variable)) { - if ("variable" %in% names(settings$ensemble)) { - var <- which(names(settings$ensemble) == "variable") - for (i in seq_along(var)) { - variable[i] <- settings$ensemble[[var[i]]] - } - } - } + if (is.null(variable)) { - PEcAn.logger::logger.severe("No variables for ensemble analysis!") + PEcAn.logger::logger.severe("No variables for ensemble time series analysis!") } # Only handling one variable at a time for now - if (length(variable) > 1) { - variable <- variable[1] - PEcAn.logger::logger.warn(paste0("Currently performs ensemble analysis on only one variable at a time. Using first (", - variable, ")")) - } + PEcAn.logger::logger.warn(paste0("Currently performing ensemble time series analysis on variable ", + variable, ")")) variables <- PEcAn.utils::convert.expr(variable) variable.ens <- variables$variable.eqn variable.fn <- variables$variable.drv - + print(paste("----- Variable: ", variable.fn, sep="")) print("----- Reading ensemble output ------") @@ -218,14 +207,14 @@ read.ensemble.ts <- function(settings, ensemble.id = NULL, variable = NULL, ### compatibility still contains the sample info for (the most recent) sensitivity ### and ensemble analysis combined. if (!is.null(ensemble.id)) { - fname <- PEcAn.utils::ensemble.filename(settings, "ensemble.samples", "Rdata", - ensemble.id = ensemble.id, - all.var.yr = TRUE) + fname <- ensemble.filename(settings, "ensemble.samples", "Rdata", + ensemble.id = ensemble.id, + all.var.yr = TRUE) } else if (!is.null(settings$ensemble$ensemble.id)) { ensemble.id <- settings$ensemble$ensemble.id - fname <- PEcAn.utils::ensemble.filename(settings, "ensemble.samples", "Rdata", - ensemble.id = ensemble.id, - all.var.yr = TRUE) + fname <- ensemble.filename(settings, "ensemble.samples", "Rdata", + ensemble.id = ensemble.id, + all.var.yr = TRUE) } else { fname <- file.path(settings$outdir, "samples.Rdata") } @@ -243,7 +232,7 @@ read.ensemble.ts <- function(settings, ensemble.id = NULL, variable = NULL, expr <- variable.ens$expression variables <- variable.ens$variables - + ## read ensemble output # Leaving list output even though only one variable allowed for now. Will improve backwards compatibility and maybe help in the future. ensemble.ts <- vector("list", length(variables)) @@ -263,32 +252,32 @@ read.ensemble.ts <- function(settings, ensemble.id = NULL, variable = NULL, # derivation newrun <- eval(parse(text = expr)) - + if(is.null(newrun)){ - # run failed - # skip to next + # run failed + # skip to next next } for(j in seq_along(variable.fn)){ - + if(is.null(ensemble.ts[[1]])){ # dimensions of the sublist matrix hasn't been declared yet ensemble.ts[[j]] <- matrix(NA,ensemble.size,length(newrun)) } ensemble.ts[[j]][as.numeric(row),] <- newrun - + } } - + names(ensemble.ts) <- variable.fn # BMR 10/16/13 Save this variable now to operate later on - fname <- PEcAn.utils::ensemble.filename(settings, "ensemble.ts", "Rdata", - all.var.yr = FALSE, - ensemble.id = ensemble.id, - variable = variable, - start.year = start.year, - end.year = end.year) + fname <- ensemble.filename(settings, "ensemble.ts", "Rdata", + all.var.yr = FALSE, + ensemble.id = ensemble.id, + variable = variable, + start.year = start.year, + end.year = end.year) save(ensemble.ts, file = fname) return(ensemble.ts) diff --git a/modules/uncertainty/R/run.sensitivity.analysis.R b/modules/uncertainty/R/run.sensitivity.analysis.R index f58eec9f3f7..ea57be97944 100644 --- a/modules/uncertainty/R/run.sensitivity.analysis.R +++ b/modules/uncertainty/R/run.sensitivity.analysis.R @@ -33,126 +33,131 @@ run.sensitivity.analysis <- function(settings,plot=TRUE, ensemble.id=NULL, varia if(is.null(start.year) | is.null(end.year)) { PEcAn.logger::logger.severe("No years given for sensitivity analysis!") } - - if(is.null(variable)) { - variable = settings$sensitivity.analysis$variable + if (is.null(variable)) { + if ("variable" %in% names(settings$sensitivity.analysis)) { + var <- which(names(settings$sensitivity.analysis) == "variable") + for (i in seq_along(var)) { + variable[i] <- settings$sensitivity.analysis[[var[i]]] + } + } } if(is.null(variable)) { - PEcAn.logger::logger.severe("No variables for ensemble analysis!") - } - - # Only handling one variable at a time for now - if(length(variable) > 1) { - variable <- variable[1] - PEcAn.logger::logger.warn(paste0("Currently performs ensemble analysis on only one variable at a time. Using first (", variable, ")")) - } - - ### Load samples - # Have to load samples.Rdata for the traits. But can overwrite the run ids if a sensitivity analysis ensemble id provided. samples.Rdata always has only the most recent ensembles for both ensemble and sensitivity runs. - fname <- file.path(settings$outdir, 'samples.Rdata') - if(!file.exists(fname)) PEcAn.logger::logger.severe("No samples.Rdata file found!") - load(fname) - - # Can specify ensemble ids manually. If not, look in settings. If none there, will use the most recent, which was loaded with samples.Rdata - if(!is.null(ensemble.id)) { - fname <- sensitivity.filename(settings, "sensitivity.samples", "Rdata", - ensemble.id=ensemble.id, all.var.yr=TRUE) - } else if(!is.null(settings$sensitivity.analysis$ensemble.id)) { - ensemble.id <- settings$sensitivity.analysis$ensemble.id - fname <- sensitivity.filename(settings, "sensitivity.samples", "Rdata", - ensemble.id=ensemble.id, all.var.yr=TRUE) - } else { - ensemble.id <- NULL + PEcAn.logger::logger.severe("No variables for sensitivity analysis!") } - if(file.exists(fname)) load(fname) - - # For backwards compatibility, define some variables if not just loaded - if(!exists("pft.names")) pft.names <- names(trait.samples) - if(!exists("trait.names")) trait.names <- lapply(trait.samples, names) - if(!exists("sa.run.ids")) sa.run.ids <- runs.samples$sa - - ### Load parsed model results - variables <- convert.expr(variable) - variable.fn <- variables$variable.drv - fname <- sensitivity.filename( - settings, "sensitivity.output", "Rdata", all.var.yr = FALSE, - ensemble.id = ensemble.id, variable = variable.fn, - start.year = start.year, end.year = end.year) - load(fname) - - ### Generate SA output and diagnostic plots - sensitivity.results <- list() - for(pft in settings$pfts){ - traits <- trait.names[[pft$name]] - quantiles.str <- rownames(sa.samples[[pft$name]]) - quantiles.str <- quantiles.str[which(quantiles.str != '50')] - quantiles <- as.numeric(quantiles.str)/100 - - C.units <- grepl('^Celsius$', trait.lookup(traits)$units, ignore.case = TRUE) - if(any(C.units)){ - for(x in which(C.units)) { - trait.samples[[pft$name]][[x]] <- udunits2::ud.convert(trait.samples[[pft$name]][[x]], "degC", "K") + variables <- variable + if(length(variables) >= 1) { + for(variable in variables){ + PEcAn.logger::logger.warn(paste0("Currently performing sensitivity analysis on variable ", variable)) + + ### Load samples + # Have to load samples.Rdata for the traits. But can overwrite the run ids if a sensitivity analysis ensemble id provided. samples.Rdata always has only the most recent ensembles for both ensemble and sensitivity runs. + fname <- file.path(settings$outdir, 'samples.Rdata') + if(!file.exists(fname)) PEcAn.logger::logger.severe("No samples.Rdata file found!") + load(fname) + + # Can specify ensemble ids manually. If not, look in settings. If none there, will use the most recent, which was loaded with samples.Rdata + if(!is.null(ensemble.id)) { + fname <- sensitivity.filename(settings, "sensitivity.samples", "Rdata", + ensemble.id=ensemble.id, all.var.yr=TRUE) + } else if(!is.null(settings$sensitivity.analysis$ensemble.id)) { + ensemble.id <- settings$sensitivity.analysis$ensemble.id + fname <- sensitivity.filename(settings, "sensitivity.samples", "Rdata", + ensemble.id=ensemble.id, all.var.yr=TRUE) + } else { + ensemble.id <- NULL } - } - - ## only perform sensitivity analysis on traits where no more than 2 results are missing - good.saruns <- sapply(sensitivity.output[[pft$name]], function(x) sum(is.na(x)) <=2) - if(!all(good.saruns)) { # if any bad saruns, reduce list of traits and print warning - bad.saruns <- !good.saruns - warning(paste('missing >2 runs for', vecpaste(traits[bad.saruns]), - '\n sensitivity analysis or variance decomposition will be performed on these trait(s)', - '\n it is likely that the runs did not complete, this should be fixed !!!!!!')) - } - - ### Gather SA results - sensitivity.results[[pft$name]] <- sensitivity.analysis( - trait.samples = trait.samples[[pft$name]][traits], - sa.samples = sa.samples[[pft$name]][ ,traits, drop=FALSE], - sa.output = sensitivity.output[[pft$name]][ ,traits, drop=FALSE], - outdir = pft$outdir) - - ### Send diagnostic output to the console - print(sensitivity.results[[pft$name]]$variance.decomposition.output) - print(sensitivity.output[[pft$name]]) - - ### Plotting - Optional - if(plot){ + if(file.exists(fname)) load(fname) + + # For backwards compatibility, define some variables if not just loaded + if(!exists("pft.names")) pft.names <- names(trait.samples) + if(!exists("trait.names")) trait.names <- lapply(trait.samples, names) + if(!exists("sa.run.ids")) sa.run.ids <- runs.samples$sa + + ### Load parsed model results + variables <- PEcAn.utils::convert.expr(variable) + variable.fn <- variables$variable.drv + fname <- sensitivity.filename( - settings, "sensitivity.analysis", "pdf", - all.var.yr=FALSE, pft=pft$name, ensemble.id=ensemble.id, variable=variable.fn, - start.year=start.year, end.year=end.year) - - ### Generate SA diagnostic plots - sensitivity.plots <- plot_sensitivities( - sensitivity.results[[pft$name]]$sensitivity.output, linesize = 1, dotsize = 3) - - pdf(fname, height = 12, width = 9) - ## arrange plots http://stackoverflow.com/q/10706753/199217 - ncol <- floor(sqrt(length(sensitivity.plots))) - print(do.call("grid.arrange", c(sensitivity.plots, ncol=ncol))) - print(sensitivity.plots) # old method. depreciated. - dev.off() - - ### Generate VD diagnostic plots - vd.plots <- plot_variance_decomposition(sensitivity.results[[pft$name]]$variance.decomposition.output) - #variance.scale = log, variance.prefix='Log') - fname <- sensitivity.filename(settings, "variance.decomposition", "pdf", - all.var.yr=FALSE, pft=pft$name, ensemble.id=ensemble.id, variable=variable.fn, + settings, "sensitivity.output", "Rdata", all.var.yr = FALSE, + ensemble.id = ensemble.id, variable = variable.fn, + start.year = start.year, end.year = end.year) + load(fname) + + ### Generate SA output and diagnostic plots + sensitivity.results <- list() + for(pft in settings$pfts){ + traits <- trait.names[[pft$name]] + quantiles.str <- rownames(sa.samples[[pft$name]]) + quantiles.str <- quantiles.str[which(quantiles.str != '50')] + quantiles <- as.numeric(quantiles.str)/100 + + C.units <- grepl('^Celsius$', trait.lookup(traits)$units, ignore.case = TRUE) + if(any(C.units)){ + for(x in which(C.units)) { + trait.samples[[pft$name]][[x]] <- udunits2::ud.convert(trait.samples[[pft$name]][[x]], "degC", "K") + } + } + + ## only perform sensitivity analysis on traits where no more than 2 results are missing + good.saruns <- sapply(sensitivity.output[[pft$name]], function(x) sum(is.na(x)) <=2) + if(!all(good.saruns)) { # if any bad saruns, reduce list of traits and print warning + bad.saruns <- !good.saruns + warning(paste('missing >2 runs for', vecpaste(traits[bad.saruns]), + '\n sensitivity analysis or variance decomposition will be performed on these trait(s)', + '\n it is likely that the runs did not complete, this should be fixed !!!!!!')) + } + + ### Gather SA results + sensitivity.results[[pft$name]] <- sensitivity.analysis( + trait.samples = trait.samples[[pft$name]][traits], + sa.samples = sa.samples[[pft$name]][ ,traits, drop=FALSE], + sa.output = sensitivity.output[[pft$name]][ ,traits, drop=FALSE], + outdir = pft$outdir) + + ### Send diagnostic output to the console + print(sensitivity.results[[pft$name]]$variance.decomposition.output) + print(sensitivity.output[[pft$name]]) + + ### Plotting - Optional + if(plot){ + fname <- sensitivity.filename( + settings, "sensitivity.analysis", "pdf", + all.var.yr=FALSE, pft=pft$name, ensemble.id=ensemble.id, variable=variable.fn, + start.year=start.year, end.year=end.year) + + ### Generate SA diagnostic plots + sensitivity.plots <- plot_sensitivities( + sensitivity.results[[pft$name]]$sensitivity.output, linesize = 1, dotsize = 3) + + pdf(fname, height = 12, width = 9) + ## arrange plots http://stackoverflow.com/q/10706753/199217 + ncol <- floor(sqrt(length(sensitivity.plots))) + print(do.call("grid.arrange", c(sensitivity.plots, ncol=ncol))) + print(sensitivity.plots) # old method. depreciated. + dev.off() + + ### Generate VD diagnostic plots + vd.plots <- plot_variance_decomposition(sensitivity.results[[pft$name]]$variance.decomposition.output) + #variance.scale = log, variance.prefix='Log') + fname <- sensitivity.filename(settings, "variance.decomposition", "pdf", + all.var.yr=FALSE, pft=pft$name, ensemble.id=ensemble.id, variable=variable.fn, + start.year=start.year, end.year=end.year) + + pdf(fname, width = 11, height = 8) + do.call(grid.arrange, c(vd.plots, ncol = 4)) + dev.off() + } + + } ## end if sensitivity analysis + + fname <- sensitivity.filename(settings, "sensitivity.results", "Rdata", + all.var.yr=FALSE, pft=NULL, ensemble.id=ensemble.id, variable=variable.fn, start.year=start.year, end.year=end.year) - - pdf(fname, width = 11, height = 8) - do.call(grid.arrange, c(vd.plots, ncol = 4)) - dev.off() + + save(sensitivity.results, file = fname) } - - } ## end if sensitivity analysis - - fname <- sensitivity.filename(settings, "sensitivity.results", "Rdata", - all.var.yr=FALSE, pft=NULL, ensemble.id=ensemble.id, variable=variable.fn, - start.year=start.year, end.year=end.year) - - save(sensitivity.results, file = fname) + } } } #==================================================================================================# diff --git a/base/utils/R/sensitivity.R b/modules/uncertainty/R/sensitivity.R similarity index 88% rename from base/utils/R/sensitivity.R rename to modules/uncertainty/R/sensitivity.R index 5e898874c5c..4335bc0786f 100644 --- a/base/utils/R/sensitivity.R +++ b/modules/uncertainty/R/sensitivity.R @@ -20,10 +20,12 @@ ##' @param pft.name name of PFT used in sensitivity analysis (Optional) ##' @param start.year first year to include in sensitivity analysis ##' @param end.year last year to include in sensitivity analysis -##' @param variables variables to be read from model output +##' @param variable variables to be read from model output ##' @param per.pft flag to determine whether we want SA on pft-specific variables +##' @param sa.run.ids list of run ids to read. +##' If NULL, will look in `pecandir` for a file named `samples.Rdata` +##' and read from that ##' @export -##' @importFrom magrittr %>% ##' @author Ryan Kelly, David LeBauer, Rob Kooper, Mike Dietze, Istem Fer #--------------------------------------------------------------------------------------------------# ##' @author Ryan Kelly, David LeBauer, Rob Kooper, Mike Dietze @@ -34,8 +36,9 @@ read.sa.output <- function(traits, quantiles, pecandir, outdir, pft.name = "", if (is.null(sa.run.ids)) { samples.file <- file.path(pecandir, "samples.Rdata") if (file.exists(samples.file)) { - load(samples.file) - sa.run.ids <- runs.samples$sa + samples <- new.env() + load(samples.file, envir = samples) + sa.run.ids <- samples$runs.samples$sa } else { PEcAn.logger::logger.error(samples.file, "not found, this file is required by the read.sa.output function") } @@ -56,10 +59,12 @@ read.sa.output <- function(traits, quantiles, pecandir, outdir, pft.name = "", # if SA is requested on a variable available per pft, pass pft.name to read.output # so that it only returns values for that pft pass_pft <- switch(per.pft + 1, NULL, pft.name) - out.tmp <- read.output(runid = run.id, outdir = file.path(outdir, run.id), - start.year = start.year, end.year = end.year, - variables = variables[var], - pft.name = pass_pft) + out.tmp <- PEcAn.utils::read.output( + runid = run.id, + outdir = file.path(outdir, run.id), + start.year = start.year, end.year = end.year, + variables = variables[var], + pft.name = pass_pft) assign(variables[var], out.tmp[[variables[var]]]) } @@ -101,7 +106,7 @@ write.sa.configs <- function(defaults, quantile.samples, settings, model, if (inherits(con, "try-error")) { con <- NULL } else { - on.exit(PEcAn.DB::db.close(con)) + on.exit(PEcAn.DB::db.close(con), add = TRUE) } } else { con <- NULL @@ -121,11 +126,11 @@ write.sa.configs <- function(defaults, quantile.samples, settings, model, runs <- data.frame() # Reading the site.pft specific tags from xml - site.pfts.vec <- settings$run$site$site.pft %>% unlist %>% as.character + site.pfts.vec <- as.character(unlist(settings$run$site$site.pft)) if(!is.null(site.pfts.vec)){ # find the name of pfts defined in the body of pecan.xml - defined.pfts <- settings$pfts %>% purrr::map('name') %>% unlist %>% as.character + defined.pfts <- as.character(unlist(purrr::map(settings$pfts, 'name'))) # subset ensemble samples based on the pfts that are specified in the site and they are also sampled from. if (length(which(site.pfts.vec %in% defined.pfts)) > 0 ) quantile.samples <- quantile.samples [site.pfts.vec[ which(site.pfts.vec %in% defined.pfts) ]] @@ -180,7 +185,7 @@ write.sa.configs <- function(defaults, quantile.samples, settings, model, } } } else { - run.id <- get.run.id("SA", "median") + run.id <- PEcAn.utils::get.run.id("SA", "median") ensemble.id <- NA } medianrun <- run.id @@ -255,42 +260,38 @@ write.sa.configs <- function(defaults, quantile.samples, settings, model, trait.samples[[i]][trait] <- quantile.samples[[i]][quantile.str, trait, drop=FALSE] if (!is.null(con)) { - now <- format(Sys.time(), "%Y-%m-%d %H:%M:%S") paramlist <- paste0("quantile=", quantile.str, ",trait=", trait, ",pft=", pftname) - PEcAn.DB::db.query(paste0("INSERT INTO runs (model_id, site_id, start_time, finish_time, outdir, created_at, ensemble_id, parameter_list) values ('", + insert_result <- PEcAn.DB::db.query(paste0("INSERT INTO runs (model_id, site_id, start_time, finish_time, outdir, ensemble_id, parameter_list) values ('", settings$model$id, "', '", settings$run$site$id, "', '", settings$run$start.date, "', '", settings$run$end.date, "', '", - settings$run$outdir, "', '", - now, "', ", + settings$run$outdir, "', ", ensemble.id, ", '", - paramlist, "')"), con = con) - run.id <- PEcAn.DB::db.query(paste0("SELECT id FROM runs WHERE created_at='", - now, "' AND parameter_list='", paramlist, "'"), con = con)[["id"]] + paramlist, "') RETURNING id"), con = con) + run.id <- insert_result[["id"]] # associate posteriors with ensembles for (pft in defaults) { - PEcAn.DB::db.query(paste0("INSERT INTO posteriors_ensembles (posterior_id, ensemble_id, created_at, updated_at) values (", + PEcAn.DB::db.query(paste0("INSERT INTO posteriors_ensembles (posterior_id, ensemble_id) values (", pft$posteriorid, ", ", - ensemble.id, ", '", - now, "', '", now, - "');"), con = con) + ensemble.id, ");"), con = con) } # associate inputs with runs if (!is.null(inputs)) { for (x in inputs) { - PEcAn.DB::db.query(paste0("INSERT INTO inputs_runs (input_id, run_id, created_at) ", - "values (", settings$run$inputs[[x]], ", ", run.id, ", NOW());"), + PEcAn.DB::db.query(paste0("INSERT INTO inputs_runs (input_id, run_id) ", + "values (", settings$run$inputs[[x]], ", ", run.id, ");"), con = con) } } } else { - run.id <- get.run.id("SA", - round(quantile, 3), - trait = trait, - pft.name = names(trait.samples)[i]) + run.id <- PEcAn.utils::get.run.id( + run.type = "SA", + index = round(quantile, 3), + trait = trait, + pft.name = names(trait.samples)[i]) } runs[[pftname]][quantile.str, trait] <- run.id diff --git a/modules/uncertainty/R/sensitivity.analysis.R b/modules/uncertainty/R/sensitivity.analysis.R index 4bb8b229d37..fac5135b7eb 100644 --- a/modules/uncertainty/R/sensitivity.analysis.R +++ b/modules/uncertainty/R/sensitivity.analysis.R @@ -24,7 +24,7 @@ sa.splinefun <- function(quantiles.input, quantiles.output) { #--------------------------------------------------------------------------------------------------# ##' Calculates the standard deviation of the variance estimate ##' -##' Uses the equation \sigma^4\left(\frac{2}{n-1}+\frac{\kappa}{n}\right) +##' Uses the equation \eqn{\sigma^4\left(\frac{2}{n-1}+\frac{\kappa}{n}\right)}{\sigma^4 (2/(n-1) + \kappa/n)} ##' @name sd.var ##' @title Standard deviation of sample variance ##' @param x sample diff --git a/modules/uncertainty/R/variance.R b/modules/uncertainty/R/variance.R index fe3d5511802..04abf493d1d 100644 --- a/modules/uncertainty/R/variance.R +++ b/modules/uncertainty/R/variance.R @@ -29,7 +29,7 @@ variance.stats <- function(x){ ##' @author David LeBauer get.gi.phii <- function(splinefuns, trait.samples, maxn = NULL){ ## check inputs - if(class(trait.samples) == 'list'){ + if(is.list(trait.samples)){ trait.samples <- matrix(unlist(trait.samples), ncol = length(names(trait.samples))) colnames(trait.samples) <- names(splinefuns) @@ -38,7 +38,7 @@ get.gi.phii <- function(splinefuns, trait.samples, maxn = NULL){ trait.samples <- trait.samples[j, ] } } - if(class(trait.samples) != 'matrix'){ + if(!is.matrix(trait.samples)){ stop(paste('variance.decomposition currently does not handle trait.samples of class', class(trait.samples), '\n please convert to list or matrix')) } if(!all(names(splinefuns) %in% colnames(trait.samples))){ @@ -55,8 +55,8 @@ get.gi.phii <- function(splinefuns, trait.samples, maxn = NULL){ ##' Estimate model output based on univariate splines ##' -##' Accepts output from get.gi.phii (the matrix $g(\phi_i)$) and produces -##' spline estimate of $f(phi)$ for use in estimating closure term associated with +##' Accepts output from get.gi.phii (the matrix \eqn{g(\phi_i)}) and produces +##' spline estimate of \eqn{f(\phi)} for use in estimating closure term associated with ##' spline approximation ##' @title Spline Ensemble ##' @author David LeBauer diff --git a/modules/uncertainty/man/ensemble.filename.Rd b/modules/uncertainty/man/ensemble.filename.Rd new file mode 100644 index 00000000000..83bbad2f201 --- /dev/null +++ b/modules/uncertainty/man/ensemble.filename.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get.analysis.filenames.r +\name{ensemble.filename} +\alias{ensemble.filename} +\title{Generate ensemble filenames} +\usage{ +ensemble.filename( + settings, + prefix = "ensemble.samples", + suffix = "Rdata", + all.var.yr = TRUE, + ensemble.id = settings$ensemble$ensemble.id, + variable = settings$ensemble$variable, + start.year = settings$ensemble$start.year, + end.year = settings$ensemble$end.year +) +} +\arguments{ +\item{settings}{list of PEcAn settings.} + +\item{prefix}{string to appear at the beginning of the filename} + +\item{suffix}{file extension: string to appear at the end of the filename} + +\item{all.var.yr}{logical: does ensemble include all vars and years? +If FALSE, filename will include years and vars} + +\item{ensemble.id}{ensemble ID(s)} + +\item{variable}{variable(s) included in the ensemble.} + +\item{start.year, end.year}{first and last year simulated.} +} +\value{ +a vector of filenames, each in the form + `[settings$outdir]/[prefix].[ensemble.ID].[variable].[start.year].[end.year][suffix]`. +} +\description{ +Generates a vector of filenames to be used for PEcAn ensemble output files. +All paths start from directory `settings$outdir`, +which will be created if it does not exist. +} +\details{ +Typically used by passing only a settings object, + but all values can be overridden for manual use. + +If only a single variable or a subset of years are needed, + the generated filename will identify these in the form +If all vars and years are included, set `all.yr.var` to TRUE + to get a filename of the form `prefix.ensemble_id.suffix`. +All elements are recycled vectorwise. +} +\author{ +Ryan Kelly +} diff --git a/modules/uncertainty/man/flux.uncertainty.Rd b/modules/uncertainty/man/flux.uncertainty.Rd index 4fcb037c1fc..586a2edded1 100644 --- a/modules/uncertainty/man/flux.uncertainty.Rd +++ b/modules/uncertainty/man/flux.uncertainty.Rd @@ -4,8 +4,15 @@ \alias{flux.uncertainty} \title{Calculate parameters for heteroskedastic flux uncertainty} \usage{ -flux.uncertainty(measurement, QC = 0, flags = TRUE, bin.num = 10, - transform = identity, minBin = 5, ...) +flux.uncertainty( + measurement, + QC = 0, + flags = TRUE, + bin.num = 10, + transform = identity, + minBin = 5, + ... +) } \arguments{ \item{measurement}{= flux time-series} diff --git a/modules/uncertainty/man/get.ensemble.samples.Rd b/modules/uncertainty/man/get.ensemble.samples.Rd index 6e00ecc5276..ac981dcb82e 100644 --- a/modules/uncertainty/man/get.ensemble.samples.Rd +++ b/modules/uncertainty/man/get.ensemble.samples.Rd @@ -4,8 +4,14 @@ \alias{get.ensemble.samples} \title{Get Ensemble Samples} \usage{ -get.ensemble.samples(ensemble.size, pft.samples, env.samples, - method = "uniform", param.names = NULL, ...) +get.ensemble.samples( + ensemble.size, + pft.samples, + env.samples, + method = "uniform", + param.names = NULL, + ... +) } \arguments{ \item{ensemble.size}{number of runs in model ensemble} diff --git a/modules/uncertainty/man/get.parameter.samples.Rd b/modules/uncertainty/man/get.parameter.samples.Rd index d2e069327b6..28dfbb815c6 100644 --- a/modules/uncertainty/man/get.parameter.samples.Rd +++ b/modules/uncertainty/man/get.parameter.samples.Rd @@ -4,8 +4,11 @@ \alias{get.parameter.samples} \title{Sample from priors or posteriors} \usage{ -get.parameter.samples(settings, posterior.files = rep(NA, - length(settings$pfts)), ens.sample.method = "uniform") +get.parameter.samples( + settings, + posterior.files = rep(NA, length(settings$pfts)), + ens.sample.method = "uniform" +) } \arguments{ \item{pfts}{the pfts node of the list of pecan settings} diff --git a/modules/uncertainty/man/get.results.Rd b/modules/uncertainty/man/get.results.Rd new file mode 100644 index 00000000000..c7275e7f32a --- /dev/null +++ b/modules/uncertainty/man/get.results.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get.results.R +\name{get.results} +\alias{get.results} +\title{Reads model output and runs sensitivity and ensemble analyses} +\usage{ +get.results( + settings, + sa.ensemble.id = NULL, + ens.ensemble.id = NULL, + variable = NULL, + start.year = NULL, + end.year = NULL +) +} +\arguments{ +\item{settings}{list, read from settings file (xml) using \code{\link{read.settings}}} + +\item{sa.ensemble.id, ens.ensemble.id}{ensemble IDs for the sensitivity +analysis and ensemble analysis. +If not provided, they are first looked up from `settings`, +then if not found they are not used and the most recent set of results +is read from \code{samples.Rdata} in directory \code{settings$outdir}} + +\item{variable}{variables to retrieve, as vector of names or expressions} + +\item{start.year, end.year}{first and last years to retrieve} +} +\description{ +Output is placed in model output directory (settings$outdir). +} +\author{ +David LeBauer, Shawn Serbin, Mike Dietze, Ryan Kelly +} diff --git a/modules/uncertainty/man/input.ens.gen.Rd b/modules/uncertainty/man/input.ens.gen.Rd index 9cd4c71a21c..a0804316b68 100644 --- a/modules/uncertainty/man/input.ens.gen.Rd +++ b/modules/uncertainty/man/input.ens.gen.Rd @@ -25,5 +25,5 @@ parent_ids to this function. } \examples{ \dontrun{input.ens.gen(settings,"met","sampling")} - + } diff --git a/modules/uncertainty/man/plot_sensitivities.Rd b/modules/uncertainty/man/plot_sensitivities.Rd index 9e08f68d55f..5d16cd257a6 100644 --- a/modules/uncertainty/man/plot_sensitivities.Rd +++ b/modules/uncertainty/man/plot_sensitivities.Rd @@ -4,8 +4,11 @@ \alias{plot_sensitivities} \title{Plot Sensitivities} \usage{ -plot_sensitivities(sensitivity.plot.inputs, - prior.sensitivity.plot.inputs = NULL, ...) +plot_sensitivities( + sensitivity.plot.inputs, + prior.sensitivity.plot.inputs = NULL, + ... +) } \arguments{ \item{sensitivity.plot.inputs}{inputs} diff --git a/modules/uncertainty/man/plot_sensitivity.Rd b/modules/uncertainty/man/plot_sensitivity.Rd index ccacfca3436..60d1369eb8d 100644 --- a/modules/uncertainty/man/plot_sensitivity.Rd +++ b/modules/uncertainty/man/plot_sensitivity.Rd @@ -4,9 +4,18 @@ \alias{plot_sensitivity} \title{Sensitivity plot} \usage{ -plot_sensitivity(sa.sample, sa.spline, trait, y.range = c(0, 50), - median.i = 4, prior.sa.sample = NULL, prior.sa.spline = NULL, - fontsize = list(title = 12, axis = 8), linesize = 1, dotsize = 2) +plot_sensitivity( + sa.sample, + sa.spline, + trait, + y.range = c(0, 50), + median.i = 4, + prior.sa.sample = NULL, + prior.sa.spline = NULL, + fontsize = list(title = 12, axis = 8), + linesize = 1, + dotsize = 2 +) } \arguments{ \item{sa.sample}{trait quantiles used in sensitivity analysis} diff --git a/modules/uncertainty/man/plot_variance_decomposition.Rd b/modules/uncertainty/man/plot_variance_decomposition.Rd index e8a12b9b493..9a8317c41e0 100644 --- a/modules/uncertainty/man/plot_variance_decomposition.Rd +++ b/modules/uncertainty/man/plot_variance_decomposition.Rd @@ -4,39 +4,18 @@ \alias{plot_variance_decomposition} \title{Variance Decomposition Plots} \usage{ -plot_variance_decomposition(plot.inputs, fontsize = list(title = 18, axis - = 14)) +plot_variance_decomposition( + plot.inputs, + fontsize = list(title = 18, axis = 14) +) } \arguments{ -\item{fontsize}{list specifying the font size of the titles and axes of the graph} - -\item{...}{Output from any number of sensitivity analyses. Output must be of the form +\item{plot.inputs}{Output from a sensitivity analysis. Output must be of the form given by sensitivity.results$variance.decomposition.output in model output} -\item{all.plot.inputs}{Optional argument allowing output from sensitivity analyses to be specified in a list} - -\item{exclude}{vector of strings specifying parameters to omit from the variance decomposition graph} - -\item{convert.var}{function transforming variances to the value displayed in the graph} - -\item{var.label}{label to displayed over variance column} - -\item{order.plot.input}{Output from a sensitivity analysis that is to be used to order parameters. -Parameters are ordered by variance. Defaults to the first sensitivity analysis output given} - -\item{ticks.plot.input}{Output from a sensitivity analysis that is to be used. -Defaults to the first sensitivity analysis output given} - -\item{col}{Color of each sensitivity analysis. Equivalent to col parameter of the plot function.} - -\item{pch}{Shape of each sensitivity analysis. Equivalent to pch parameter of the plot function.} - -\item{main}{Plot title. Useful for multi-pft variance decompositions.} +\item{fontsize}{list specifying the font size of the titles and axes of the graph} } \description{ -Plot results of variance decomposition -} -\details{ Plots variance decomposition tryptich } \examples{ diff --git a/modules/uncertainty/man/read.ensemble.output.Rd b/modules/uncertainty/man/read.ensemble.output.Rd index 91745f27c51..2b6ad72cb69 100644 --- a/modules/uncertainty/man/read.ensemble.output.Rd +++ b/modules/uncertainty/man/read.ensemble.output.Rd @@ -4,8 +4,15 @@ \alias{read.ensemble.output} \title{Read ensemble output} \usage{ -read.ensemble.output(ensemble.size, pecandir, outdir, start.year, end.year, - variable, ens.run.ids = NULL) +read.ensemble.output( + ensemble.size, + pecandir, + outdir, + start.year, + end.year, + variable, + ens.run.ids = NULL +) } \arguments{ \item{ensemble.size}{the number of ensemble members run} diff --git a/modules/uncertainty/man/read.ensemble.ts.Rd b/modules/uncertainty/man/read.ensemble.ts.Rd index a973e65b588..8fe0726670b 100644 --- a/modules/uncertainty/man/read.ensemble.ts.Rd +++ b/modules/uncertainty/man/read.ensemble.ts.Rd @@ -4,8 +4,13 @@ \alias{read.ensemble.ts} \title{Reads an ensemble time-series from PEcAn for the selected target variable} \usage{ -read.ensemble.ts(settings, ensemble.id = NULL, variable = NULL, - start.year = NULL, end.year = NULL) +read.ensemble.ts( + settings, + ensemble.id = NULL, + variable = NULL, + start.year = NULL, + end.year = NULL +) } \value{ list diff --git a/base/utils/man/read.sa.output.Rd b/modules/uncertainty/man/read.sa.output.Rd similarity index 72% rename from base/utils/man/read.sa.output.Rd rename to modules/uncertainty/man/read.sa.output.Rd index a28a814750a..06a0f07196f 100644 --- a/base/utils/man/read.sa.output.Rd +++ b/modules/uncertainty/man/read.sa.output.Rd @@ -4,8 +4,18 @@ \alias{read.sa.output} \title{Read Sensitivity Analysis output} \usage{ -read.sa.output(traits, quantiles, pecandir, outdir, pft.name = "", - start.year, end.year, variable, sa.run.ids = NULL, per.pft = FALSE) +read.sa.output( + traits, + quantiles, + pecandir, + outdir, + pft.name = "", + start.year, + end.year, + variable, + sa.run.ids = NULL, + per.pft = FALSE +) } \arguments{ \item{traits}{model parameters included in the sensitivity analysis} @@ -22,13 +32,17 @@ read.sa.output(traits, quantiles, pecandir, outdir, pft.name = "", \item{end.year}{last year to include in sensitivity analysis} -\item{per.pft}{flag to determine whether we want SA on pft-specific variables} +\item{variable}{variables to be read from model output} + +\item{sa.run.ids}{list of run ids to read. +If NULL, will look in `pecandir` for a file named `samples.Rdata` +and read from that} -\item{variables}{variables to be read from model output} +\item{per.pft}{flag to determine whether we want SA on pft-specific variables} } \value{ dataframe with one col per quantile analysed and one row per trait, -each cell is a list of AGB over time + each cell is a list of AGB over time } \description{ Reads output of sensitivity analysis runs diff --git a/modules/uncertainty/man/run.ensemble.analysis.Rd b/modules/uncertainty/man/run.ensemble.analysis.Rd index 8e840dbea0d..6fdd8da315d 100644 --- a/modules/uncertainty/man/run.ensemble.analysis.Rd +++ b/modules/uncertainty/man/run.ensemble.analysis.Rd @@ -4,9 +4,15 @@ \alias{run.ensemble.analysis} \title{run ensemble.analysis} \usage{ -run.ensemble.analysis(settings, plot.timeseries = NA, - ensemble.id = NULL, variable = NULL, start.year = NULL, - end.year = NULL, ...) +run.ensemble.analysis( + settings, + plot.timeseries = NA, + ensemble.id = NULL, + variable = NULL, + start.year = NULL, + end.year = NULL, + ... +) } \arguments{ \item{plot.timeseries}{if TRUE plots a modeled timeseries of target variable(s) with CIs} diff --git a/modules/uncertainty/man/run.sensitivity.analysis.Rd b/modules/uncertainty/man/run.sensitivity.analysis.Rd index fc5d34a31ae..0ee71d65507 100644 --- a/modules/uncertainty/man/run.sensitivity.analysis.Rd +++ b/modules/uncertainty/man/run.sensitivity.analysis.Rd @@ -4,8 +4,15 @@ \alias{run.sensitivity.analysis} \title{run sensitivity.analysis} \usage{ -run.sensitivity.analysis(settings, plot = TRUE, ensemble.id = NULL, - variable = NULL, start.year = NULL, end.year = NULL, ...) +run.sensitivity.analysis( + settings, + plot = TRUE, + ensemble.id = NULL, + variable = NULL, + start.year = NULL, + end.year = NULL, + ... +) } \arguments{ \item{plot}{logical. Option to generate sensitivity analysis and variance diff --git a/modules/uncertainty/man/runModule.get.results.Rd b/modules/uncertainty/man/runModule.get.results.Rd new file mode 100644 index 00000000000..cd5f741932d --- /dev/null +++ b/modules/uncertainty/man/runModule.get.results.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get.results.R +\name{runModule.get.results} +\alias{runModule.get.results} +\title{Apply get.results to each of a list of settings} +\usage{ +runModule.get.results(settings) +} +\arguments{ +\item{settings}{a PEcAn \code{Settings} or \code{MultiSettings} object} +} +\description{ +Apply get.results to each of a list of settings +} +\seealso{ +get.results +} diff --git a/modules/uncertainty/man/sd.var.Rd b/modules/uncertainty/man/sd.var.Rd index 7bc7b241892..fe6c570e436 100644 --- a/modules/uncertainty/man/sd.var.Rd +++ b/modules/uncertainty/man/sd.var.Rd @@ -16,7 +16,7 @@ estimate of standard deviation of the sample variance Calculates the standard deviation of the variance estimate } \details{ -Uses the equation \sigma^4\left(\frac{2}{n-1}+\frac{\kappa}{n}\right) +Uses the equation \eqn{\sigma^4\left(\frac{2}{n-1}+\frac{\kappa}{n}\right)}{\sigma^4 (2/(n-1) + \kappa/n)} } \references{ Mood, Graybill, Boes 1974 'Introduction to the Theory of Statistics' 3rd ed. p 229; Casella and Berger 'Statistical Inference' p 364 ex. 7.45; 'Reference for Var(s^2)' CrossValidated \url{http://stats.stackexchange.com/q/29905/1381}, 'Calculating required sample size, precision of variance estimate' CrossValidated \url{http://stats.stackexchange.com/q/7004/1381}, 'Variance of Sample Variance?' Mathematics - Stack Exchange \url{http://math.stackexchange.com/q/72975/3733} diff --git a/modules/uncertainty/man/sensitivity.filename.Rd b/modules/uncertainty/man/sensitivity.filename.Rd new file mode 100644 index 00000000000..f65939c0242 --- /dev/null +++ b/modules/uncertainty/man/sensitivity.filename.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get.analysis.filenames.r +\name{sensitivity.filename} +\alias{sensitivity.filename} +\title{Generate sensitivity analysis filenames} +\usage{ +sensitivity.filename( + settings, + prefix = "sensitivity.samples", + suffix = "Rdata", + all.var.yr = TRUE, + pft = NULL, + ensemble.id = settings$sensitivity.analysis$ensemble.id, + variable = settings$sensitivity.analysis$variable, + start.year = settings$sensitivity.analysis$start.year, + end.year = settings$sensitivity.analysis$end.year +) +} +\arguments{ +\item{settings}{list of PEcAn settings.} + +\item{prefix}{string to appear at the beginning of the filename} + +\item{suffix}{file extension: string to appear at the end of the filename} + +\item{all.var.yr}{logical: does ensemble include all vars and years? +If FALSE, filename will include years and vars} + +\item{pft}{name of PFT used for analysis. If NULL, assumes all +PFTs in run are used and does not add them to the filename} + +\item{ensemble.id}{ensemble ID(s)} + +\item{variable}{variable(s) included in the ensemble.} + +\item{start.year}{first and last year simulated.} + +\item{end.year}{first and last year simulated.} +} +\value{ +a filename +} +\description{ +Generate sensitivity analysis filenames +} +\details{ +Generally uses values in settings, but can be overwritten for manual uses +} +\author{ +Ryan Kelly +} diff --git a/modules/uncertainty/man/spline.ensemble.Rd b/modules/uncertainty/man/spline.ensemble.Rd index 5dbf10b467a..0827106a184 100644 --- a/modules/uncertainty/man/spline.ensemble.Rd +++ b/modules/uncertainty/man/spline.ensemble.Rd @@ -15,8 +15,8 @@ spline.ensemble(gi.phii, median) Estimate model output based on univariate splines } \details{ -Accepts output from get.gi.phii (the matrix $g(\phi_i)$) and produces -spline estimate of $f(phi)$ for use in estimating closure term associated with +Accepts output from get.gi.phii (the matrix \eqn{g(\phi_i)}) and produces +spline estimate of \eqn{f(\phi)} for use in estimating closure term associated with spline approximation } \author{ diff --git a/modules/uncertainty/man/write.ensemble.configs.Rd b/modules/uncertainty/man/write.ensemble.configs.Rd index 05ffa4e39c6..c1df116166e 100644 --- a/modules/uncertainty/man/write.ensemble.configs.Rd +++ b/modules/uncertainty/man/write.ensemble.configs.Rd @@ -4,8 +4,15 @@ \alias{write.ensemble.configs} \title{Write ensemble config files} \usage{ -write.ensemble.configs(defaults, ensemble.samples, settings, model, - clean = FALSE, write.to.db = TRUE, restart = NULL) +write.ensemble.configs( + defaults, + ensemble.samples, + settings, + model, + clean = FALSE, + write.to.db = TRUE, + restart = NULL +) } \arguments{ \item{defaults}{pft} diff --git a/base/utils/man/write.sa.configs.Rd b/modules/uncertainty/man/write.sa.configs.Rd similarity index 89% rename from base/utils/man/write.sa.configs.Rd rename to modules/uncertainty/man/write.sa.configs.Rd index 5bd0bfdf101..281894d39d7 100644 --- a/base/utils/man/write.sa.configs.Rd +++ b/modules/uncertainty/man/write.sa.configs.Rd @@ -4,8 +4,14 @@ \alias{write.sa.configs} \title{Write sensitivity analysis config files} \usage{ -write.sa.configs(defaults, quantile.samples, settings, model, - clean = FALSE, write.to.db = TRUE) +write.sa.configs( + defaults, + quantile.samples, + settings, + model, + clean = FALSE, + write.to.db = TRUE +) } \arguments{ \item{defaults}{named list with default parameter values} diff --git a/modules/uncertainty/tests/Rcheck_reference.log b/modules/uncertainty/tests/Rcheck_reference.log new file mode 100644 index 00000000000..fa30301a0e8 --- /dev/null +++ b/modules/uncertainty/tests/Rcheck_reference.log @@ -0,0 +1,318 @@ +* using log directory ‘/tmp/Rtmpy5mZ7I/PEcAn.uncertainty.Rcheck’ +* using R version 3.5.2 (2018-12-20) +* using platform: x86_64-pc-linux-gnu (64-bit) +* using session charset: UTF-8 +* using options ‘--no-tests --no-manual --as-cran’ +* checking for file ‘PEcAn.uncertainty/DESCRIPTION’ ... OK +* checking extension type ... Package +* this is package ‘PEcAn.uncertainty’ version ‘1.7.0’ +* package encoding: UTF-8 +* checking package namespace information ... OK +* checking package dependencies ... OK +* checking if this is a source package ... OK +* checking if there is a namespace ... OK +* checking for executable files ... OK +* checking for hidden files and directories ... OK +* checking for portable file names ... OK +* checking for sufficient/correct file permissions ... OK +* checking serialization versions ... OK +* checking whether package ‘PEcAn.uncertainty’ can be installed ... OK +* checking installed package size ... OK +* checking package directory ... OK +* checking DESCRIPTION meta-information ... NOTE +Authors@R field gives no person with name and roles. +Authors@R field gives no person with maintainer role, valid email +address and non-empty name. +* checking top-level files ... OK +* checking for left-over files ... OK +* checking index information ... OK +* checking package subdirectories ... OK +* checking R files for non-ASCII characters ... OK +* checking R files for syntax errors ... OK +* checking whether the package can be loaded ... OK +* checking whether the package can be loaded with stated dependencies ... OK +* checking whether the package can be unloaded cleanly ... OK +* checking whether the namespace can be loaded with stated dependencies ... OK +* checking whether the namespace can be unloaded cleanly ... OK +* checking loading without being on the library search path ... OK +* checking dependencies in R code ... WARNING +'::' or ':::' imports not declared from: + ‘PEcAn.assim.sequential’ ‘PEcAn.data.atmosphere’ +Packages in Depends field not imported from: + ‘ggmap’ ‘ggplot2’ ‘gridExtra’ ‘PEcAn.priors’ ‘PEcAn.utils’ + These packages need to be imported from (in the NAMESPACE file) + for when this namespace is loaded but not attached. +* checking S3 generic/method consistency ... OK +* checking replacement functions ... OK +* checking foreign function calls ... OK +* checking R code for possible problems ... NOTE +ensemble.ts: no visible binding for global variable ‘quantile’ +ensemble.ts: no visible global function definition for ‘plot’ +ensemble.ts: no visible global function definition for ‘lines’ +ensemble.ts: no visible global function definition for ‘points’ +ensemble.ts: no visible global function definition for ‘legend’ +ensemble.ts: no visible global function definition for ‘box’ +flux.uncertainty: no visible global function definition for ‘sd’ +flux.uncertainty: no visible global function definition for ‘lm’ +format.plot.input: no visible global function definition for + ‘trait.lookup’ +get.coef.var: no visible global function definition for ‘var’ +get.coef.var: no visible global function definition for ‘median’ +get.elasticity: no visible global function definition for ‘median’ +get.gi.phii: no visible global function definition for ‘laply’ +get.parameter.samples: no visible global function definition for + ‘dbfile.check’ +get.parameter.samples: no visible binding for global variable + ‘post.distns’ +get.parameter.samples: no visible binding for global variable + ‘trait.mcmc’ +get.parameter.samples: no visible global function definition for + ‘get.quantiles’ +get.parameter.samples: no visible global function definition for + ‘vecpaste’ +get.parameter.samples: no visible global function definition for + ‘get.sa.sample.list’ +get.results: no visible binding for global variable ‘trait.samples’ +get.results: no visible binding for global variable ‘runs.samples’ +get.results: no visible binding for global variable ‘sa.samples’ +get.sensitivity: no visible global function definition for ‘median’ +kurtosis: no visible global function definition for ‘sd’ +plot_flux_uncertainty: no visible global function definition for ‘plot’ +plot_flux_uncertainty: no visible global function definition for + ‘lines’ +plot_flux_uncertainty: no visible global function definition for + ‘legend’ +plot_sensitivity: no visible global function definition for + ‘trait.lookup’ +plot_sensitivity: no visible global function definition for ‘ggplot’ +plot_sensitivity: no visible global function definition for ‘geom_line’ +plot_sensitivity: no visible global function definition for ‘aes’ +plot_sensitivity: no visible binding for global variable ‘x’ +plot_sensitivity: no visible binding for global variable ‘y’ +plot_sensitivity: no visible global function definition for + ‘geom_point’ +plot_sensitivity: no visible global function definition for + ‘scale_y_continuous’ +plot_sensitivity: no visible global function definition for ‘theme_bw’ +plot_sensitivity: no visible global function definition for ‘ggtitle’ +plot_sensitivity: no visible global function definition for ‘theme’ +plot_sensitivity: no visible global function definition for + ‘element_text’ +plot_sensitivity: no visible global function definition for + ‘element_blank’ +plot_sensitivity: no visible global function definition for + ‘scale_x_continuous’ +plot_variance_decomposition: no visible global function definition for + ‘theme_set’ +plot_variance_decomposition: no visible global function definition for + ‘theme_classic’ +plot_variance_decomposition: no visible global function definition for + ‘theme’ +plot_variance_decomposition: no visible global function definition for + ‘element_text’ +plot_variance_decomposition: no visible global function definition for + ‘element_blank’ +plot_variance_decomposition: no visible global function definition for + ‘trait.lookup’ +plot_variance_decomposition: no visible global function definition for + ‘ggplot’ +plot_variance_decomposition: no visible global function definition for + ‘coord_flip’ +plot_variance_decomposition: no visible global function definition for + ‘ggtitle’ +plot_variance_decomposition: no visible global function definition for + ‘geom_text’ +plot_variance_decomposition: no visible global function definition for + ‘aes’ +plot_variance_decomposition: no visible binding for global variable + ‘points’ +plot_variance_decomposition: no visible global function definition for + ‘scale_y_continuous’ +plot_variance_decomposition: no visible global function definition for + ‘geom_pointrange’ +plot_variance_decomposition: no visible binding for global variable + ‘coef.vars’ +plot_variance_decomposition: no visible binding for global variable + ‘elasticities’ +plot_variance_decomposition: no visible binding for global variable + ‘variances’ +plot.oechel.flux: no visible global function definition for ‘par’ +prep.data.assim: no visible global function definition for ‘rexp’ +prep.data.assim: no visible global function definition for + ‘complete.cases’ +prep.data.assim: no visible global function definition for ‘cov’ +read.ameriflux.L2: no visible global function definition for + ‘read.table’ +read.ensemble.output: no visible binding for global variable + ‘runs.samples’ +read.ensemble.ts: no visible binding for global variable ‘runs.samples’ +run.ensemble.analysis: no visible global function definition for + ‘convert.expr’ +run.ensemble.analysis: no visible global function definition for + ‘mstmipvar’ +run.ensemble.analysis: no visible global function definition for + ‘ensemble.filename’ +run.ensemble.analysis: no visible binding for global variable + ‘ensemble.output’ +run.ensemble.analysis: no visible global function definition for ‘pdf’ +run.ensemble.analysis: no visible global function definition for ‘par’ +run.ensemble.analysis: no visible global function definition for ‘hist’ +run.ensemble.analysis: no visible global function definition for ‘box’ +run.ensemble.analysis: no visible global function definition for + ‘boxplot’ +run.ensemble.analysis: no visible global function definition for + ‘dev.off’ +run.sensitivity.analysis: no visible global function definition for + ‘sensitivity.filename’ +run.sensitivity.analysis: no visible binding for global variable + ‘runs.samples’ +run.sensitivity.analysis: no visible global function definition for + ‘convert.expr’ +run.sensitivity.analysis: no visible binding for global variable + ‘sa.samples’ +run.sensitivity.analysis: no visible global function definition for + ‘trait.lookup’ +run.sensitivity.analysis: no visible binding for global variable + ‘sensitivity.output’ +run.sensitivity.analysis: no visible global function definition for + ‘vecpaste’ +run.sensitivity.analysis: no visible global function definition for + ‘pdf’ +run.sensitivity.analysis: no visible global function definition for + ‘dev.off’ +run.sensitivity.analysis: no visible binding for global variable + ‘grid.arrange’ +runModule.run.ensemble.analysis: no visible global function definition + for ‘is.MultiSettings’ +runModule.run.ensemble.analysis: no visible global function definition + for ‘papply’ +runModule.run.ensemble.analysis: no visible global function definition + for ‘is.Settings’ +runModule.run.sensitivity.analysis: no visible global function + definition for ‘is.MultiSettings’ +runModule.run.sensitivity.analysis: no visible global function + definition for ‘papply’ +runModule.run.sensitivity.analysis: no visible global function + definition for ‘is.Settings’ +sa.splinefun: no visible global function definition for ‘splinefun’ +sd.var: no visible global function definition for ‘var’ +sensitivity.analysis : : no visible global function + definition for ‘var’ +spline.truncate: no visible global function definition for ‘pnorm’ +spline.truncate: no visible global function definition for ‘quantile’ +spline.truncate: no visible global function definition for + ‘zero.truncate’ +tundra.flux.uncertainty : : no visible global function + definition for ‘read.table’ +variance.stats: no visible global function definition for ‘var’ +vd.variance: no visible binding for global variable ‘var’ +write.ensemble.configs: no visible binding for global variable ‘id’ +write.ensemble.configs: no visible binding for global variable + ‘required’ +write.ensemble.configs: no visible binding for global variable ‘tag’ +write.ensemble.configs: no visible binding for global variable + ‘site_id’ +write.ensemble.configs: no visible global function definition for ‘map’ +Undefined global functions or variables: + aes box boxplot coef.vars complete.cases convert.expr coord_flip cov + dbfile.check dev.off elasticities element_blank element_text + ensemble.filename ensemble.output geom_line geom_point + geom_pointrange geom_text get.quantiles get.sa.sample.list ggplot + ggtitle grid.arrange hist id is.MultiSettings is.Settings laply + legend lines lm map median mstmipvar papply par pdf plot pnorm points + post.distns quantile read.table required rexp runs.samples sa.samples + scale_x_continuous scale_y_continuous sd sensitivity.filename + sensitivity.output site_id splinefun tag theme theme_bw theme_classic + theme_set trait.lookup trait.samples trait.mcmc var variances vecpaste + x y zero.truncate +Consider adding + importFrom("graphics", "box", "boxplot", "hist", "legend", "lines", + "par", "plot", "points") + importFrom("grDevices", "dev.off", "pdf") + importFrom("stats", "complete.cases", "cov", "lm", "median", "pnorm", + "quantile", "rexp", "sd", "splinefun", "var") + importFrom("utils", "read.table") +to your NAMESPACE file. +* checking Rd files ... OK +* checking Rd metadata ... OK +* checking Rd line widths ... NOTE +Rd file 'sensitivity.analysis.Rd': + \examples lines wider than 100 characters: + sensitivity.analysis(trait.samples[[pft$name]], sa.samples[[pft$name]], sa.agb[[pft$name]], pft$outdir) + +These lines will be truncated in the PDF manual. +* checking Rd cross-references ... WARNING +Missing link or links in documentation object 'get.gi.phii.Rd': + ‘variance.decomposition’ + +See section 'Cross-references' in the 'Writing R Extensions' manual. + +* checking for missing documentation entries ... WARNING +Undocumented code objects: + ‘runModule.run.ensemble.analysis’ + ‘runModule.run.sensitivity.analysis’ +Undocumented data sets: + ‘ensemble.output’ ‘sensitivity.output’ ‘ensemble.samples’ + ‘sa.samples’ ‘settings’ ‘trait.samples’ +All user-level objects in a package should have documentation entries. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking for code/documentation mismatches ... OK +* checking Rd \usage sections ... WARNING +Undocumented arguments in documentation object 'ensemble.ts' + ‘ensemble.ts’ ‘observations’ ‘window’ ‘...’ + +Undocumented arguments in documentation object 'flux.uncertainty' + ‘...’ + +Undocumented arguments in documentation object 'get.change' + ‘measurement’ + +Undocumented arguments in documentation object 'get.parameter.samples' + ‘settings’ ‘posterior.files’ ‘ens.sample.method’ + +Undocumented arguments in documentation object 'input.ens.gen' + ‘input’ + +Documented arguments not in \usage in documentation object 'plot_sensitivities': + ‘sensitivity.results’ + +Undocumented arguments in documentation object 'plot_sensitivity' + ‘linesize’ ‘dotsize’ + +Undocumented arguments in documentation object 'read.ameriflux.L2' + ‘file.name’ ‘year’ + +Undocumented arguments in documentation object 'read.ensemble.ts' + ‘settings’ ‘ensemble.id’ ‘variable’ ‘start.year’ ‘end.year’ + +Undocumented arguments in documentation object 'run.ensemble.analysis' + ‘settings’ ‘ensemble.id’ ‘variable’ ‘start.year’ ‘end.year’ ‘...’ + +Undocumented arguments in documentation object 'run.sensitivity.analysis' + ‘settings’ ‘ensemble.id’ ‘variable’ ‘start.year’ ‘end.year’ ‘...’ + +Functions with \usage entries need to have the appropriate \alias +entries, and all their arguments documented. +The \usage entries must correspond to syntactically valid R code. +See chapter ‘Writing R documentation files’ in the ‘Writing R +Extensions’ manual. +* checking Rd contents ... WARNING +Argument items with no description in Rd object 'get.sensitivity': + ‘trait.samples’ ‘sa.splinefun’ + +Argument items with no description in Rd object 'plot_sensitivity': + ‘y.range’ + +Argument items with no description in Rd object 'sa.splinefun': + ‘quantiles.input’ ‘quantiles.output’ + +* checking for unstated dependencies in examples ... OK +* checking contents of ‘data’ directory ... OK +* checking data for non-ASCII characters ... OK +* checking data for ASCII and uncompressed saves ... OK +* checking examples ... OK +* checking for unstated dependencies in ‘tests’ ... OK +* checking tests ... SKIPPED +* DONE +Status: 7 WARNINGs, 3 NOTEs diff --git a/modules/uncertainty/tests/testthat/test.plot.sensitivity.R b/modules/uncertainty/tests/testthat/test.plot.sensitivity.R index 947a30be723..66894d94a09 100644 --- a/modules/uncertainty/tests/testthat/test.plot.sensitivity.R +++ b/modules/uncertainty/tests/testthat/test.plot.sensitivity.R @@ -3,6 +3,6 @@ test_that("plot_sensitivity.analysis works",{ sa.splinefun <- splinefun(1:10,10:1) trait <- "foo" sa.plot <- plot_sensitivity(sa.sample, sa.splinefun, trait) - expect_true("ggplot" %in% class(sa.plot)) + expect_true(inherits(sa.plot, "ggplot")) }) diff --git a/release.sh b/release.sh index d490e281b75..9e5b6254679 100755 --- a/release.sh +++ b/release.sh @@ -111,7 +111,7 @@ else fi # push all images -for image in ${OLDEST} $( docker image ls pecan/*:${IMAGE_VERSION} --filter "since=${OLDEST}:${IMAGE_VERSION}" --format "{{ .Repository }}" ); do +for image in pecan/check ${OLDEST} $( docker image ls pecan/*:${IMAGE_VERSION} --filter "since=${OLDEST}:${IMAGE_VERSION}" --format "{{ .Repository }}" ); do for v in ${TAGS}; do if [ "$v" != "${IMAGE_VERSION}" -o "$SERVER" != "" ]; then ${DEBUG} docker tag ${image}:${IMAGE_VERSION} ${SERVER}${image}:${v} diff --git a/scripts/EFI_dataprep.R b/scripts/EFI_dataprep.R new file mode 100644 index 00000000000..112c4438b8b --- /dev/null +++ b/scripts/EFI_dataprep.R @@ -0,0 +1,122 @@ +############################################## +# +# EFI Forecasting Challenge +# +############################################### +#set home directory as object (remember to change to your own directory before running this script) +homedir <- "/projectnb/dietzelab/ahelgeso" + +library(PEcAn.all) +library(tidyverse) +########## Site Info ########### +#read in .csv with site info +setwd(file.path(homedir, 'pecan/scripts/')) #remember to change to where you keep your dataprep .csv file with the site info +data_prep <- read.csv("dataprep_10_sites.csv") #this .csv file contains the NEON site id, BETY site id, and location where you want the met data saved. Remember to change to fit your sites and file path before running the script +data_prep <- filter(data_prep, met_download == "dataprep") +sitename <- data_prep$siteid_NEON4 +siteid <- data_prep$siteid_BETY4 +base_dir <- data_prep$base_dir4 + +#run info +start_date = format(Sys.Date()-2, "%Y-%m-%d") + +for(i in 1:length(sitename)){ + +###### Download Data ########### + +download_noaa_files_s3 <- function(siteID, date, cycle, local_directory){ + + Sys.setenv("AWS_DEFAULT_REGION" = "data", + "AWS_S3_ENDPOINT" = "ecoforecast.org") + + object <- aws.s3::get_bucket("drivers", prefix=paste0("noaa/NOAAGEFS_1hr/",siteID,"/",date,"/",cycle)) + + for(j in 1:length(object)){ + aws.s3::save_object(object[[j]], bucket = "drivers", file = file.path(local_directory, object[[j]]$Key)) + } +} + + +download_noaa_files_s3(siteID = sitename[i], date = as.Date(start_date), cycle = "00", local_directory <- base_dir[i] )# } + + +############ Downscale to 30 minutes ############## + +input_path = file.path(base_dir[i], "noaa/NOAAGEFS_1hr/", sitename[i], "/", start_date, "/00/") +output_path = file.path(base_dir[i], "noaa/half_hour/", sitename[i], "/", start_date, "/") +files = list.files(input_path) + +if(!dir.exists(output_path)){dir.create(output_path, recursive = TRUE)} + +for(k in 1:length(files)){ + +input_file = paste0(input_path, files[k]) +output_file = paste0(output_path, "Half_Hour_", files[k]) +temporal_downscale_half_hour(input_file = input_file, output_file = output_file , overwrite = FALSE, hr = 0.5) + +} + + + +########## Met2Model For SIPNET ############## +outfolder = file.path(base_dir[i], "noaa_clim/", sitename[i], "/", start_date, "/") +if(!dir.exists(outfolder)){dir.create(outfolder, recursive = TRUE)} + +in.path = dirname(output_path) +in.prefix = list.files(output_path) + +end_date = as.Date(start_date) + lubridate::days(35) + +for(l in 1:length(in.prefix)){ + + PEcAn.SIPNET::met2model.SIPNET(in.path = in.path, + in.prefix = in.prefix[l], + outfolder = outfolder, + start_date = start_date, + end_date = end_date, + overwrite = FALSE, + verbose = FALSE, + year.fragment = TRUE) + +} + +##### register downloaded met to BETY ############## +files = list.files(outfolder) + +### Get BETY information ### +bety <- dplyr::src_postgres(dbname = 'bety', + host = 'psql-pecan.bu.edu', + user = 'bety', + password = 'bety') +con <- bety$con + + + +for(h in 1:length(files)){ + + + + dbfile.input.insert(in.path = outfolder, + in.prefix = files[h], + startdate = start_date, + enddate = end_date, + siteid = siteid[i], + mimetype = "text/csv", + formatname = "Sipnet.climna", + parentid=NA, + con = con, + hostname=PEcAn.remote::fqdn(), + allow.conflicting.dates=TRUE, + ens=TRUE) + + + + +} #closes files for loop + +} #closes sitename for loop + + + + + diff --git a/scripts/EFI_metprocess.R b/scripts/EFI_metprocess.R new file mode 100644 index 00000000000..7483ebddae2 --- /dev/null +++ b/scripts/EFI_metprocess.R @@ -0,0 +1,70 @@ +############################################## +# +# EFI Forecasting Challenge +# +############################################### +#set home directory as object (remember to change to your own directory before running this script) +homedir <- "/projectnb/dietzelab/ahelgeso" + +library(PEcAn.all) +library(tidyverse) +source('/projectnb/dietzelab/ahelgeso/pecan/modules/data.atmosphere/R/download.NOAA_GEFS.R') +source('/projectnb/dietzelab/ahelgeso/pecan/modules/data.atmosphere/R/download.raw.met.module.R') + +#read in .csv with site info +setwd(file.path(homedir, "pecan/scripts/")) #remember to change to where you keep your dataprep .csv file with the site info +data_prep <- read.csv("dataprep_10_sites.csv") #this .csv file contains the sitename, BETY site id, location to store met files, model name, met source (from .xml), and the met output (from .xml) for each site you want to download met data +data_prep <- filter(data_prep, met_download == "metprocess") +sitename <- data_prep$site_name +site_id <- data_prep$siteid_BETY4 +base_dir <- data_prep$base_dir +model_name <- data_prep$model_name4 +met_source <- data_prep$input_met_source4 +met_output <- data_prep$input_met_output4 + +#run info +start_date = as.Date(format(Sys.Date()-1, "%Y-%m-%d")) +end_date = as.Date(format(Sys.Date(), "%Y-%m-%d")) +host = list() + host$name = "localhost" +dbparms = list() + dbparms$dbname = "bety" + dbparms$host = "psql-pecan.bu.edu" + dbparms$user = "bety" + dbparms$password = "bety" + +#met.process + for (i in 1:length(sitename)) { + outfolder = file.path(base_dir[i], "noaa_clim/", sitename[i], "/", start_date, "/") + if(!dir.exists(outfolder)){dir.create(outfolder, recursive = TRUE)} + + input_met = list() + input_met$source = met_source[i] + input_met$output = met_output[i] + + site = list() + site$id = site_id[i] + site$name = sitename[i] + + model = model_name[i] + + met.process(site = site, + input_met = input_met, + start_date = start_date, + end_date = end_date, + model = model, + host = host, + dbparms = dbparms, + dir = outfolder, + browndog = NULL, + spin = NULL, + overwrite = FALSE) + + + + } + + + + + diff --git a/scripts/EFI_workflow.R b/scripts/EFI_workflow.R new file mode 100644 index 00000000000..1ba328895b7 --- /dev/null +++ b/scripts/EFI_workflow.R @@ -0,0 +1,274 @@ +#You must run this script in the terminal using the code: +#Rscript --vanilla EFI_workflow.R "[file path to site xml]" "[file path to output folder]" [start_date] [end_date] + +library("PEcAn.all") +library("PEcAn.utils") +library("RCurl") +library("REddyProc") +library("tidyverse") +library("furrr") +library("R.utils") +library("dynutils") + +###### Preping Workflow for regular SIPNET Run ############## +#set home directory as object (remember to change to your own directory before running this script) +homedir <- "/projectnb/dietzelab/ahelgeso" + +#Load site.xml, start & end date, (with commandArgs specify args in terminal) and outputPath (i.e. where the model outputs will be stored) into args +tmp = commandArgs(trailingOnly = TRUE) +if(length(tmp)<3){ + logger.severe("Missing required arguments") +} +args = list() +args$settings = tmp[1] +if(!file.exists(args$settings)){ + logger.severe("Not a valid xml path") +} +args$outputPath = tmp[2] +if(!isAbsolutePath(args$outputPath)){ + logger.severe("Not a valid outputPath") +} +args$start_date = as.Date(tmp[3]) +if(is.na(args$start_date)){ + logger.severe("No start date provided") +} + +if(length(args)>3){ + args$end_date = as.Date(tmp[4]) +} else { + args$end_date = args$start_date + 35 +} + +if(length(args)>4){ + args$continue = tmp[5] +} else { + args$continue = TRUE +} + +if(!dir.exists(args$outputPath)){dir.create(args$outputPath, recursive = TRUE)} +setwd(args$outputPath) + +# Open and read in settings file for PEcAn run. +settings <- PEcAn.settings::read.settings(args$settings) + +start_date <- args$start_date +end_date<- args$end_date + +# Finding the right end and start date +met.start <- start_date +met.end <- met.start + lubridate::days(35) + + + +settings$run$start.date <- as.character(met.start) +settings$run$end.date <- as.character(met.end) +settings$run$site$met.start <- as.character(met.start) +settings$run$site$met.end <- as.character(met.end) +#info +settings$info$date <- paste0(format(Sys.time(), "%Y/%m/%d %H:%M:%S"), " +0000") + +# Update/fix/check settings. +# Will only run the first time it's called, unless force=TRUE +settings <- + PEcAn.settings::prepare.settings(settings, force = FALSE) + +# Write pecan.CHECKED.xml +PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") + +#manually add in clim files +con <-try(PEcAn.DB::db.open(settings$database$bety), silent = TRUE) + +input_check <- PEcAn.DB::dbfile.input.check( + siteid=settings$run$site$id %>% as.character(), + startdate = settings$run$start.date %>% as.Date, + enddate = NULL, + parentid = NA, + mimetype="text/csv", + formatname="Sipnet.climna", + con = con, + hostname = PEcAn.remote::fqdn(), + pattern = NULL, + exact.dates = TRUE, + return.all=TRUE +) + +#If INPUTS already exists, add id and met path to settings file + +if(length(input_check$id) > 0){ + #met paths + clim_check = list() + for(i in 1:length(input_check$file_path)){ + + clim_check[[i]] <- file.path(input_check$file_path[i], input_check$file_name[i]) + }#end i loop for creating file paths + #ids + index_id = list() + index_path = list() + for(i in 1:length(input_check$id)){ + index_id[[i]] = as.character(input_check$id[i])#get ids as list + + }#end i loop for making lists + names(index_id) = sprintf("id%s",seq(1:length(input_check$id))) #rename list + names(clim_check) = sprintf("path%s",seq(1:length(input_check$id))) + + settings$run$inputs$met$id = index_id + settings$run$inputs$met$path = clim_check +}else{PEcAn.logger::logger.error("No met file found")} +#settings <- PEcAn.workflow::do_conversions(settings, T, T, T) + +if(is_empty(settings$run$inputs$met$path) & length(clim_check)>0){ + settings$run$inputs$met$id = index_id + settings$run$inputs$met$path = clim_check +} +PEcAn.DB::db.close(con) + +# Write out the file with updated settings +PEcAn.settings::write.settings(settings, outputfile = "pecan.GEFS.xml") + +# start from scratch if no continue is passed in +status_file <- file.path(settings$outdir, "STATUS") +if (args$continue && file.exists(status_file)) { + file.remove(status_file) +} + +# Do conversions +#settings <- PEcAn.workflow::do_conversions(settings) + +# Write model specific configs +if (PEcAn.utils::status.check("CONFIG") == 0) { + PEcAn.utils::status.start("CONFIG") + settings <- + PEcAn.workflow::runModule.run.write.configs(settings) + + PEcAn.settings::write.settings(settings, outputfile = "pecan.CONFIGS.xml") + PEcAn.utils::status.end() +} else if (file.exists(file.path(settings$outdir, "pecan.CONFIGS.xml"))) { + settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.CONFIGS.xml")) +} + +if ((length(which(commandArgs() == "--advanced")) != 0) + && (PEcAn.utils::status.check("ADVANCED") == 0)) { + PEcAn.utils::status.start("ADVANCED") + q() +} + +# Start ecosystem model runs +if (PEcAn.utils::status.check("MODEL") == 0) { + PEcAn.utils::status.start("MODEL") + stop_on_error <- as.logical(settings[[c("run", "stop_on_error")]]) + if (length(stop_on_error) == 0) { + # If we're doing an ensemble run, don't stop. If only a single run, we + # should be stopping. + if (is.null(settings[["ensemble"]]) || + as.numeric(settings[[c("ensemble", "size")]]) == 1) { + stop_on_error <- TRUE + } else { + stop_on_error <- FALSE + } + } + PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = stop_on_error) + PEcAn.utils::status.end() +} + +# Get results of model runs +if (PEcAn.utils::status.check("OUTPUT") == 0) { + PEcAn.utils::status.start("OUTPUT") + runModule.get.results(settings) + PEcAn.utils::status.end() +} + +# # Run ensemble analysis on model output. +# if ("ensemble" %in% names(settings) +# && PEcAn.utils::status.check("ENSEMBLE") == 0) { +# PEcAn.utils::status.start("ENSEMBLE") +# runModule.run.ensemble.analysis(settings, TRUE) +# PEcAn.utils::status.end() +# } + +# Run state data assimilation +if ("state.data.assimilation" %in% names(settings)) { + if (PEcAn.utils::status.check("SDA") == 0) { + PEcAn.utils::status.start("SDA") + settings <- sda.enfk(settings) + PEcAn.utils::status.end() + } +} + +# Pecan workflow complete +if (PEcAn.utils::status.check("FINISHED") == 0) { + PEcAn.utils::status.start("FINISHED") + PEcAn.remote::kill.tunnel(settings) + db.query( + paste( + "UPDATE workflows SET finished_at=NOW() WHERE id=", + settings$workflow$id, + "AND finished_at IS NULL" + ), + params = settings$database$bety + ) + + # Send email if configured + if (!is.null(settings$email) + && !is.null(settings$email$to) + && (settings$email$to != "")) { + sendmail( + settings$email$from, + settings$email$to, + paste0("Workflow has finished executing at ", base::date()), + paste0("You can find the results on ", settings$email$url) + ) + } + PEcAn.utils::status.end() +} + +db.print.connections() +print("---------- PEcAn Workflow Complete ----------") + + +#EFI Output Configuration +library("ggplot2") +library("plotly") +library("gganimate") +library("thematic") +thematic_on() +source("/projectnb/dietzelab/ahelgeso/pecan/scripts/efi_data_process.R") +#Load Output args +site.num <- settings$run$site$id +outdir <- args$outputPath +site.name <- settings$run$site$name +wid <- settings$workflow$id + +output_args = c(as.character(wid), site.num, outdir) + +data = efi.data.process(output_args) + +#Run SIPNET Outputs +data.final = data %>% + mutate(date = as.Date(date)) %>% + filter(date < end_date) %>% + arrange(ensemble, date) %>% + mutate(time = as.POSIXct(paste(date, Time, sep = " "), format = "%Y-%m-%d %H %M")) %>% + mutate(siteID = site.name, + forecast = 1, + data_assimilation = 0, + time = lubridate::force_tz(time, tz = "UTC")) +#re-order columns and delete unnecessary columns in data.final +datacols <- c("date", "time", "siteID", "ensemble", "nee", "le", "vswc", "forecast", "data_assimilation") +data.final = data.final[datacols] + +############ Plots to check out reliability of forecast ######################### + +# ggplot(data.final, aes(x = time, y = nee, group = ensemble)) + +# geom_line(aes(x = time, y = nee, color = ensemble)) +# +# ggplot(data.final, aes(x = time, y = le, group = ensemble)) + +# geom_line(aes(x = time, y = le, color = ensemble)) +# +# ggplot(data.final, aes(x = time, y = vswc, group = ensemble)) + +# geom_line(aes(x = time, y = vswc, color = ensemble)) + +########### Export data.final ############### + +write.csv(data.final, file = paste0(site.name, "-", start_date, "-", end_date, ".csv")) + + diff --git a/scripts/Makefile.depends b/scripts/Makefile.depends deleted file mode 100644 index adac6e7c09d..00000000000 --- a/scripts/Makefile.depends +++ /dev/null @@ -1 +0,0 @@ -# autogenerated diff --git a/scripts/add.models.sh b/scripts/add.models.sh index 490d731fdcc..b52c9c247ca 100755 --- a/scripts/add.models.sh +++ b/scripts/add.models.sh @@ -9,17 +9,18 @@ # 3 : model revision number # 4 : name of executable, without the path # 5 : optionally path to executable -addLocalModel "ED2.2" "ED2" "46" "ed2.r46" -addLocalModel "ED2.2" "ED2" "82" "ed2.r82" -addLocalModel "ED2.2" "ED2" "git" "ed2.git" -addLocalModel "SIPNET" "SIPNET" "unk" "sipnet.runk" -addLocalModel "SIPNET" "SIPNET" "136" "sipnet.r136" -addLocalModel "SIPNET" "SIPNET" "git" "sipnet.git" -addLocalModel "DALEC" "DALEC" "" "dalec_seqMH" -addLocalModel "Linkages" "LINKAGES" "git" "linkages.git" -addLocalModel "MAESPA" "MAESPA" "git" "maespa.git" -addLocalModel "LPJ-GUESS" "LPJGUESS" "3.1" "guess.3.1" -addLocalModel "GDAY(Day)" "GDAY" "" "gday" +addLocalModel "ED2.2" "ED2" "46" "ed2.r46" +addLocalModel "ED2.2" "ED2" "82" "ed2.r82" +addLocalModel "ED2.2" "ED2" "git" "ed2.git" +addLocalModel "SIPNET" "SIPNET" "unk" "sipnet.runk" +addLocalModel "SIPNET" "SIPNET" "136" "sipnet.r136" +addLocalModel "SIPNET" "SIPNET" "git" "sipnet.git" +addLocalModel "DALEC" "DALEC" "" "dalec_seqMH" +addLocalModel "Linkages" "LINKAGES" "git" "linkages.git" +addLocalModel "MAESPA" "MAESPA" "git" "maespa.git" +addLocalModel "LPJ-GUESS" "LPJGUESS" "3.1" "guess.3.1" +addLocalModel "GDAY(Day)" "GDAY" "" "gday" +addLocalModel "BASGRA" "BASGRA_N" "v1.0" "basgra" # special case for PRELES addModelFile "${FQDN}" "Preles" "PRELES" "" "true" "/bin" diff --git a/scripts/add.util.sh b/scripts/add.util.sh index 36e3b44637b..ee3ba0bd547 100644 --- a/scripts/add.util.sh +++ b/scripts/add.util.sh @@ -7,9 +7,14 @@ if [ -z "$FQDN" ]; then FQDN=$( hostname -f ) fi +# postgres hostname +if [ -z "$PGHOST" ]; then + PGHOST="localhost" +fi + # command to execute to add items to BETY database if [ -z "$PSQL" ]; then - PSQL="psql -h localhost -U bety bety -q -t -c" + PSQL="psql -h ${PGHOST} -U bety bety -q -t -c" fi # folder to data, this is assumed to be installed at the same level @@ -33,7 +38,7 @@ addFormat() { fi FORMAT_ID=$( ${PSQL} "SELECT id FROM formats WHERE mimetype_id=${MIME_ID} AND name='$2' LIMIT 1;" ) if [ "$FORMAT_ID" == "" ]; then - ${PSQL} "INSERT INTO formats (mimetype_id, name, created_at, updated_at) VALUES (${MIME_ID}, '$2', NOW(), NOW());" + ${PSQL} "INSERT INTO formats (mimetype_id, name) VALUES (${MIME_ID}, '$2');" FORMAT_ID=$( ${PSQL} "SELECT id FROM formats WHERE mimetype_id=${MIME_ID} AND name='$2' LIMIT 1;" ) echo "Added new format with ID=${FORMAT_ID} for mimetype_id=${MIME_ID}, name=$2" fi @@ -62,7 +67,7 @@ addInput() { fi INPUT_ID=$( ${PSQL} "SELECT id FROM inputs WHERE site_id=$1 AND format_id=$2 AND start_date${START_Q} AND end_date${END_Q} LIMIT 1;" ) if [ "$INPUT_ID" == "" ]; then - ${PSQL} "INSERT INTO inputs (site_id, format_id, name, start_date, end_date, created_at, updated_at) VALUES ($1, $2, '', ${START_I}, ${END_I}, NOW(), NOW());" + ${PSQL} "INSERT INTO inputs (site_id, format_id, name, start_date, end_date) VALUES ($1, $2, '', ${START_I}, ${END_I});" INPUT_ID=$( ${PSQL} "SELECT id FROM inputs WHERE site_id=$1 AND format_id=$2 AND start_date${START_Q} AND end_date${END_Q} LIMIT 1;" ) echo "Added new input with ID=${INPUT_ID} for site=$1, format_id=$2, start=$3, end=$4" else @@ -93,8 +98,8 @@ addInputFile() { fi # Make sure host exists - ${PSQL} "INSERT INTO machines (hostname, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" + ${PSQL} "INSERT INTO machines (hostname) + SELECT * FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" # Add file ${PSQL} "INSERT INTO dbfiles (container_type, container_id, file_name, file_path, machine_id) VALUES @@ -116,16 +121,16 @@ addModelFile() { MODELID="(SELECT models.id FROM models, modeltypes WHERE model_name='${2}' AND modeltypes.name='${3}' AND modeltypes.id=models.modeltype_id AND revision='${4}')" # Make sure host exists - ${PSQL} "INSERT INTO machines (hostname, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" + ${PSQL} "INSERT INTO machines (hostname) + SELECT * FROM (SELECT '${1}') AS tmp WHERE NOT EXISTS ${HOSTID};" # Make sure modeltype exists - ${PSQL} "INSERT INTO modeltypes (name, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${3}') AS tmp WHERE NOT EXISTS ${MODELTYPEID};" + ${PSQL} "INSERT INTO modeltypes (name) + SELECT * FROM (SELECT '${3}') AS tmp WHERE NOT EXISTS ${MODELTYPEID};" # Make sure model exists - ${PSQL} "INSERT INTO models (model_name, modeltype_id, revision, created_at, updated_at) - SELECT *, now(), now() FROM (SELECT '${2}', ${MODELTYPEID}, '${4}') AS tmp WHERE NOT EXISTS ${MODELID};" + ${PSQL} "INSERT INTO models (model_name, modeltype_id, revision) + SELECT * FROM (SELECT '${2}', ${MODELTYPEID}, '${4}') AS tmp WHERE NOT EXISTS ${MODELID};" # check if binary already added COUNT=$( ${PSQL} "SELECT COUNT(id) FROM dbfiles WHERE container_type='Model' AND container_id=${MODELID} AND file_name='${5}' AND file_path='${6}' and machine_id=${HOSTID};" ) diff --git a/scripts/check.dependencies.sh b/scripts/check.dependencies.sh deleted file mode 100755 index c2307dd0aba..00000000000 --- a/scripts/check.dependencies.sh +++ /dev/null @@ -1,65 +0,0 @@ -#!/bin/bash -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - -# packages needed which might not be required/library -ALL="ggplot2 randtoolbox gridExtra testthat roxygen2" - -# packages that are not in cran -SKIP="(time)" - -# find all packages needed (require and library) -for f in `find . -type d -name R`; do - NAME=$( echo $f | sed -e 's#\./##' -e 's#/R##' ) - LIB=$( grep -h 'library(.*)' $f/*.R 2>/dev/null | grep -v 'PEcAn' | grep -v '^#' | sed -e 's/.*library("*\([A-Za-z0-9\.]*\).*/\1/' | sort -u ) - LIB=$( echo $LIB ) - - REQ=$( grep -h 'require(.*)' $f/*.R 2>/dev/null | grep -v 'PEcAn' | grep -v '^#' | sed -e 's/.*require("*\([A-Za-z0-9\.]*\).*/\1/' | sort -u ) - REQ=$( echo $REQ ) - - PACKAGE=$( echo $LIB $REQ | tr -s [:space:] \\n | sort -u ) - TEMP=$( echo $PACKAGE) - echo "packages needed for $NAME : $TEMP" - -# for s in $SKIP; do -# PACKAGE=$( echo $PACKAGE | grep -v $s ) -# done - ALL="${ALL} ${PACKAGE}" -done - -echo $ALL - -# sort packages and create little R script -if [ ! -z "$ALL" ]; then - ALL=$( echo $ALL | tr -s [:space:] \\n | sort -u | egrep -v "${SKIP}" ) - ALL=$( echo $ALL ) - ALL=$( echo "'$ALL'" | sed -e "s/ /', '/g" ) - echo "Make sure following packages are installed : " - echo "$ALL" - echo "" - - cat << EOF -echo "list.of.packages <- c($ALL) -new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,'Package'])] -if('BioCro' %in% new.packages){ - biocro <- TRUE - new.packages <- new.packages[!new.packages %in% "BioCro"] -} else { - biocro <- FALSE -} -if(length(new.packages)) { - print('installing : ') - print(new.packages) - install.packages(new.packages, repos='http://cran.us.r-project.org') -} -if(biocro){ - devtools::install_github("ebimodeling/biocro") -} | R --vanilla " -EOF -fi diff --git a/scripts/check_with_errors.R b/scripts/check_with_errors.R old mode 100644 new mode 100755 index f1cd1e39e3a..4a4e8701658 --- a/scripts/check_with_errors.R +++ b/scripts/check_with_errors.R @@ -1,73 +1,202 @@ +#!/usr/bin/env Rscript arg <- commandArgs(trailingOnly = TRUE) pkg <- arg[1] -# Workaround for devtools/#1914: -# check() sets its own values for `_R_CHECK_*` environment variables, without -# checking whether any are already set. It winds up string-concatenating new -# onto old (e.g. "FALSE TRUE") instead of either respecting or overriding them. -# (Fixed in devtools 2.0.1.9000; remove these lines after next CRAN release) -Sys.unsetenv( - c('_R_CHECK_CRAN_INCOMING_', - '_R_CHECK_CRAN_INCOMING_REMOTE_', - '_R_CHECK_FORCE_SUGGESTS_')) +log_level <- Sys.getenv("LOGLEVEL", unset = NA) +die_level <- Sys.getenv("DIELEVEL", unset = NA) +redocument <- as.logical(Sys.getenv("REBUILD_DOCS", unset = NA)) +runtests <- as.logical(Sys.getenv("RUN_TESTS", unset = TRUE)) + +old_file <- file.path(pkg, "tests", "Rcheck_reference.log") +if (file.exists(old_file)) { + # Package has old unfixed warnings that we should ignore by default + # (but if log/die level are explicitly set, respect them) + if (is.na(log_level)) log_level <- "error" + if (is.na(die_level)) die_level <- "error" +} else { + if (is.na(log_level)) log_level <- "all" + if (is.na(die_level)) die_level <- "note" +} -log_level <- Sys.getenv('LOGLEVEL', unset = NA) -die_level <- Sys.getenv('DIELEVEL', unset = NA) -redocument <- as.logical(Sys.getenv('REBUILD_DOCS', unset = NA)) -runtests <- as.logical(Sys.getenv('RUN_TESTS', unset = FALSE)) +log_level <- match.arg(log_level, c("error", "warning", "note", "all")) +die_level <- match.arg(die_level, c("never", "error", "warning", "note")) -# message('log_level = ', log_level) -# message('die_level = ', die_level) +log_warn <- log_level %in% c("warning", "note", "all") +log_notes <- log_level %in% c("note", "all") # should test se run -if (as.logical(Sys.getenv('RUN_TESTS', unset = FALSE))) { - args <- c('--no-tests', '--timings') +if (!runtests) { + args <- c("--no-tests", "--timings") } else { - args <- c('--timings') -} - -valid_log_levels <- c('warn', 'all') -if (!is.na(log_level) && !log_level %in% valid_log_levels) { - stop('Invalid log_level "', log_level, '". Select one of: ', - paste(valid_log_levels, collapse = ', ')) + args <- c("--timings") } -if (!is.na(die_level) && !die_level == 'warn') { - stop('Invalid die_level "', die_level, - '". Use either "warn" for warnings or leave blank for error.') +# devtools 2.4.0 changed values accepted by document argument: +# < 2.4.0: TRUE = yes, FALSE = no, NA = yes if a Roxygen package +# >= 2.4.0: TRUE = yes, FALSE = no, +# NULL = if installed Roxygen is same version as package's RoxygenNote +if ((packageVersion("devtools") >= "2.4.0") && is.na(redocument)) { + redocument <- NULL } -log_warn <- !is.na(log_level) && log_level %in% c('warn', 'all') -die_warn <- !is.na(die_level) && die_level == 'warn' - -log_notes <- !is.na(log_level) && log_level == 'all' - -chk <- devtools::check(pkg, args = args, quiet = TRUE, error_on = "never", document = redocument) +chk <- devtools::check(pkg, args = args, quiet = TRUE, + error_on = die_level, document = redocument) -errors <- chk[['errors']] +errors <- chk[["errors"]] n_errors <- length(errors) - if (n_errors > 0) { - cat(errors, '\n') - stop(n_errors, ' errors found in ', pkg, '. See above for details') + cat(errors, "\n") + stop(n_errors, " errors found in ", pkg, ".") } -warns <- chk[['warnings']] +warns <- chk[["warnings"]] n_warns <- length(warns) -message(n_warns, ' warnings found in ', pkg, '.') - -if ((log_warn|die_warn) && n_warns > 0) { - cat(warns, '\n') - if (die_warn && n_warns > 0) { - stop('Killing process because ', n_warns, ' warnings found in ', pkg, '.') - } +message(n_warns, " warnings found in ", pkg, ".") +if ((log_warn) && n_warns > 0) { + cat(warns, "\n") } -notes <- chk[['notes']] +notes <- chk[["notes"]] n_notes <- length(notes) -message(n_notes, ' notes found in ', pkg, '.') - +message(n_notes, " notes found in ", pkg, ".") if (log_notes && n_notes > 0) { - cat(notes, '\n') + cat(notes, "\n") +} + + +###### + +# PEcAn has a lot of legacy code that issues check warnings, +# such that it's not yet practical to break the build on every warning. +# Cleaning this up is a long-term goal, but will take time. +# Meanwhile, we compare against a cached historic check output to enforce that +# no *new* warnings are added. As historic warnings are removed, we will update +# the cached results to ensure they stay gone. +# +# To compare checks, we take a two-level approach: +# First by comparing results with rcmdcheck::compare_checks to find any new +# top-level warnings (e.g. "checking Rd cross-references ... WARNING"), +# then if those are OK we get fussier and check for new *instances* of existing +# warnings (e.g. new check increases from 2 bad Rd cross-references to 3). + +### +# To update reference files after fixing an old warning: +# * Run check_with_errors.R to be sure the check is currently passing +# * Delete the file you want to update +# * Uncomment this section +# * run `DIELEVEL=never Rscript scripts/check_with_errors.R path/to/package` +# * recomment this section +# * Commit updated file +# if (!file.exists(old_file)) { +# cat("No reference check file found. Saving current results as the new standard\n") +# cat(chk$stdout, file = old_file) +# quit("no") +# } +### + +# everything beyond this point is comparing to old version +if (!file.exists(old_file)) { + quit("no") +} + +old <- rcmdcheck::parse_check(old_file) +cmp <- rcmdcheck::compare_checks(old, chk) + +msg_lines <- function(msg) { + # leading double-space indicates wrapped line -> rejoin + msg <- gsub("\n ", " ", msg, fixed = TRUE) + + #split lines, delete empty ones + msg <- strsplit(msg, split = "\n", fixed = TRUE) + msg <- lapply(msg, function(x)x[x != ""]) + + # prepend message title (e.g. "checking Rd files ... NOTE") to each line + unlist(lapply( + msg, + function(x) { + if (length(x) > 1) { + paste(x[[1]], x[-1], sep = ": ") + } else { + x + } + })) +} + +if (cmp$status != "+") { + # rcmdcheck found new messages, so check has failed + print(cmp) + cat("R check of", pkg, "reports the following new problems.", + "Please fix these and resubmit:\n") + cat(cmp$cmp$output[cmp$cmp$change == 1], sep = "\n") + stop("Please fix these and resubmit.") +} else { + # No new messages, but need to check details of pre-existing ones + # We stopped earlier for errors, so all entries here are WARNING or NOTE + cur_msgs <- msg_lines(cmp$cmp$output[cmp$cmp$which == "new"]) + prev_msgs <- msg_lines(cmp$cmp$output[cmp$cmp$which == "old"]) + + # avoids false positives from tempdir changes + cur_msgs <- gsub(chk$checkdir, "...", cur_msgs) + prev_msgs <- gsub(old$checkdir, "...", prev_msgs) + + # R 3.6.0 switched style for lists of packages + # from space-separated fancy quotes to comma-separated straight quotes + # We'll meet halfway, with space-separated straight quotes + cur_msgs <- gsub("[‘’]", "'", cur_msgs) + cur_msgs <- gsub("', '", "' '", cur_msgs) + prev_msgs <- gsub("[‘’]", "'", prev_msgs) + prev_msgs <- gsub("', '", "' '", prev_msgs) + + # Compression warnings report slightly different sizes on different R + # versions. If the only difference is in the numbers, don't complain + cmprs_msg <- grepl("significantly better compression", cur_msgs) + if (any(cmprs_msg)) { + prev_cmprs_msg <- grepl("significantly better compression", prev_msgs) + cur_cmprs_nodigit <- gsub("[0-9]", "", cur_msgs[cmprs_msg]) + prev_cmprs_nodigit <- gsub("[0-9]", "", prev_msgs[prev_cmprs_msg]) + if (all(cur_cmprs_nodigit %in% prev_cmprs_nodigit)) { + cur_msgs <- cur_msgs[!cmprs_msg] + } + } + + # These lines are redundant summaries of issues also reported individually + # and create false positives when an existing issue is fixed + cur_msgs <- cur_msgs[!grepl( + "NOTE: Undefined global functions or variables:", cur_msgs)] + cur_msgs <- cur_msgs[!grepl("NOTE: Consider adding importFrom", cur_msgs)] + + lines_changed <- setdiff(cur_msgs, prev_msgs) + + # Crude hack: + # Some messages are locale-dependent in complex ways, + # e.g. the note about undocumented datasets concatenates CSV names + # (ordered in the current locale) and objects in RData files (always + # ordered in C locale), and so on. + # As a last effort, we look for pre-existing lines that contain the same + # words in a different order + if (length(lines_changed) > 0) { + prev_words <- strsplit(prev_msgs, " ") + changed_words <- strsplit(lines_changed, " ") + is_reordered <- function(v1, v2) { + length(v1[v1 != ""]) == length(v2[v2 != ""]) && setequal(v1, v2) + } + is_in_prev <- function(line) { + any(vapply( + X = prev_words, + FUN = is_reordered, + FUN.VALUE = logical(1), + line)) + } + in_prev <- vapply( + X = changed_words, + FUN = is_in_prev, + FUN.VALUE = logical(1)) + lines_changed <- lines_changed[!in_prev] + } + if (length(lines_changed) > 0) { + cat("R check of", pkg, "returned new problems:\n") + cat(lines_changed, sep = "\n") + stop("Please fix these and resubmit.") + } } diff --git a/scripts/compile.sh b/scripts/compile.sh new file mode 100755 index 00000000000..462c2ac55aa --- /dev/null +++ b/scripts/compile.sh @@ -0,0 +1,3 @@ +#!/bin/bash + +docker-compose exec executor sh -c 'cd /pecan && make' diff --git a/scripts/dataprep_10_sites.csv b/scripts/dataprep_10_sites.csv new file mode 100644 index 00000000000..b19e6192557 --- /dev/null +++ b/scripts/dataprep_10_sites.csv @@ -0,0 +1,11 @@ +"","siteid_BETY4","site_name4","base_dir4","met_download","model_id4","model_name4","input_met_source4","input_met_output4","siteid_NEON4" +"1",646,"HARV","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","dataprep",1000000030,"SIPNET","NOAA_GEFS","SIPNET","HARV" +"2",679,"LOS","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","metprocess",1000000030,"SIPNET","NOAA_GEFS","SIPNET",NA +"3",1000026756,"POTATO","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","metprocess",1000000030,"SIPNET","NOAA_GEFS","SIPNET",NA +"4",622,"SYV","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","metprocess",1000000030,"SIPNET","NOAA_GEFS","SIPNET",NA +"5",676,"WCR","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","metprocess",1000000030,"SIPNET","NOAA_GEFS","SIPNET",NA +"6",678,"WLEF","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","metprocess",1000000030,"SIPNET","NOAA_GEFS","SIPNET",NA +"7",1000004924,"BART","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","dataprep",1000000030,"SIPNET","NOAA_GEFS","SIPNET","BART" +"8",1000004927,"KONZ","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","dataprep",1000000030,"SIPNET","NOAA_GEFS","SIPNET","KONZ" +"9",1000004916,"OSBS","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","dataprep",1000000030,"SIPNET","NOAA_GEFS","SIPNET","OSBS" +"10",1000004876,"SRER","/projectnb/dietzelab/ahelgeso/NOAA_met_data/","dataprep",1000000030,"SIPNET","NOAA_GEFS","SIPNET","SRER" diff --git a/scripts/dump.pgsql.sh b/scripts/dump.pgsql.sh deleted file mode 100644 index f41c1e59de9..00000000000 --- a/scripts/dump.pgsql.sh +++ /dev/null @@ -1,36 +0,0 @@ -#!/bin/bash - -if [ ! -e /var/www/html/pecan/dump/dump.pgsql ]; then - exit 0 -fi -rm /var/www/html/pecan/dump/dump.pgsql - -PATH=/usr/local/ruby-1.9.3/bin:$PATH - -BETYDUMP_DB="betydump" -QUIET="-q" - -pg_dump ebi_production > ${HOME}/dump/betydump.psql - -psql ${QUIET} -d "${BETYDUMP_DB}" -c "DROP SCHEMA public CASCADE" 2> /dev/null -psql ${QUIET} -d "${BETYDUMP_DB}" -c "CREATE SCHEMA public" - -psql ${QUIET} ${BETYDUMP_DB} < ${HOME}/dump/betydump.psql > /dev/null - -# anonymize all accounts -psql ${QUIET} ${BETYDUMP_DB} -c "update users set login=CONCAT('user', id), name=CONCAT('user ', id), email=CONCAT('betydb+', id, '@gmail.com'), city='Urbana, IL', country='USA', area=NULL, created_at=NOW(), updated_at=NOW(), crypted_password='563d44743a37d62a3cbf124fd27f32ab', salt='nosecret', remember_token=NULL, remember_token_expires_at=NULL, access_level=3, page_access_level=4, apikey=NULL, state_prov=NULL, postal_code=NULL;" - -# remove all non checked data -psql ${QUIET} ${BETYDUMP_DB} -c "delete from traits where checked = -1;" -psql ${QUIET} ${BETYDUMP_DB} -c "delete from yields where checked = -1;" - -# remove all secret data -psql ${QUIET} ${BETYDUMP_DB} -c "delete from traits where access_level < 3;" -psql ${QUIET} ${BETYDUMP_DB} -c "delete from yields where access_level < 3;" - -# update bety -#cd ${HOME}/bety -#git pull ${QUIET} -#rake db:migrate RAILS_ENV="dump" - -pg_dump ${BETYDUMP_DB} | gzip > /var/www/html/pecan/dump/betydump.psql.gz diff --git a/scripts/efi_data_process.R b/scripts/efi_data_process.R new file mode 100644 index 00000000000..aed1549acf9 --- /dev/null +++ b/scripts/efi_data_process.R @@ -0,0 +1,218 @@ +#### need to create a graph function here to call with the args of start time + +#' EFI Data Process +#' +#' @param args completed forecast run settings file +#' +#' @return +#' +#' +#' @examples +efi.data.process <- function(args){ + start_date <- tryCatch(as.POSIXct(args[1]), error = function(e) {NULL} ) + if (is.null(start_date)) { + in_wid <- as.integer(args[1]) + } + dbparms = list() + dbparms$dbname = "bety" + dbparms$host = "128.197.168.114" + dbparms$user = "bety" + dbparms$password = "bety" + #Connection code copied and pasted from met.process + bety <- dplyr::src_postgres(dbname = dbparms$dbname, + host = dbparms$host, + user = dbparms$user, + password = dbparms$password) + con <- bety$con #Connection to the database. dplyr returns a list. + on.exit(PEcAn.DB::db.close(con), add = TRUE) + # Identify the workflow with the proper information + if (!is.null(start_date)) { + workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE start_date='", format(start_date, "%Y-%m-%d %H:%M:%S"), + "' ORDER BY id"), con) + } else { + workflows <- PEcAn.DB::db.query(paste0("SELECT * FROM workflows WHERE id='", in_wid, "'"), con) + } + print(workflows) + + workflows <- workflows[which(workflows$site_id == args[2]),] + + SDA_check = grep("StateData", workflows$folder) + if(length(SDA_check) > 0){ workflows = workflows[-SDA_check,]} + + index = grepl(basename(args[3]), workflows$folder) + + if(length(index) == 0){ workflow <- workflows[which(workflows$folder == "" ),]} + + if(length(index) > 0){workflow = workflows[index, ]} + + + if (nrow(workflow) > 1) { + workflow <- workflow[1,] + } + + if(nrow(workflow) == 0){ + PEcAn.logger::logger.error(paste0("There are no workflows for ", start_date)) + stop() + } + + print(paste0("Using workflow ", workflow$id)) + wid <- workflow$id + outdir <- args[3] + pecan_out_dir <- paste0(outdir, "PEcAn_", wid, "/out"); + pecan_out_dirs <- list.dirs(path = pecan_out_dir) + if (is.na(pecan_out_dirs[1])) { + print(paste0(pecan_out_dirs, " does not exist.")) + } + + + #neemat <- matrix(1:64, nrow=1, ncol=64) # Proxy row, will be deleted later. + #qlemat <- matrix(1:64, nrow=1, ncol=64)# Proxy row, will be deleted later. + + neemat <- vector() + qlemat <- vector() + soilmoist <- vector() + gppmat <- vector() + time <- vector() + + num_results <- 0; + for (i in 2:length(pecan_out_dirs)) { + #datafile <- file.path(pecan_out_dirs[i], format(workflow$start_date, "%Y.nc")) + datafiles <- list.files(pecan_out_dirs[i]) + datafiles <- datafiles[grep("*.nc$", datafiles)] + + if (length(datafiles) == 0) { + print(paste0("File ", pecan_out_dirs[i], " does not exist.")) + next + } + + if(length(datafiles) == 1){ + + file = paste0(pecan_out_dirs[i],'/', datafiles[1]) + + num_results <- num_results + 1 + + #open netcdf file + ncptr <- ncdf4::nc_open(file); + + # Attach data to matricies + nee <- ncdf4::ncvar_get(ncptr, "NEE") + if(i == 2){ neemat <- nee} else{neemat <- cbind(neemat,nee)} + + qle <- ncdf4::ncvar_get(ncptr, "Qle") + if(i == 2){ qlemat <- qle} else{qlemat <- cbind(qlemat,qle)} + + soil <- ncdf4::ncvar_get(ncptr, "SoilMoistFrac") + if(i == 2){ soilmoist <- soil} else{soilmoist <- cbind(soilmoist,soil)} + + gpp <- ncdf4::ncvar_get(ncptr, "GPP") + if(i == 2){ gppmat <- gpp} else{gppmat <- cbind(gppmat,nee)} + + + sec <- ncptr$dim$time$vals + origin <- strsplit(ncptr$dim$time$units, " ")[[1]][3] + + # Close netcdf file + ncdf4::nc_close(ncptr) + } + + if(length(datafiles) > 1){ + + + file = paste0(pecan_out_dirs[i],'/', datafiles[1]) + file2 = paste0(pecan_out_dirs[i],'/', datafiles[2]) + + num_results <- num_results + 1 + + #open netcdf file + ncptr1 <- ncdf4::nc_open(file); + ncptr2 <- ncdf4::nc_open(file2); + # Attach data to matricies + nee1 <- ncdf4::ncvar_get(ncptr1, "NEE") + nee2 <- ncdf4::ncvar_get(ncptr2, "NEE") + nee <- c(nee1, nee2) + if(i == 2){ neemat <- nee} else{neemat <- cbind(neemat,nee)} + + qle1 <- ncdf4::ncvar_get(ncptr1, "Qle") + qle2 <- ncdf4::ncvar_get(ncptr2, "Qle") + qle <- c(qle1, qle2) + + if(i == 2){ qlemat <- qle} else{qlemat <- cbind(qlemat,qle)} + + soil1 <- ncdf4::ncvar_get(ncptr1, "SoilMoistFrac") + soil2 <- ncdf4::ncvar_get(ncptr2, "SoilMoistFrac") + soil <- c(soil1, soil2) + if(i == 2){ soilmoist <- soil} else{soilmoist <- cbind(soilmoist,soil)} + + + sec <- c(ncptr1$dim$time$vals, ncptr2$dim$time$vals+ last(ncptr1$dim$time$vals)) + origin <- strsplit(ncptr1$dim$time$units, " ")[[1]][3] + + + # Close netcdf file + ncdf4::nc_close(ncptr1) + ncdf4::nc_close(ncptr2) + + } + + } + + if (num_results == 0) { + print("No results found.") + quit("no") + } else { + print(paste0(num_results, " results found.")) + } + + # Time + time <- seq(1, length.out= length(sec)) + + + # Change to long format with ensemble numbers + + #lets get rid of col names for easier pivoting + colnames(neemat) <- paste0(rep("ens_", 100), seq(1, 100)) + needf = neemat %>% + as_tibble() %>% + mutate(date= as.Date(sec, origin = origin), + Time = round(abs(sec - floor(sec)) * 24)) %>% + pivot_longer(!c(date, Time), + names_to = "ensemble", + names_prefix = "ens_", + values_to = "nee") %>% + mutate(nee = PEcAn.utils::misc.convert(nee, "kg C m-2 s-1", "umol C m-2 s-1")) + + colnames(qlemat) <- paste0(rep("ens_", 100), seq(1, 100)) + qledf = qlemat %>% + as_tibble() %>% + mutate(date= as.Date(sec, origin = origin), + Time = round(abs(sec - floor(sec)) * 24)) %>% + pivot_longer(!c(date, Time), + names_to = "ens", + names_prefix = "ens_", + values_to = "le") + + colnames(soilmoist) <- paste0(rep("ens_", 100), seq(1, 100)) + soildf = soilmoist %>% + as_tibble() %>% + mutate(date= as.Date(sec, origin = origin), + Time = round(abs(sec - floor(sec)) * 24)) %>% + pivot_longer(!c(date, Time), + names_to = "ens", + names_prefix = "ens_", + values_to = "vswc") + + + data = needf %>% + mutate(le = qledf$le, + vswc = soildf$vswc) + + + + + +return(data) + +} + + + diff --git a/scripts/generate_dependencies.R b/scripts/generate_dependencies.R index e63f88821f6..fa4da91f24b 100755 --- a/scripts/generate_dependencies.R +++ b/scripts/generate_dependencies.R @@ -1,7 +1,14 @@ -#!/usr/bin/env RScript +#!/usr/bin/env Rscript + +# force sorting +if (capabilities("ICU")) { + icuSetCollate(locale = "en_US.UTF-8") +} else { + print("Can not force sorting, this could result in unpredicted results.") +} # following modules will be ignored -ignore <- c('models/template', 'modules/data.mining') +ignore <- c("modules/data.mining") files <- c( @@ -30,68 +37,70 @@ pecan <- c() depends <- c() docker <- c() remotes <- c() -d <- purrr::walk(files, - function(x) { - f <- dirname(x) - if (f %in% ignore) return() +d <- purrr::walk( + files, + function(x) { + f <- dirname(x) + if (f %in% ignore) return() - # load DESCRIPTION file - d <- desc::desc(file=x) - deps <- d$get_deps()[['package']] + # load DESCRIPTION file + d <- desc::desc(file = x) + deps <- d$get_deps()[["package"]] - # PEcAn dependencies - y <- deps[grepl('^PEcAn.', deps)] - p <- d$get_field('Package') - pecan[[p]] <<- f - depends[[f]] <<- y + # PEcAn dependencies + y <- deps[grepl("^PEcAn.", deps)] + p <- d$get_field("Package") + pecan[[p]] <<- f + depends[[f]] <<- y - # Dockerfile dependencies - z <- y['package'] - z <- deps[!grepl('^PEcAn.', deps)] - docker <<- unique(c(docker, z)) + # Dockerfile dependencies + z <- y["package"] + z <- deps[!grepl("^PEcAn.", deps)] + docker <<- unique(c(docker, z)) - # Dockerfile remote dependencies - if (!purrr::is_empty(d$get_remotes())) { - deps <- d$get_remotes() - github <- gsub('github::', '', deps[grepl('^github::', deps)]) - remotes <<- unique(c(remotes, github)) + # Dockerfile remote dependencies + if (!purrr::is_empty(d$get_remotes())) { + deps <- d$get_remotes() + github <- gsub("github::", "", deps[grepl("^github::", deps)]) + remotes <<- unique(c(remotes, github)) - bad <- deps[!grepl('^github::', deps)] - if (!purrr::is_empty(bad)) { - print(bad) - } - } - } ) + bad <- deps[!grepl("^github::", deps)] + if (!purrr::is_empty(bad)) { + print(bad) + } + } + } +) # write for makefile -cat('# autogenerated', file = 'Makefile.depends', sep = '\n', append = FALSE) +cat("# autogenerated", file = "Makefile.depends", sep = "\n", append = FALSE) for (name in names(depends)) { - x <- paste0('$(call depends,', name, '): |') + x <- paste0("$(call depends,", name, "): |") for (p in depends[[name]]) { # TEMP HACK: Don't declare known circular deps in utils Suggests if (name == "base/utils" && p == "PEcAn.DB") next - if (name == "base/utils" && p == "PEcAn.settings") next - if (name == "base/utils" && p == "PEcAn.data.atmosphere") next - if (name == "base/utils" && p == "PEcAn.data.land") next - x <- paste0(x, ' .install/', pecan[[p]]) + x <- paste0(x, " .install/", pecan[[p]]) } - cat(x, file = 'Makefile.depends', sep = '\n', append = TRUE) + cat(x, file = "Makefile.depends", sep = "\n", append = TRUE) } -# write for dockerfile -cat('#!/bin/bash', - '# autogenerated do not edit', - '# use scripts/generate.dockerfile.depends', - '', - '# stop on error', - 'set -e', - '', - '# Don\'t use X11 for rgl', - 'RGL_USE_NULL=TRUE', - '', - '# install remotes first in case packages are references in dependencies', - paste0('installGithub.r \\\n ', paste(sort(remotes), sep="", collapse=" \\\n ")), - '', - '# install all packages (depends, imports, suggests)', - paste0('install2.r -e -s -n -1\\\n ', paste(sort(docker), sep="", collapse=" \\\n ")), - file = 'docker/depends/pecan.depends', sep = '\n', append = FALSE) +# write for docker dependency image +cat("#!/usr/bin/env Rscript", + "# autogenerated do not edit", + "# use scripts/generate_dependencies.R", + "", + "# Don\'t use X11 for rgl", + "Sys.setenv(RGL_USE_NULL = TRUE)", + "rlib <- Sys.getenv('R_LIBS_USER', '/usr/local/lib/R/site-library')", + "Sys.setenv(RLIB = rlib)", + "", + "# install remotes first in case packages are references in dependencies", + "lapply(c(", + paste(shQuote(sort(remotes)), collapse = ",\n"), + "), remotes::install_github, lib = rlib)", + "", + "# install all packages (depends, imports, suggests)", + "wanted <- c(", paste(shQuote(sort(docker)), sep = "", collapse = ",\n"), ")", + "missing <- wanted[!(wanted %in% installed.packages()[,'Package'])]", + "install.packages(missing, lib = rlib)", + file = "docker/depends/pecan.depends.R", sep = "\n", append = FALSE) diff --git a/scripts/install.dependencies.R b/scripts/install.dependencies.R deleted file mode 100755 index e65fa72fd6c..00000000000 --- a/scripts/install.dependencies.R +++ /dev/null @@ -1,51 +0,0 @@ -#!/usr/bin/env Rscript -#------------------------------------------------------------------------------- -# Copyright (c) 2012 University of Illinois, NCSA. -# All rights reserved. This program and the accompanying materials -# are made available under the terms of the -# University of Illinois/NCSA Open Source License -# which accompanies this distribution, and is available at -# http://opensource.ncsa.illinois.edu/license.html -#------------------------------------------------------------------------------- - -# install graph for MCMCpack for allometry module -if (!("graph" %in% installed.packages()[, "Package"])) { - source("http://bioconductor.org/biocLite.R") - biocLite("graph") -} - -# install Rgraphviz for MCMCpack for allometry module -if (!("Rgraphviz" %in% installed.packages()[, "Package"])) { - source("http://bioconductor.org/biocLite.R") - biocLite("Rgraphviz") -} - -# install packages needed from CRAN -list.of.packages <- c("BayesianTools","data.table", "doSNOW", "dplR", "earth", - "emulator", "ggmap", "ggplot2", "gridExtra", "Hmisc", "httr", "kernlab", - "GPfit", "knitr", "Maeswrap", "MASS", "MCMCpack", "mvtnorm", - "plotrix", "raster", "randtoolbox", "rjags", "rgdal", "tgp", "DBI", - "roxygen2", "boot", "RNCEP", "foreign", - "RCurl", "RPostgreSQL", "rPython", "minpack.lm", "mclust", - "geonames", "Rcpp", "devtools", "inline", "segmented", "msm", "dplyr", - "shiny", "scales", "maps", "sp") -new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[, "Package"])] -if (length(new.packages)) { - print("installing : ") - print(new.packages) - install.packages(new.packages, repos = "http://cran.rstudio.com/") - - warning("If Maeswrap Package download fails, please refer to PEcAn documentation for download instructions") -} - -# install packages from github -if (!("BioCro" %in% installed.packages()[, "Package"])) { - devtools::install_github("ebimodeling/biocro") -} - - -# install rhdf5 from bioconductor for met2model.ED -if (!("rhdf5" %in% installed.packages()[, "Package"])) { - source("http://bioconductor.org/biocLite.R") - biocLite("rhdf5") -} diff --git a/scripts/install_deps.R b/scripts/install_deps.R deleted file mode 100644 index 00090bd738c..00000000000 --- a/scripts/install_deps.R +++ /dev/null @@ -1,79 +0,0 @@ -#!/usr/bin/env Rscript - -SUGGESTS <- TRUE -INSTALL <- FALSE - -files <- - c( - list.files( - path = "base", - full.names = TRUE, - pattern = "^DESCRIPTION$", - recursive = TRUE - ), - list.files( - path = "modules", - full.names = TRUE, - pattern = "^DESCRIPTION$", - recursive = TRUE - ), - list.files( - path = "models", - full.names = TRUE, - pattern = "^DESCRIPTION$", - recursive = TRUE - ) - ) - -## Required dependencies -d <- purrr::map(files, - function(x) { - y <- desc::desc_get_deps(x) - y[y$type %in% c('Depends', 'Imports', 'Remotes'), 'package'] - }) -d <- sort(unique(unlist(d))) -d <- d[!grepl('^PEcAn.', d)] - -if (INSTALL) { - purrr::walk(d, - function(p) { - print("# ----------------------------------------------------------------------") - print(paste0("# INSTALLING ", p)) - print("# ----------------------------------------------------------------------") - install.packages(p, repos = 'http://cran.rstudio.com/') - if (system.file(package = p) == "") { - stop("Don't know how to install dependency ", p) - } - }) -} else { - print(paste(d, collapse = ' ')) -} - -## Suggested dependencies -if (SUGGESTS) { - s <- purrr::map(files, - function(x) { - y <- desc::desc_get_deps(x) - y[y$type %in% c('Suggests'), 'package'] - }) - s <- sort(unique(unlist(s))) - s <- s[!grepl('^PEcAn.', s)] - s <- s[!s %in% c('BioCro', 'linkages', 'Maeswrap', 'Rpreles')] - s <- s[!s %in% d] - - if (INSTALL) { - purrr::walk(s, - function(p) { - print("# ----------------------------------------------------------------------") - print(paste0("# INSTALLING ", p)) - print("# ----------------------------------------------------------------------") - install.packages(p, repos = 'http://cran.rstudio.com/') - if (system.file(package = p) == "") { - stop("Don't know how to install dependency ", p) - } - }) - } else { - print(paste(d, collapse = ' ')) - } -} - diff --git a/scripts/install_pecan.sh b/scripts/install_pecan.sh index 12d5e6a1610..db0845b41bc 100644 --- a/scripts/install_pecan.sh +++ b/scripts/install_pecan.sh @@ -357,21 +357,21 @@ if [ -z "${R_LIBS_USER}" ]; then ;; esac fi -echo 'if(!"devtools" %in% installed.packages()) install.packages("devtools", repos="http://cran.rstudio.com/")' | R --vanilla -echo 'if(!"udunits2" %in% installed.packages()) install.packages("udunits2", configure.args=c(udunits2="--with-udunits2-include=/usr/include/udunits2"), repo="http://cran.rstudio.com")' | R --vanilla +echo 'if(!"devtools" %in% installed.packages()) install.packages("devtools")' | R --vanilla +echo 'if(!"udunits2" %in% installed.packages()) install.packages("udunits2", configure.args=c(udunits2="--with-udunits2-include=/usr/include/udunits2"))' | R --vanilla # packages for BrownDog shiny app -echo 'if(!"leaflet" %in% installed.packages()) install.packages("leaflet", repos="http://cran.rstudio.com/")' | R --vanilla -echo 'if(!"RJSONIO" %in% installed.packages()) install.packages("RJSONIO", repos="http://cran.rstudio.com/")' | R --vanilla +echo 'if(!"leaflet" %in% installed.packages()) install.packages("leaflet")' | R --vanilla +echo 'if(!"RJSONIO" %in% installed.packages()) install.packages("RJSONIO")' | R --vanilla # packages for other shiny apps -echo 'if(!"DT" %in% installed.packages()) install.packages("DT", repos="http://cran.rstudio.com/")' | R --vanilla +echo 'if(!"DT" %in% installed.packages()) install.packages("DT")' | R --vanilla -#echo 'update.packages(repos="http://cran.rstudio.com/", ask=FALSE)' | sudo R --vanilla -echo 'x <- rownames(old.packages(repos="http://cran.rstudio.com/")); update.packages(repos="http://cran.rstudio.com/", ask=FALSE, oldPkgs=x[!x %in% "rgl"])' | sudo R --vanilla +#echo 'update.packages(ask=FALSE)' | sudo R --vanilla +echo 'x <- rownames(old.packages()); update.packages(ask=FALSE, oldPkgs=x[!x %in% "rgl"])' | sudo R --vanilla -#echo 'update.packages(repos="http://cran.rstudio.com/", ask=FALSE)' | R --vanilla -echo 'x <- rownames(old.packages(repos="http://cran.rstudio.com/")); update.packages(repos="http://cran.rstudio.com/", ask=FALSE, oldPkgs=x[!x %in% "rgl"])' | R --vanilla +#echo 'update.packages(ask=FALSE)' | R --vanilla +echo 'x <- rownames(old.packages()); update.packages(ask=FALSE, oldPkgs=x[!x %in% "rgl"])' | R --vanilla echo "######################################################################" echo "ED" @@ -422,7 +422,7 @@ echo "######################################################################" if [ ! -e ${HOME}/maespa ]; then cd git clone https://bitbucket.org/remkoduursma/maespa.git - echo 'install.packages("Maeswrap", repo="http://cran.rstudio.com")' | R --vanilla + echo 'install.packages("Maeswrap")' | R --vanilla fi cd ${HOME}/maespa make clean @@ -479,7 +479,7 @@ echo "######################################################################" echo "PECAN" echo "######################################################################" -echo 'if(!"rgl" %in% installed.packages()) install.packages("rgl", repos="http://cran.rstudio.com/")' | R --vanilla +echo 'if(!"rgl" %in% installed.packages()) install.packages("rgl")' | R --vanilla if [ ! -e ${HOME}/pecan ]; then cd @@ -496,7 +496,6 @@ if [ ! -e ${HOME}/pecan/web/config.php ]; then sed -e "s#browndog_url=.*#browndog_url=\"${BROWNDOG_URL}\";#" \ -e "s#browndog_username=.*#browndog_username=\"${BROWNDOG_USERNAME}\";#" \ -e "s#browndog_password=.*#browndog_password=\"${BROWNDOG_PASSWORD}\";#" \ - -e "s#googleMapKey=.*#googleMapKey=\"${GOOGLE_MAP_KEY}\";#" \ -e "s/carya/$USER/g" ${HOME}/pecan/web/config.example.php > ${HOME}/pecan/web/config.php fi @@ -623,12 +622,12 @@ echo "######################################################################" echo "SHINY SERVER" echo "######################################################################" if [ "${SHINY_SERVER}" != "" -a $( uname -m ) == "x86_64" ]; then - sudo su - -c "R -e \"install.packages(c('rmarkdown', 'shiny'), repos='https://cran.rstudio.com/')\"" + sudo su - -c "R -e \"install.packages(c('rmarkdown', 'shiny'))\"" R -e "install.packages(c('https://www.bioconductor.org/packages/release/bioc/src/contrib/BiocGenerics_0.28.0.tar.gz', 'http://www.bioconductor.org/packages/release/bioc/src/contrib/graph_1.60.0.tar.gz'), repos=NULL)" R -e "devtools::install_github('duncantl/CodeDepends')" #R -e "devtools::install_github('OakleyJ/SHELF')" - R -e "install.packages(c('shinythemes', 'shinytoastr', 'plotly'), repos='https://cran.rstudio.com/')" + R -e "install.packages(c('shinythemes', 'shinytoastr', 'plotly'))" cd @@ -732,8 +731,8 @@ echo "######################################################################" echo "PalEON" echo "######################################################################" if [ "$SETUP_PALEON" != "" ]; then - echo 'if(!"neotoma" %in% installed.packages()) install.packages("neotoma", repos="http://cran.rstudio.com/")' | R --vanilla - echo 'if(!"R2jags" %in% installed.packages()) install.packages("R2jags", repos="http://cran.rstudio.com/")' | R --vanilla + echo 'if(!"neotoma" %in% installed.packages()) install.packages("neotoma")' | R --vanilla + echo 'if(!"R2jags" %in% installed.packages()) install.packages("R2jags")' | R --vanilla if [ ! -e ${HOME}/Camp2016 ]; then cd diff --git a/scripts/reindex.bety.sh b/scripts/reindex.bety.sh deleted file mode 100755 index 03c9f696d1b..00000000000 --- a/scripts/reindex.bety.sh +++ /dev/null @@ -1,150 +0,0 @@ -#!/bin/bash - -# exit on error -set -e - -# ---------------------------------------------------------------------- -# START CONFIGURATION SECTION -# ---------------------------------------------------------------------- - -# name of the dabase to reindexing -# this script assumes the user running it has access to the database -DATABASE=${DATABASE:-"bety"} - -# The database catalog to search for mactching table names -DBCATALOG=${DBCATALOG:-"bety"} - -# psql options -# this allows you to add the user to use as well as any other options -PG_OPT=${PG_OPT-"-U bety"} - -# Should the process be quiet -QUIET=${QUIET:-"NO"} - -# Should all the tables be indexed -TABLENAME=${TABLENAME:-"ALL"} - -# Non-database-system tables that should always be ignored on a reindex -IGNORETABLES=${IGNORETABLES:-""} - -# Skip reindexing the entire database after reindexing the tables -SKIPDATABASE=${SKIPDATABASE:-"YES"} - -# ---------------------------------------------------------------------- -# END CONFIGURATION SECTION -# ---------------------------------------------------------------------- - -# parse command line options -while getopts c:d:hi:p:qst: opt; do - case $opt in - c) - DBCATALOG=$OPTARG - ;; - d) - DATABASE=$OPTARG - ;; - h) - echo "$0 [-c datalog] [-d database] [-h] [-i table names] [-p psql options] [-q] [-s] [-t tablename]" - echo " -c catalog, database catalog name used to search for tables, default is bety" - echo " -d database, default is bety" - echo " -h this help page" - echo " -i table names, list of space-separated table names to skip over when reindexing" - echo " -p additional psql command line options, default is -U bety" - echo " -q the reindexing should be quiet" - echo " -s reindex the database after reindexing the tables (this should be done sparingly)" - echo " -t tablename, the name of the one table to reindex" - exit 0 - ;; - i) - # We add spaces to assist in exact table name maching - IGNORETABLES=" ${OPTARG} " - ;; - p) - PG_OPT=$OPTARG - ;; - q) - QUIET="YES" - ;; - s) - SKIPDATABASE="NO" - ;; - t) - TABLENAME=$OPTARG - SKIPDATABASE="YES" - ;; - esac -done - -# be quiet if not interactive -if ! tty -s ; then - exec 1>/dev/null -fi - -# find current schema version -# following returns a triple: -# - number of migrations -# - largest migration -# - hash of all migrations -MIGRATIONS=$( psql ${PG_OPT} -t -q -d "${DATABASE}" -c 'SELECT COUNT(version) FROM schema_migrations' | tr -d ' ' ) -VERSION=$( psql ${PG_OPT} -t -q -d "${DATABASE}" -c 'SELECT md5(array_agg(version)::text) FROM (SELECT version FROM schema_migrations ORDER BY version) as v;' | tr -d ' ' ) -LATEST=$( psql ${PG_OPT} -t -q -d "${DATABASE}" -c 'SELECT version FROM schema_migrations ORDER BY version DESC LIMIT 1' | tr -d ' ' ) -NOW=$( date -u +"%Y-%m-%dT%H:%M:%SZ" ) -if [ "${QUIET}" != "YES" ]; then - echo "Version: ${MIGRATIONS} ${VERSION} ${LATEST}" - echo "Starting reindexing: ${NOW}" -fi - -# Inform the caller of what we're doing -if [ "${QUIET}" != "YES" ]; then - RUNINFO="" - if [ "${TABLENAME}" == "ALL" ]; then - RUNINFO="Reindexing all tables in catalog ${DBCATALOG}" - else - RUNINFO="Reindexing ${TABLENAME}" - fi - if [ "${SKIPDATABASE}" == "YES" ]; then - RUNINFO="${RUNINFO}, skipping entire database" - else - RUNINFO="${RUNINFO}, reindexing entire database" - fi - echo "${RUNINFO}" -fi - -# If we are reindexing all the tables, get the list of tables from the database -if [ "${TABLENAME}" == "ALL" ]; then - TABLENAME=$(psql ${PG_OPT} -t -q -d "${DATABASE}" -c "with curuser as (select user) select t.table_name from information_schema.tables t join pg_catalog.pg_class c on (t.table_name = c.relname) join pg_catalog.pg_user u on (c.relowner = u.usesysid) join curuser cu on (u.usename = cu.current_user) where t.table_catalog='${DBCATALOG}' and t.table_schema='public' and t.table_type like '%TABLE%' order by t.table_name asc" | tr -d ' ') - if [ "${QUIET}" != "YES" ]; then - printf "Reindexing all tables\n" - fi -else - if [ "${QUIET}" != "YES" ]; then - printf "Reindexing %-40s\n" "${TABLENAME}" - fi -fi - -# Reindex the tables -for T in ${TABLENAME}; do - if echo "${IGNORETABLES}" | grep -qi " ${T} "; then - if [ "${QUIET}" != "YES" ]; then - printf "Ignoring %-40s\n" "${T}" - fi - else - if [ "${QUIET}" != "YES" ]; then - printf "Reindex %-40s\n" "${T}" - fi - psql ${PG_OPT} -t -q -d "${DATABASE}" -c "REINDEX TABLE ${T}" - fi -done - -# Reindexing the overall database, should be fast(er) with all the tables already reindexed -if [ "${SKIPDATABASE}" == "NO" ]; then - if [ "${QUIET}" != "YES" ]; then - printf "Reindex entire database\n" - fi - psql ${PG_OPT} -t -q -d "${DATABASE}" -c "REINDEX DATABASE ${DATABASE}" -fi - -if [ "${QUIET}" != "YES" ]; then - NOW=$( date -u +"%Y-%m-%dT%H:%M:%SZ" ) - echo "Completed reindexing: ${NOW}" -fi diff --git a/scripts/setversion.sh b/scripts/setversion.sh deleted file mode 100755 index 5eed0d50f68..00000000000 --- a/scripts/setversion.sh +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/bash - -RELEASE="1.5.0" -RC=2 -VERSION="${RELEASE}-{RC}" - -cd /home/carya/pecan -git checkout release/${RELEASE} -git reset --hard -git pull - -$(dirname $0)/updateVersion.sh "${VERSION}" - -cat > /tmp/motd << EOF -PEcAn version ${VERSION} - -For more information about: -Pecan - http://pecanproject.org -BETY - http://www.betydb.org - -For a list of all models currently supported see: -https://pecan.gitbooks.io/pecan-documentation/content/models/ -EOF -sudo cp /tmp/motd /etc/motd -rm /tmp/motd - -make clean -make diff --git a/scripts/sshkey.sh b/scripts/sshkey.sh index 24518be6ba5..258a6d879cb 100755 --- a/scripts/sshkey.sh +++ b/scripts/sshkey.sh @@ -44,6 +44,6 @@ echo "paste the following lines to the commandline:" echo "" echo " (the first only if there is no .ssh directory on the server)" echo "" -echo "echo ssh ${USERNAME}@${SERVER} \"mkdir ~/.ssh\"" +echo "ssh ${USERNAME}@${SERVER} \"mkdir ~/.ssh\"" echo "" echo "cat ~/.ssh/${SERVER}.pub | ssh ${USERNAME}@${SERVER} \"cat >> ~/.ssh/authorized_keys\"" diff --git a/scripts/time.sh b/scripts/time.sh index 2f42cb7425b..c4c82f98284 100755 --- a/scripts/time.sh +++ b/scripts/time.sh @@ -2,15 +2,15 @@ set -e -FOLD_NAME=$( echo "make_$1" | sed -e 's#[^a-z0-9]#_#g' ) +TITLE="$(echo $1 | xargs)" shift -if [ "$TRAVIS" == "true" ]; then - . $( dirname $0 )/travis/func.sh - - travis_time_start "${FOLD_NAME}" "${FOLD_NAME}" +if [ -n "$GITHUB_WORKFLOW" ]; then + echo "::group::${TITLE}" "$@" - travis_time_end + echo "::endgroup::" else + echo "=========== START $TITLE ===========" time "$@" + echo "=========== END $TITLE ===========" fi diff --git a/scripts/travis/after_script.sh b/scripts/travis/after_script.sh deleted file mode 100755 index 4ace384a5d3..00000000000 --- a/scripts/travis/after_script.sh +++ /dev/null @@ -1,20 +0,0 @@ -#!/bin/bash - -set -e -. $( dirname $0 )/func.sh - -# BUILD DOCUMENTATION -( - travis_time_start "build_book" "Building Book" - cd book_source - make - travis_time_end -) - -# BUILD TUTORIALS -( - travis_time_start "build_tutorials" "Building Tutorials" - cd documentation/tutorials - make build deploy - travis_time_end -) diff --git a/scripts/travis/before_script.sh b/scripts/travis/before_script.sh deleted file mode 100755 index e60b193b273..00000000000 --- a/scripts/travis/before_script.sh +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/bash - -set -e -. $( dirname $0 )/func.sh - -# LOADING BETY DATABASE -( - travis_time_start "load_database" "Loading minimal BETY database" - - sudo service postgresql stop - docker run --detach --rm --name postgresql --publish 5432:5432 mdillon/postgis:9.6-alpine - echo -n "Waiting for Postgres to start..."; - until psql -U postgres -c 'select 1' >/dev/null 2>&1; - do echo -n "."; - sleep 1; - done; - echo " OK" - psql -q -o /dev/null -U postgres -c "CREATE ROLE BETY WITH LOGIN CREATEDB SUPERUSER CREATEROLE UNENCRYPTED PASSWORD 'bety'"; - psql -q -o /dev/null -U postgres -c "CREATE DATABASE bety OWNER bety;" - curl -o bety.sql http://isda.ncsa.illinois.edu/~kooper/PEcAn/data/bety.sql - psql -q -o /dev/null -U postgres < bety.sql - rm bety.sql - ./scripts/add.models.sh - chmod +x book_source/deploy.sh - chmod +x documentation/tutorials/deploy.sh - - travis_time_end -) diff --git a/scripts/travis/build_order.txt b/scripts/travis/build_order.txt deleted file mode 100644 index 6dc914e5b59..00000000000 --- a/scripts/travis/build_order.txt +++ /dev/null @@ -1,38 +0,0 @@ -base/logger -base/remote -modules/emulator -base/utils -base/db -base/settings -base/visualization -base/qaqc -modules/data.atmosphere -modules/data.land -modules/priors -modules/uncertainty -base/workflow -modules/allometry -modules/meta.analysis -modules/assim.batch -modules/assim.sequential -modules/benchmark -modules/data.hydrology -modules/data.remote -modules/photosynthesis -models/template -models/ed -modules/rtm -models/biocro -models/clm45 -models/dalec -models/dvmdostem -models/fates -models/gday -models/jules -models/linkages -models/lpjguess -models/maat -models/maespa -models/preles -models/sipnet -base/all diff --git a/scripts/travis/func.sh b/scripts/travis/func.sh deleted file mode 100755 index 57eb24c2dc8..00000000000 --- a/scripts/travis/func.sh +++ /dev/null @@ -1,43 +0,0 @@ -#!/bin/bash - -TRAVIS_STACK=() -if [ "$(uname -s)" == "Darwin" ]; then - DATE_OPTION="+%s" - DATE_DIV=1 -else - DATE_OPTION="+%s%N" - DATE_DIV=1000000000 -fi - -function travis_time_start { - old_setting=${-//[^x]/} - set +x - TRAVIS_START_TIME=$(date ${DATE_OPTION}) - TRAVIS_TIME_ID=$( uuidgen | sed 's/-//g' | cut -c 1-8 ) - TRAVIS_FOLD_NAME=$1 - TRAVIS_STACK=("${TRAVIS_FOLD_NAME}#${TRAVIS_TIME_ID}#${TRAVIS_START_TIME}" "${TRAVIS_STACK[@]}") - echo -e "\e[0Ktravis_fold:start:$TRAVIS_FOLD_NAME" - echo -e "\e[0Ktravis_time:start:$TRAVIS_TIME_ID" - if [ "$2" != "" ]; then - echo "$2" - fi - if [[ -n "$old_setting" ]]; then set -x; else set +x; fi -} - -function travis_time_end { - old_setting=${-//[^x]/} - set +x - _COLOR=${1:-32} - TRAVIS_ITEM="${TRAVIS_STACK[0]}" - TRAVIS_ITEMS=(${TRAVIS_ITEM//#/ }) - TRAVIS_FOLD_NAME="${TRAVIS_ITEMS[0]}" - TRAVIS_TIME_ID="${TRAVIS_ITEMS[1]}" - TRAVIS_START_TIME="${TRAVIS_ITEMS[2]}" - TRAVIS_STACK=("${TRAVIS_STACK[@]:1}") - TRAVIS_END_TIME=$(date ${DATE_OPTION}) - TIME_ELAPSED_SECONDS=$(( ($TRAVIS_END_TIME - $TRAVIS_START_TIME)/1000000000 )) - echo -e "travis_time:end:$TRAVIS_TIME_ID:start=$TRAVIS_START_TIME,finish=$TRAVIS_END_TIME,duration=$(($TRAVIS_END_TIME - $TRAVIS_START_TIME))\n\e[0K" - echo -e "travis_fold:end:$TRAVIS_FOLD_NAME" - echo -e "\e[0K\e[${_COLOR}mFunction $TRAVIS_FOLD_NAME takes $(( $TIME_ELAPSED_SECONDS / 60 )) min $(( $TIME_ELAPSED_SECONDS % 60 )) sec\e[0m" - if [[ -n "$old_setting" ]]; then set -x; else set +x; fi -} diff --git a/scripts/travis/install.sh b/scripts/travis/install.sh deleted file mode 100755 index 9bb80041f21..00000000000 --- a/scripts/travis/install.sh +++ /dev/null @@ -1,31 +0,0 @@ -#!/bin/bash - -set -e -. $( dirname $0 )/func.sh - -# INSTALLING SIPNET -( - travis_time_start "install_sipnet" "Installing SIPNET for testing" - - cd ${HOME} - curl -o sipnet_unk.tar.gz http://isda.ncsa.illinois.edu/~kooper/EBI/sipnet_unk.tar.gz - tar zxf sipnet_unk.tar.gz - cd sipnet_unk - make - ls -l sipnet - - travis_time_end -) - -# INSTALLING BIOCRO -( - travis_time_start "install_biocro" "Installing BioCro" - - cd ${HOME} - curl -sL https://github.com/ebimodeling/biocro/archive/0.95.tar.gz | tar zxf - - cd biocro-0.95 - rm configure - R CMD INSTALL . - - travis_time_end -) diff --git a/scripts/travis/script.sh b/scripts/travis/script.sh deleted file mode 100755 index 58376ec020c..00000000000 --- a/scripts/travis/script.sh +++ /dev/null @@ -1,62 +0,0 @@ -#!/bin/bash - -set -e -. $( dirname $0 )/func.sh - -# GENERATING DEPENDENCIES -( - travis_time_start "dependency_generate" "Generate PEcAn package dependencies" - Rscript scripts/generate_dependencies.R - travis_time_end -) - -# INSTALL SPECIFIC DBPLYR AND LATEST RGDAL -( - travis_time_start "pecan_install_dbplyr" "Installing dbplyr version 1.3.0 see #2349" - # fix for #2349 - Rscript -e 'devtools::install_version("dbplyr", version = "1.3.0", repos = "http://cran.us.r-project.org")' - Rscript -e 'install.packages("rgdal")' # yes, this is supposed to happen automatically but... doesn't - travis_time_end -) - -# COMPILE PECAN -( - travis_time_start "pecan_make_all" "Compiling PEcAn" - # TODO: Would probably be faster to use -j2 NCPUS=1 as for other steps, - # but many dependency compilations seem not parallel-safe. - # More debugging needed. - NCPUS=2 make -j1 - travis_time_end -) - - -# INSTALLING PECAN (compile, intall, test, check) -( - travis_time_start "pecan_make_test" "Testing PEcAn" - make test - travis_time_end -) - - -# INSTALLING PECAN (compile, intall, test, check) -( - travis_time_start "pecan_make_check" "Checking PEcAn" - REBUILD_DOCS=FALSE RUN_TESTS=FALSE make check - travis_time_end -) - - -# RUNNING SIMPLE PECAN WORKFLOW -( - travis_time_start "integration_test" "Testing Integration using simple PEcAn workflow" - ./tests/integration.sh travis - travis_time_end -) - -# CHECK FOR CHANGES TO DOC/DEPENDENCIES -if [[ `git status -s` ]]; then - echo "These files were changed by the build process:"; - git status -s; - echo "Have you run devtools::check and commited any updated Roxygen outputs?"; - exit 1; -fi diff --git a/scripts/update.mysql.sh b/scripts/update.mysql.sh deleted file mode 100755 index b4a3458fb3e..00000000000 --- a/scripts/update.mysql.sh +++ /dev/null @@ -1,27 +0,0 @@ -#!/bin/bash - -# goto home -cd $(dirname $0)/../.. -set -x - -# command to connect to database -export CMD="mysql -u bety -pbety" - -# load latest dump of the database -curl -o betydump.gz https://ebi-forecast.igb.illinois.edu/pecan/dump/betydump.mysql.gz - -echo "drop database if exists bety; create database bety;" | ${CMD} - -gunzip -c betydump.gz | grep -v 'DEFINER' | ${CMD} bety -rm betydump.gz - -# remove old runs -sudo rm -rf output -mkdir output -chmod 777 output - -# add sites -echo "addsites script is now using psql commands" - -# add models -echo "addmodels script is now using psql commands" diff --git a/scripts/update.psql.sh b/scripts/update.psql.sh deleted file mode 100755 index 39324c31fa4..00000000000 --- a/scripts/update.psql.sh +++ /dev/null @@ -1,62 +0,0 @@ -#!/bin/bash - -# goto home -cd $(dirname $0)/../.. -#set -x - -# command to connect to database -if [ "`uname -s`" != "Darwin" ]; then - export POSTGRES="sudo -u postgres" -fi -export CMD="${POSTGRES} psql -U bety" - -# load latest dump of the database -curl -o betydump.gz https://ebi-forecast.igb.illinois.edu/pecan/dump/betydump.psql.gz - -${POSTGRES} dropdb bety -${POSTGRES} createdb -O bety bety -${POSTGRES} psql -d bety -c 'CREATE EXTENSION Postgis;' -${POSTGRES} psql -d bety -c 'GRANT ALL ON ALL TABLES IN SCHEMA public TO bety;' - -gunzip -c betydump.gz | ${CMD} -d bety -rm betydump.gz - -# set all users -ID=2 - -RESULT=$( ${POSTGRES} psql -t -d bety -c "SELECT count(id) FROM users WHERE login='carya';" ) -if [ ${RESULT} -eq 0 ]; then - RESULT='UPDATE 0' - while [ "${RESULT}" = "UPDATE 0" ]; do - RESULT=$( ${POSTGRES} psql -t -d bety -c "UPDATE users SET login='carya', name='carya', crypted_password='df8428063fb28d75841d719e3447c3f416860bb7', salt='carya', access_level=1, page_access_level=1 WHERE id=${ID};" ) - ((ID++)) - done -fi -echo "Added carya with admin privileges" - -# set all users -for f in 1 2 3 4; do - for g in 1 2 3 4; do - RESULT=$( ${POSTGRES} psql -t -d bety -c "SELECT count(id) FROM users WHERE login='carya${f}${g}';" ) - if [ ${RESULT} -eq 0 ]; then - RESULT='UPDATE 0' - while [ "${RESULT}" = "UPDATE 0" ]; do - RESULT=$( ${POSTGRES} psql -t -d bety -c "UPDATE users SET login='carya${f}${g}', name='carya a-${f} p-${g}', crypted_password='df8428063fb28d75841d719e3447c3f416860bb7', salt='carya', access_level=${f}, page_access_level=${g} WHERE id=${ID};" ) - ((ID++)) - done - fi - done -done -echo "Updated users to have login='caryaXY' with appropriate privileges" -echo " (X=access_level, Y=page_access_level)." - -# add guest user -RESULT=$( ${POSTGRES} psql -t -d bety -c "SELECT count(id) FROM users WHERE login='guestuser';" ) -if [ ${RESULT} -eq 0 ]; then - RESULT='UPDATE 0' - while [ "${RESULT}" = "UPDATE 0" ]; do - RESULT=$( ${POSTGRES} psql -t -d bety -c "UPDATE users SET login='guestuser', name='guestuser', crypted_password='994363a949b6486fc7ea54bf40335127f5413318', salt='bety', access_level=4, page_access_level=4 WHERE id=${ID};" ) - ((ID++)) - done -fi -echo "Added guestuser with access_level=4 and page_access_level=4" diff --git a/scripts/updateVersion.sh b/scripts/updateVersion.sh index 0011ddc628a..2b43c6865c1 100755 --- a/scripts/updateVersion.sh +++ b/scripts/updateVersion.sh @@ -30,7 +30,7 @@ for d in $FILES; do echo "Modifying : $d" sed -i.bak -e "s/^Version: .*$/Version: $VERSION/" \ -e "s/^Date: .*$/Date: $DATE/" \ - -e "s/^License: .*/License: FreeBSD + file LICENSE/" $d + -e "s/^License: .*/License: BSD_3_clause + file LICENSE/" $d if [ ! -e "${DIR}/LICENSE" ]; then if [ -e LICENSE ]; then echo "Copied LICENSE file to ${DIR}" diff --git a/scripts/vacuum.bety.sh b/scripts/vacuum.bety.sh deleted file mode 100755 index 7fff9af9ef7..00000000000 --- a/scripts/vacuum.bety.sh +++ /dev/null @@ -1,204 +0,0 @@ -#!/bin/bash - -# exit on error -set -e - -# ---------------------------------------------------------------------- -# START CONFIGURATION SECTION -# ---------------------------------------------------------------------- - -# name of the dabase to vacuum -# this script assumes the user running it has access to the database -DATABASE=${DATABASE:-"bety"} - -# The database catalog to search for mactching table names -DBCATALOG=${DBCATALOG:-"bety"} - -# Perform a full vacuum which returns resources to the system -FULLVACUUM=${FULLVACUUM:-"NO"} - -# psql options -# this allows you to add the user to use as well as any other options -PG_OPT=${PG_OPT-"-U bety"} - -# Should the process be quiet -QUIET=${QUIET:-"NO"} - -# Should all the tables be vacuumed -TABLENAME=${TABLENAME:-"ALL"} - -# Whether the tables should be analyzed -ANALYZETABLES=${ANALYZETABLES:-"YES"} - -# Only analyze the tables, don't perform a regular vacuum -ANALYZEONLY=${ANALYZEONLY:-"NO"} - -# Non-database-system tables that should always be ignored on a vacuum -IGNORETABLES=${IGNORETABLES:-""} - -# Skip vacuuming the entire database after vacuuming the tables -SKIPDATABASE=${SKIPDATABASE:-"NO"} - -# ---------------------------------------------------------------------- -# END CONFIGURATION SECTION -# ---------------------------------------------------------------------- - -# parse command line options -while getopts c:d:fhi:np:qst:z opt; do - case $opt in - c) - DBCATALOG=$OPTARG - ;; - d) - DATABASE=$OPTARG - ;; - f) - if [ "${ANALYZEONLY}" == "NO" ]; then - FULLVACUUM="YES" - fi - ;; - h) - echo "$0 [-c datalog] [-d database] [-f] [-h] [-i table names] [-n] [-p psql options] [-q] [-s] [-t tablename] [-z]" - echo " -c catalog, database catalog name used to search for tables, default is bety" - echo " -d database, default is bety" - echo " -f perform a full vacuum to return resources to the system. Specify rarely, if ever" - echo " -h this help page" - echo " -i table names, list of space-separated table names to skip over when vacuuming" - echo " -n only vacuum the tables and do not analyze, default is to first vacuum and then analyze" - echo " -p additional psql command line options, default is -U bety" - echo " -q the vacuum should be quiet" - echo " -s skip vacuuming the database after vacuuming the tables" - echo " -t tablename, the name of the one table to vacuum" - echo " -z only perform analyze, do not perform a regular vacuum, overrides -n and -f, sets -s" - exit 0 - ;; - i) - # We add spaces to assist in exact table name maching - IGNORETABLES=" ${OPTARG} " - ;; - n) - if [ "${ANALYZEONLY}" == "NO" ]; then - ANALYZETABLES="NO" - fi - ;; - p) - PG_OPT=$OPTARG - ;; - q) - QUIET="YES" - ;; - s) - SKIPDATABASE="YES" - ;; - t) - TABLENAME=$OPTARG - SKIPDATABASE="YES" - ;; - z) - ANALYZEONLY="YES" - ANALYZETABLES="YES" - SKIPDATABASE="YES" - FULLVACUUM="NO" - ;; - esac -done - -# be quiet if not interactive -if ! tty -s ; then - exec 1>/dev/null -fi - -# find current schema version -# following returns a triple: -# - number of migrations -# - largest migration -# - hash of all migrations -MIGRATIONS=$( psql ${PG_OPT} -t -q -d "${DATABASE}" -c 'SELECT COUNT(version) FROM schema_migrations' | tr -d ' ' ) -VERSION=$( psql ${PG_OPT} -t -q -d "${DATABASE}" -c 'SELECT md5(array_agg(version)::text) FROM (SELECT version FROM schema_migrations ORDER BY version) as v;' | tr -d ' ' ) -LATEST=$( psql ${PG_OPT} -t -q -d "${DATABASE}" -c 'SELECT version FROM schema_migrations ORDER BY version DESC LIMIT 1' | tr -d ' ' ) -NOW=$( date -u +"%Y-%m-%dT%H:%M:%SZ" ) -if [ "${QUIET}" != "YES" ]; then - echo "Version: ${MIGRATIONS} ${VERSION} ${LATEST}" - echo "Starting vacuum: ${NOW}" -fi - -# Inform the caller of what we're doing -if [ "${QUIET}" != "YES" ]; then - RUNINFO="" - if [ "${TABLENAME}" == "ALL" ]; then - RUNINFO="Vacuuming all tables in catalog ${DBCATALOG}" - else - RUNINFO="Vacuuming ${TABLENAME}" - fi - if [ "${ANALYZETABLES}" == "YES" ]; then - RUNINFO="${RUNINFO}, with analysis" - else - RUNINFO="${RUNINFO}, skipping analysis" - fi - if [ "${SKIPDATABASE}" == "YES" ]; then - RUNINFO="${RUNINFO}, skipping entire database" - fi - if [ "${FULLVACUUM}" == "YES" ]; then - RUNINFO="${RUNINFO}, with the FULL option set (this may take a long time)" - fi - echo "${RUNINFO}" -fi - -# If we are vacuuming all the tables, get the list of tables from the database -if [ "${TABLENAME}" == "ALL" ]; then - TABLENAME=$(psql ${PG_OPT} -t -q -d "${DATABASE}" -c "select table_name from information_schema.tables where table_catalog='${DBCATALOG}' and table_schema='public' and table_type like '%TABLE%' order by table_name asc" | tr -d ' ') - if [ "${QUIET}" != "YES" ]; then - printf "Vacuuming all tables\n" - fi -else - if [ "${QUIET}" != "YES" ]; then - printf "Vacuuming %-40s\n" "${TABLENAME}" - fi -fi - -# Vacuum the tables -FULLOPTION="" -if [ "${FULLVACUUM}" == "YES" ]; then - FULLOPTION="FULL" -fi -for T in ${TABLENAME}; do - if echo "${IGNORETABLES}" | grep -qi " ${T} "; then - if [ "${QUIET}" != "YES" ]; then - printf "Ignoring %-40s\n" "${T}" - fi - else - if [ "${ANALYZEONLY}" == "NO" ]; then - if [ "${QUIET}" != "YES" ]; then - printf "Vacuum %s%-40s\n" "${FULLOPTION} " "${T}" - fi - psql ${PG_OPT} -t -q -d "${DATABASE}" -c "VACUUM ${FULLOPTION} ${T}" - fi - if [ "${ANALYZETABLES}" == "YES" ]; then - if [ "${QUIET}" != "YES" ]; then - printf "Vacuum analyze %-40s\n" "${T}" - fi - psql ${PG_OPT} -t -q -d "${DATABASE}" -c "VACUUM ANALYZE ${T}" - fi - fi -done - -# Vacuum the overall database, should be fast(er) with all the tables already vacuumed -if [ "${SKIPDATABASE}" == "NO" ]; then - if [ "${ANALYZEONLY}" == "NO" ]; then - if [ "${QUIET}" != "YES" ]; then - printf "Vacuum %sdatabase\n" "${FULLOPTION} " - fi - psql ${PG_OPT} -t -q -d "${DATABASE}" -c "VACUUM ${FULLOPTION}" - fi - if [ "${ANALYZETABLES}" == "YES" ]; then - if [ "${QUIET}" != "YES" ]; then - printf "Vacuum analyze database\n" - fi - psql ${PG_OPT} -t -q -d "${DATABASE}" -c "VACUUM ANALYZE" - fi -fi - -if [ "${QUIET}" != "YES" ]; then - NOW=$( date -u +"%Y-%m-%dT%H:%M:%SZ" ) - echo "Completed vacuum: ${NOW}" -fi diff --git a/scripts/workflow.bm.R b/scripts/workflow.bm.R index 797f31a38b9..09668b37117 100644 --- a/scripts/workflow.bm.R +++ b/scripts/workflow.bm.R @@ -70,8 +70,8 @@ kill.tunnel <- function() { # make sure always to call status.end options(warn = 1) options(error = quote({ - status.end("ERROR") - kill.tunnel() + try(status.end("ERROR")) + try(kill.tunnel(settings)) if (!interactive()) { q() } diff --git a/scripts/workflow.pda.R b/scripts/workflow.pda.R index 996d513e813..c0837bd787c 100755 --- a/scripts/workflow.pda.R +++ b/scripts/workflow.pda.R @@ -33,7 +33,7 @@ status.skip <- function(name) { options(warn = 1) options(error = quote({ - status.end("ERROR") + try(status.end("ERROR")) if (!interactive()) { q() } diff --git a/scripts/workflow.wcr.assim.R b/scripts/workflow.wcr.assim.R index 2912cd89d19..0023b905985 100644 --- a/scripts/workflow.wcr.assim.R +++ b/scripts/workflow.wcr.assim.R @@ -14,10 +14,10 @@ library(PEcAn.all) library(PEcAn.utils) library(RCurl) # make sure always to call status.end -options(warn=1) -options(error=quote({ - PEcAn.utils::status.end("ERROR") - PEcAn.remote::kill.tunnel(settings) +options(warn = 1) +options(error = quote({ + try(PEcAn.utils::status.end("ERROR")) + try(PEcAn.remote::kill.tunnel(settings)) if (!interactive()) { q() } diff --git a/shiny/BenchmarkReport/DESCRIPTION b/shiny/BenchmarkReport/DESCRIPTION index 7f3a86d2400..190cdf8cc4f 100644 --- a/shiny/BenchmarkReport/DESCRIPTION +++ b/shiny/BenchmarkReport/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Benchmarking Report -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Author: Betsy Cowdery ecowdery@bu.edu Tags: PEcAn Imports: shiny diff --git a/shiny/BrownDog/DESCRIPTION b/shiny/BrownDog/DESCRIPTION index 7a6c46fa230..544a2270373 100644 --- a/shiny/BrownDog/DESCRIPTION +++ b/shiny/BrownDog/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Workflow Output -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Author: Yan Zhao AuthorUrl: https://github.com/yan130 Tags: PEcAn diff --git a/shiny/BrownDog/server.R b/shiny/BrownDog/server.R index 5225484911e..99ea2fbe366 100644 --- a/shiny/BrownDog/server.R +++ b/shiny/BrownDog/server.R @@ -33,9 +33,8 @@ server <- shinyServer(function(input, output, session) { output$modelSelector <- renderUI({ bety <- betyConnect("../../web/config.php") - con <- bety$con - on.exit(db.close(con)) - models <- db.query("SELECT name FROM modeltypes;", con) + on.exit(db.close(bety), add = TRUE) + models <- db.query("SELECT name FROM modeltypes;", bety) selectInput("model", "Model", models) }) @@ -75,8 +74,7 @@ server <- shinyServer(function(input, output, session) { observeEvent(input$type, { # get all sites name, lat and lon by sitegroups bety <- betyConnect("../../web/config.php") - con <- bety$con - on.exit(db.close(con)) + on.exit(db.close(bety), add = TRUE) sites <- db.query( paste0( @@ -87,7 +85,7 @@ server <- shinyServer(function(input, output, session) { input$type, "');" ), - con + bety ) if(length(sites) > 0){ diff --git a/shiny/Data-Ingest/DESCRIPTION b/shiny/Data-Ingest/DESCRIPTION index c95023a7cd4..f245180193c 100644 --- a/shiny/Data-Ingest/DESCRIPTION +++ b/shiny/Data-Ingest/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Data-Ingest -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Date: 2019-09-05 Author: Liam Burke liam.burke24@gmail.com Tags: PEcAn diff --git a/shiny/Elicitation/DESCRIPTION b/shiny/Elicitation/DESCRIPTION index b1bf86101a5..332f258af91 100644 --- a/shiny/Elicitation/DESCRIPTION +++ b/shiny/Elicitation/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Expert Prior Elicitation -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Author: Mike Dietze , Rob Kooper diff --git a/shiny/Pecan.depend/DESCRIPTION b/shiny/Pecan.depend/DESCRIPTION index 9c40d09a33f..fe6b80cfbf1 100644 --- a/shiny/Pecan.depend/DESCRIPTION +++ b/shiny/Pecan.depend/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Visualize dependencies between PEcAn packages -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Author: Hamze Dokoohaki Tags: PEcAn #DisplayMode: Showcase diff --git a/shiny/Pecan.depend/www/style.css b/shiny/Pecan.depend/www/style.css index 3fec3f65b09..59355875e6a 100644 --- a/shiny/Pecan.depend/www/style.css +++ b/shiny/Pecan.depend/www/style.css @@ -1,17 +1,19 @@ button.btn.btn-default.action-button { -display:inline-block; -padding:0.7em 1.7em; -margin:0 0.3em 0.3em 0; -border-radius:0.2em; -box-sizing: border-box; -text-decoration:none; -font-family:'Roboto',sans-serif; -font-weight:400; -color:#FFFFFF; -background-color:#3cb0fd; -box-shadow:inset 0 -0.6em 1em -0.35em rgba(0,0,0,0.17),inset 0 0.6em 2em -0.3em rgba(255,255,255,0.15),inset 0 0 0em 0.05em rgba(255,255,255,0.12); -text-align:center; -position:relative; + display: inline-block; + padding: 0.7em 1.7em; + margin: 0 0.3em 0.3em 0; + border-radius: 0.2em; + box-sizing: border-box; + text-decoration: none; + font-family: "Roboto", sans-serif; + font-weight: 400; + color: #ffffff; + background-color: #3cb0fd; + box-shadow: inset 0 -0.6em 1em -0.35em rgba(0, 0, 0, 0.17), + inset 0 0.6em 2em -0.3em rgba(255, 255, 255, 0.15), + inset 0 0 0em 0.05em rgba(255, 255, 255, 0.12); + text-align: center; + position: relative; } button.btn.btn-default.action-button:hover { @@ -24,22 +26,19 @@ button.btn.btn-default.action-button:hover { text-decoration: none; } - - - - - - table.dataTable tr.selected td, table.dataTable td.selected { - background-color: #2F373E !important; - color: white; - border-style: solid; - border-color: white; - border: 2px; - } - table.dataTable.hover tbody tr:hover, table.dataTable.display tbody tr:hover { - background-color: #2F373E !important; - color: white !important; - border-style: solid; - border-color: white; - border: 2px; - } \ No newline at end of file +table.dataTable tr.selected td, +table.dataTable td.selected { + background-color: #2f373e !important; + color: white; + border-style: solid; + border-color: white; + border: 2px; +} +table.dataTable.hover tbody tr:hover, +table.dataTable.display tbody tr:hover { + background-color: #2f373e !important; + color: white !important; + border-style: solid; + border-color: white; + border: 2px; +} diff --git a/shiny/SDAdashboard/www/scripts.js b/shiny/SDAdashboard/www/scripts.js index 94726e7a521..a93a5ad2071 100644 --- a/shiny/SDAdashboard/www/scripts.js +++ b/shiny/SDAdashboard/www/scripts.js @@ -1,4 +1,4 @@ $("[data-toggle='toggle']").click(function() { - var selector = $(this).data("target"); - $(selector).toggleClass('in'); -}); \ No newline at end of file + var selector = $(this).data("target"); + $(selector).toggleClass("in"); +}); diff --git a/shiny/SDAdashboard/www/style.css b/shiny/SDAdashboard/www/style.css index dee8feb1b25..b0f3023ca8f 100644 --- a/shiny/SDAdashboard/www/style.css +++ b/shiny/SDAdashboard/www/style.css @@ -1,88 +1,99 @@ -.table>thead>tr>th, .table>tbody>tr>th, .table>tfoot>tr>th, .table>thead>tr>td, .table>tbody>tr>td, .table>tfoot>tr>td { - padding: 0 !important; -} - .label{ +.table > thead > tr > th, +.table > tbody > tr > th, +.table > tfoot > tr > th, +.table > thead > tr > td, +.table > tbody > tr > td, +.table > tfoot > tr > td { + padding: 0 !important; +} +.label { padding: 0px 0px 0px 0px; font-size: 100%; margin: 0px 0px 0px 0px; } /* Dropdown Button */ .dropbtn { - background-color: #4CAF50; - color: white; - padding: 16px; - font-size: 16px; - border: none; + background-color: #4caf50; + color: white; + padding: 16px; + font-size: 16px; + border: none; } /* The container
- needed to position the dropdown content */ .dropdown { - position: relative; - display: inline-block; + position: relative; + display: inline-block; } /* Dropdown Content (Hidden by Default) */ .dropdown-content { - display: none; - position: absolute; - background-color: #f1f1f1; - min-width: 160px; - box-shadow: 0px 8px 16px 0px rgba(0,0,0,0.2); - z-index: 1; - padding: 10px 10px 10px 10px; + display: none; + position: absolute; + background-color: #f1f1f1; + min-width: 160px; + box-shadow: 0px 8px 16px 0px rgba(0, 0, 0, 0.2); + z-index: 1; + padding: 10px 10px 10px 10px; } /* Links inside the dropdown */ .dropdown-content a { - color: black; - padding: 12px 16px; - text-decoration: none; - display: block; + color: black; + padding: 12px 16px; + text-decoration: none; + display: block; } .modal-backdrop { - background-color: #666699; + background-color: #666699; } -.modal-content { - -webkit-border-radius: 10px !important; - -moz-border-radius: 10px !important; - border-radius: 10px !important; +.modal-content { + -webkit-border-radius: 10px !important; + -moz-border-radius: 10px !important; + border-radius: 10px !important; } -.panel { - -webkit-border-radius: 10px !important; - -moz-border-radius: 10px !important; - border-radius: 10px !important; +.panel { + -webkit-border-radius: 10px !important; + -moz-border-radius: 10px !important; + border-radius: 10px !important; } -#mymap { - -webkit-border-radius: 5px !important; - -moz-border-radius: 5px !important; - border-radius: 5px !important; +#mymap { + -webkit-border-radius: 5px !important; + -moz-border-radius: 5px !important; + border-radius: 5px !important; } /* Change color of dropdown links on hover */ -.dropdown-content a:hover {background-color: #ddd;} +.dropdown-content a:hover { + background-color: #ddd; +} /* Show the dropdown menu on hover */ -.dropdown:hover .dropdown-content {display: block;} +.dropdown:hover .dropdown-content { + display: block; +} /* Change the background color of the dropdown button when the dropdown content is shown */ -.dropdown:hover .dropbtn {background-color: #3e8e41;} +.dropdown:hover .dropbtn { + background-color: #3e8e41; +} -.li { - font-family: Lato, Verdana, sans-serif !important; +.li { + font-family: Lato, Verdana, sans-serif !important; } -p { - font-family: Lato, Verdana, sans-serif !important; +p { + font-family: Lato, Verdana, sans-serif !important; } -h3 { - font-family: Lato, Verdana, sans-serif !important; +h3 { + font-family: Lato, Verdana, sans-serif !important; } -h4 { - font-family: Lato, Verdana, sans-serif !important; - font-size: 16px; +h4 { + font-family: Lato, Verdana, sans-serif !important; + font-size: 16px; } .content4 { display: flex; @@ -90,77 +101,78 @@ h4 { .contentt img { margin-right: 10px; - display:inline-block; - + display: inline-block; } .contentt h3, -.contentt p {margin: 0;} - +.contentt p { + margin: 0; +} -.modal-lg { +.modal-lg { width: 90%; - -webkit-border-radius: 5px !important; --moz-border-radius: 5px !important; -border-radius: 5px !important; - + -webkit-border-radius: 5px !important; + -moz-border-radius: 5px !important; + border-radius: 5px !important; } .blurryCont { - filter: blur(5px); - -webkit-filter: blur(5px); /* Safari 6.0 - 9.0 */ - -ms-filter: blur(5px); - filter: progid:DXImageTransform.Microsoft.gradient(enabled = false) !important; + filter: blur(5px); + -webkit-filter: blur(5px); /* Safari 6.0 - 9.0 */ + -ms-filter: blur(5px); + filter: progid:DXImageTransform.Microsoft.gradient(enabled = false) !important; -ms-filter: "progid:DXImageTransform.Microsoft.gradient(enabled = false)"; - } +} /* Style inputs */ -input[type=text], select, textarea { - width: 99%; - padding: 12px; - border: 1px solid #ccc; - margin-bottom: 16px; - resize: vertical; +input[type="text"], +select, +textarea { + width: 99%; + padding: 12px; + border: 1px solid #ccc; + margin-bottom: 16px; + resize: vertical; } -input[type=submit] { - background-color: #4CAF50; - color: white; - padding: 12px 20px; - border: none; - cursor: pointer; +input[type="submit"] { + background-color: #4caf50; + color: white; + padding: 12px 20px; + border: none; + cursor: pointer; } -input[type=submit]:hover { - background-color: #45a049; +input[type="submit"]:hover { + background-color: #45a049; } /* Style the container/contact section */ .container { - border-radius: 5px; - background-color: #f2f2f2; - padding: 10px; + border-radius: 5px; + background-color: #f2f2f2; + padding: 10px; } .containerW { - border-radius: 5px; - background-color: #f7f7f7; - padding: 5px; - margin: 2px; + border-radius: 5px; + background-color: #f7f7f7; + padding: 5px; + margin: 2px; } /* Create two columns that float next to eachother */ .column { - float: left; - width: 50%; - margin-top: 6px; - padding: 20px; + float: left; + width: 50%; + margin-top: 6px; + padding: 20px; } /* Clear floats after the columns */ .row:after { - content: ""; - display: table; - clear: both; + content: ""; + display: table; + clear: both; } /* Responsive layout - when the screen is less than 600px wide, make the two columns stack on top of each other instead of next to each other */ @@ -178,27 +190,27 @@ input[type=submit]:hover { color: #fff !important; } - body{ - font-size: 14px; +body { + font-size: 14px; } -.jumbotron{ - padding: 20px !important; +.jumbotron { + padding: 20px !important; } #loadmessage { - position: fixed; + position: fixed; top: 25%; left: 40%; z-index: 105; - } - .card { +} +.card { position: relative; display: -webkit-box; display: -ms-flexbox; display: flex; -webkit-box-orient: vertical; -webkit-box-direction: normal; - -ms-flex-direction: column; - flex-direction: column; + -ms-flex-direction: column; + flex-direction: column; min-width: 0; word-wrap: break-word; background-color: #fff; @@ -224,8 +236,8 @@ input[type=submit]:hover { .card-body { -webkit-box-flex: 1; - -ms-flex: 1 1 auto; - flex: 1 1 auto; + -ms-flex: 1 1 auto; + flex: 1 1 auto; padding: 1.5rem; } @@ -320,8 +332,8 @@ input[type=submit]:hover { display: flex; -webkit-box-orient: vertical; -webkit-box-direction: normal; - -ms-flex-direction: column; - flex-direction: column; + -ms-flex-direction: column; + flex-direction: column; } .card-deck .card { @@ -332,8 +344,8 @@ input[type=submit]:hover { .card-deck { -webkit-box-orient: horizontal; -webkit-box-direction: normal; - -ms-flex-flow: row wrap; - flex-flow: row wrap; + -ms-flex-flow: row wrap; + flex-flow: row wrap; margin-right: -15px; margin-left: -15px; } @@ -342,12 +354,12 @@ input[type=submit]:hover { display: -ms-flexbox; display: flex; -webkit-box-flex: 1; - -ms-flex: 1 0 0%; - flex: 1 0 0%; + -ms-flex: 1 0 0%; + flex: 1 0 0%; -webkit-box-orient: vertical; -webkit-box-direction: normal; - -ms-flex-direction: column; - flex-direction: column; + -ms-flex-direction: column; + flex-direction: column; margin-right: 15px; margin-bottom: 0; margin-left: 15px; @@ -360,8 +372,8 @@ input[type=submit]:hover { display: flex; -webkit-box-orient: vertical; -webkit-box-direction: normal; - -ms-flex-direction: column; - flex-direction: column; + -ms-flex-direction: column; + flex-direction: column; } .card-group > .card { @@ -372,13 +384,13 @@ input[type=submit]:hover { .card-group { -webkit-box-orient: horizontal; -webkit-box-direction: normal; - -ms-flex-flow: row wrap; - flex-flow: row wrap; + -ms-flex-flow: row wrap; + flex-flow: row wrap; } .card-group > .card { -webkit-box-flex: 1; - -ms-flex: 1 0 0%; - flex: 1 0 0%; + -ms-flex: 1 0 0%; + flex: 1 0 0%; margin-bottom: 0; } .card-group > .card + .card { @@ -425,10 +437,18 @@ input[type=submit]:hover { .card-group > .card:not(:first-child):not(:last-child):not(:only-child) { border-radius: 0; } - .card-group > .card:not(:first-child):not(:last-child):not(:only-child) .card-img-top, - .card-group > .card:not(:first-child):not(:last-child):not(:only-child) .card-img-bottom, - .card-group > .card:not(:first-child):not(:last-child):not(:only-child) .card-header, - .card-group > .card:not(:first-child):not(:last-child):not(:only-child) .card-footer { + .card-group + > .card:not(:first-child):not(:last-child):not(:only-child) + .card-img-top, + .card-group + > .card:not(:first-child):not(:last-child):not(:only-child) + .card-img-bottom, + .card-group + > .card:not(:first-child):not(:last-child):not(:only-child) + .card-header, + .card-group + > .card:not(:first-child):not(:last-child):not(:only-child) + .card-footer { border-radius: 0; } } @@ -440,9 +460,9 @@ input[type=submit]:hover { @media (min-width: 576px) { .card-columns { -webkit-column-count: 3; - column-count: 3; + column-count: 3; -webkit-column-gap: 1.25rem; - column-gap: 1.25rem; + column-gap: 1.25rem; orphans: 1; widows: 1; } @@ -472,7 +492,7 @@ input[type=submit]:hover { border-top-right-radius: 0; } .border-primary { - border-color: #2FA4E7 !important; + border-color: #2fa4e7 !important; } .border-secondary { @@ -480,19 +500,19 @@ input[type=submit]:hover { } .border-success { - border-color: #73A839 !important; + border-color: #73a839 !important; } .border-info { - border-color: #033C73 !important; + border-color: #033c73 !important; } .border-warning { - border-color: #DD5600 !important; + border-color: #dd5600 !important; } .border-danger { - border-color: #C71C22 !important; + border-color: #c71c22 !important; } .border-light { @@ -544,224 +564,462 @@ input[type=submit]:hover { } .card-body { -webkit-box-flex: 1; - -ms-flex: 1 1 auto; - flex: 1 1 auto; + -ms-flex: 1 1 auto; + flex: 1 1 auto; padding: 1.25rem; } .card-text:last-child { margin-bottom: 0; } .bg-danger { - background-color: #C71C22 !important; + background-color: #c71c22 !important; } .bg-success { - background-color: #73A839 !important; + background-color: #73a839 !important; } .badge { - border: 1px solid #000; + border: 1px solid #000; } .bg-primary { - background-image: -webkit-gradient(linear, left top, left bottom, from(#54b4eb), color-stop(60%, #2FA4E7), to(#1d9ce5)); - background-image: linear-gradient(#54b4eb, #2FA4E7 60%, #1d9ce5); + background-image: -webkit-gradient( + linear, + left top, + left bottom, + from(#54b4eb), + color-stop(60%, #2fa4e7), + to(#1d9ce5) + ); + background-image: linear-gradient(#54b4eb, #2fa4e7 60%, #1d9ce5); background-repeat: no-repeat; } .bg-dark { - background-image: -webkit-gradient(linear, left top, left bottom, from(#04519b), color-stop(60%, #033C73), to(#02325f)); - background-image: linear-gradient(#04519b, #033C73 60%, #02325f); + background-image: -webkit-gradient( + linear, + left top, + left bottom, + from(#04519b), + color-stop(60%, #033c73), + to(#02325f) + ); + background-image: linear-gradient(#04519b, #033c73 60%, #02325f); background-repeat: no-repeat; } .bg-warning { - background-color: #DD5600 !important; + background-color: #dd5600 !important; } .bg-light { - background-image: -webkit-gradient(linear, left top, left bottom, from(white), color-stop(60%, #e9ecef), to(#e3e7eb)); + background-image: -webkit-gradient( + linear, + left top, + left bottom, + from(white), + color-stop(60%, #e9ecef), + to(#e3e7eb) + ); background-image: linear-gradient(white, #e9ecef 60%, #e3e7eb); background-repeat: no-repeat; } .dropdown.dropdown-lg .dropdown-menu { - margin-top: -1px; - padding: 6px 20px; - color:balck; + margin-top: -1px; + padding: 6px 20px; + color: balck; } .input-group-btn .btn-group { - display: flex !important; + display: flex !important; } .btn-group .btn { - border-radius: 0; - margin-left: -1px; + border-radius: 0; + margin-left: -1px; } .btn-group .btn:last-child { - border-top-right-radius: 4px; - border-bottom-right-radius: 4px; + border-top-right-radius: 4px; + border-bottom-right-radius: 4px; } .btn-group .form-horizontal .btn[type="submit"] { border-top-left-radius: 4px; border-bottom-left-radius: 4px; } .form-horizontal .form-group { - margin-left: 0; - margin-right: 0; + margin-left: 0; + margin-right: 0; } .form-group .form-control:last-child { - border-top-left-radius: 4px; - border-bottom-left-radius: 4px; + border-top-left-radius: 4px; + border-bottom-left-radius: 4px; } @media screen and (min-width: 968px) { - #adv-search { - width: 500px; - margin: 0 auto; - } - .dropdown.dropdown-lg { - position: static !important; - } - .dropdown.dropdown-lg .dropdown-menu { - min-width: 500px; - } -} -* { font-family: Lato, Helvetica, Arial, sans-serif; } + #adv-search { + width: 500px; + margin: 0 auto; + } + .dropdown.dropdown-lg { + position: static !important; + } + .dropdown.dropdown-lg .dropdown-menu { + min-width: 500px; + } +} +* { + font-family: Lato, Helvetica, Arial, sans-serif; +} .promoBox { - display: inline-block; - position: relative; - margin: 5px; - padding: 10px; - width: 100%; - border: 2px solid #ddd; - -webkit-border-radius: 8px; - border-radius: 8px; - overflow: hidden; - - background: #ffffff; - background: -moz-linear-gradient(-45deg, #ffffff 0%, #f1f1f1 50%, #e1e1e1 51%, #f6f6f6 100%); - background: -webkit-gradient(linear, left top, right bottom, color-stop(0%,#ffffff), color-stop(50%,#f1f1f1), color-stop(51%,#e1e1e1), color-stop(100%,#f6f6f6)); - background: -webkit-linear-gradient(-45deg, #ffffff 0%,#f1f1f1 50%,#e1e1e1 51%,#f6f6f6 100%); - background: -o-linear-gradient(-45deg, #ffffff 0%,#f1f1f1 50%,#e1e1e1 51%,#f6f6f6 100%); - background: -ms-linear-gradient(-45deg, #ffffff 0%,#f1f1f1 50%,#e1e1e1 51%,#f6f6f6 100%); - background: linear-gradient(135deg, #ffffff 0%,#f1f1f1 50%,#e1e1e1 51%,#f6f6f6 100%); - filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#ffffff', endColorstr='#f6f6f6',GradientType=1 ); - - -webkit-box-shadow: 0px 3px 5px 0px rgba(0,0,0,0.2); - box-shadow: 0px 3px 5px 0px rgba(0,0,0,0.2); + display: inline-block; + position: relative; + margin: 5px; + padding: 10px; + width: 100%; + border: 2px solid #ddd; + -webkit-border-radius: 8px; + border-radius: 8px; + overflow: hidden; + + background: #ffffff; + background: -moz-linear-gradient( + -45deg, + #ffffff 0%, + #f1f1f1 50%, + #e1e1e1 51%, + #f6f6f6 100% + ); + background: -webkit-gradient( + linear, + left top, + right bottom, + color-stop(0%, #ffffff), + color-stop(50%, #f1f1f1), + color-stop(51%, #e1e1e1), + color-stop(100%, #f6f6f6) + ); + background: -webkit-linear-gradient( + -45deg, + #ffffff 0%, + #f1f1f1 50%, + #e1e1e1 51%, + #f6f6f6 100% + ); + background: -o-linear-gradient( + -45deg, + #ffffff 0%, + #f1f1f1 50%, + #e1e1e1 51%, + #f6f6f6 100% + ); + background: -ms-linear-gradient( + -45deg, + #ffffff 0%, + #f1f1f1 50%, + #e1e1e1 51%, + #f6f6f6 100% + ); + background: linear-gradient( + 135deg, + #ffffff 0%, + #f1f1f1 50%, + #e1e1e1 51%, + #f6f6f6 100% + ); + filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#ffffff', endColorstr='#f6f6f6',GradientType=1 ); + + -webkit-box-shadow: 0px 3px 5px 0px rgba(0, 0, 0, 0.2); + box-shadow: 0px 3px 5px 0px rgba(0, 0, 0, 0.2); } .promoBox aside { - position: absolute; - width: 230px; - right: 0; - margin: 0 -65px 0 0; - -webkit-transform: rotate(35deg); - -khtml-transform: rotate(35deg); - -moz-transform: rotate(35deg); - -ms-transform: rotate(35deg); - transform: rotate(35deg); - -webkit-box-shadow: 0px 3px 5px 0px rgba(0,0,0,0.2); - box-shadow: 0px 3px 5px 0px rgba(0,0,0,0.2); - text-align: center; - text-transform: uppercase; - font-size: 10px; - - color: #fff; - background: #4f85bb; - background: -moz-linear-gradient(-45deg, #4f85bb 0%, #4f85bb 100%); - background: -webkit-gradient(linear, left top, right bottom, color-stop(0%,#4f85bb), color-stop(100%,#4f85bb)); - background: -webkit-linear-gradient(-45deg, #4f85bb 0%,#4f85bb 100%); - background: -o-linear-gradient(-45deg, #4f85bb 0%,#4f85bb 100%); - background: -ms-linear-gradient(-45deg, #4f85bb 0%,#4f85bb 100%); - background: linear-gradient(135deg, #4f85bb 0%,#4f85bb 100%); - filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#4f85bb', endColorstr='#4f85bb',GradientType=1 ); - -} - -.promoBox aside p { padding: 10px 80px 10px 80px; margin: 0; } -.promoBox h4 { - font-size: 25px; - margin: 0; - padding: 0 35% 10px 0; - line-height: 25px; - border-bottom: 1px solid #ddd; - -} -.promoBox p { font-size: 12px; } + position: absolute; + width: 230px; + right: 0; + margin: 0 -65px 0 0; + -webkit-transform: rotate(35deg); + -khtml-transform: rotate(35deg); + -moz-transform: rotate(35deg); + -ms-transform: rotate(35deg); + transform: rotate(35deg); + -webkit-box-shadow: 0px 3px 5px 0px rgba(0, 0, 0, 0.2); + box-shadow: 0px 3px 5px 0px rgba(0, 0, 0, 0.2); + text-align: center; + text-transform: uppercase; + font-size: 10px; + + color: #fff; + background: #4f85bb; + background: -moz-linear-gradient(-45deg, #4f85bb 0%, #4f85bb 100%); + background: -webkit-gradient( + linear, + left top, + right bottom, + color-stop(0%, #4f85bb), + color-stop(100%, #4f85bb) + ); + background: -webkit-linear-gradient(-45deg, #4f85bb 0%, #4f85bb 100%); + background: -o-linear-gradient(-45deg, #4f85bb 0%, #4f85bb 100%); + background: -ms-linear-gradient(-45deg, #4f85bb 0%, #4f85bb 100%); + background: linear-gradient(135deg, #4f85bb 0%, #4f85bb 100%); + filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#4f85bb', endColorstr='#4f85bb',GradientType=1 ); +} + +.promoBox aside p { + padding: 10px 80px 10px 80px; + margin: 0; +} +.promoBox h4 { + font-size: 25px; + margin: 0; + padding: 0 35% 10px 0; + line-height: 25px; + border-bottom: 1px solid #ddd; +} +.promoBox p { + font-size: 12px; +} /* COLOR: Box & Text \* --------------------------------- */ .promoBox.info-box { - background: #e0f3fa; - background: -moz-linear-gradient(-45deg, #e0f3fa 0%, #d8f0fc 50%, #b8e2f6 51%, #b6dffd 100%); - background: -webkit-gradient(linear, left top, right bottom, color-stop(0%,#e0f3fa), color-stop(50%,#d8f0fc), color-stop(51%,#b8e2f6), color-stop(100%,#b6dffd)); - background: -webkit-linear-gradient(-45deg, #e0f3fa 0%,#d8f0fc 50%,#b8e2f6 51%,#b6dffd 100%); - background: -o-linear-gradient(-45deg, #e0f3fa 0%,#d8f0fc 50%,#b8e2f6 51%,#b6dffd 100%); - background: -ms-linear-gradient(-45deg, #e0f3fa 0%,#d8f0fc 50%,#b8e2f6 51%,#b6dffd 100%); - background: linear-gradient(135deg, #e0f3fa 0%,#d8f0fc 50%,#b8e2f6 51%,#b6dffd 100%); - filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#e0f3fa', endColorstr='#b6dffd',GradientType=1 ); - border-color: #b6e1f6; -} -.promoBox.info-box h4 { color: #225b9c; border-color: #8dc2dd; } + background: #e0f3fa; + background: -moz-linear-gradient( + -45deg, + #e0f3fa 0%, + #d8f0fc 50%, + #b8e2f6 51%, + #b6dffd 100% + ); + background: -webkit-gradient( + linear, + left top, + right bottom, + color-stop(0%, #e0f3fa), + color-stop(50%, #d8f0fc), + color-stop(51%, #b8e2f6), + color-stop(100%, #b6dffd) + ); + background: -webkit-linear-gradient( + -45deg, + #e0f3fa 0%, + #d8f0fc 50%, + #b8e2f6 51%, + #b6dffd 100% + ); + background: -o-linear-gradient( + -45deg, + #e0f3fa 0%, + #d8f0fc 50%, + #b8e2f6 51%, + #b6dffd 100% + ); + background: -ms-linear-gradient( + -45deg, + #e0f3fa 0%, + #d8f0fc 50%, + #b8e2f6 51%, + #b6dffd 100% + ); + background: linear-gradient( + 135deg, + #e0f3fa 0%, + #d8f0fc 50%, + #b8e2f6 51%, + #b6dffd 100% + ); + filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#e0f3fa', endColorstr='#b6dffd',GradientType=1 ); + border-color: #b6e1f6; +} +.promoBox.info-box h4 { + color: #225b9c; + border-color: #8dc2dd; +} .promoBox.warning-box { - background: #fceabb; - background: -moz-linear-gradient(-45deg, #fceabb 0%, #fccd4d 50%, #f8b500 51%, #fbdf93 100%); - background: -webkit-gradient(linear, left top, right bottom, color-stop(0%,#fceabb), color-stop(50%,#fccd4d), color-stop(51%,#f8b500), color-stop(100%,#fbdf93)); - background: -webkit-linear-gradient(-45deg, #fceabb 0%,#fccd4d 50%,#f8b500 51%,#fbdf93 100%); - background: -o-linear-gradient(-45deg, #fceabb 0%,#fccd4d 50%,#f8b500 51%,#fbdf93 100%); - background: -ms-linear-gradient(-45deg, #fceabb 0%,#fccd4d 50%,#f8b500 51%,#fbdf93 100%); - background: linear-gradient(135deg, #fceabb 0%,#fccd4d 50%,#f8b500 51%,#fbdf93 100%); - filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#fceabb', endColorstr='#fbdf93',GradientType=1 ); - border-color: #fccf5a; -} -.promoBox.warning-box h4 { color: #775600; border-color: #9e8135; } + background: #fceabb; + background: -moz-linear-gradient( + -45deg, + #fceabb 0%, + #fccd4d 50%, + #f8b500 51%, + #fbdf93 100% + ); + background: -webkit-gradient( + linear, + left top, + right bottom, + color-stop(0%, #fceabb), + color-stop(50%, #fccd4d), + color-stop(51%, #f8b500), + color-stop(100%, #fbdf93) + ); + background: -webkit-linear-gradient( + -45deg, + #fceabb 0%, + #fccd4d 50%, + #f8b500 51%, + #fbdf93 100% + ); + background: -o-linear-gradient( + -45deg, + #fceabb 0%, + #fccd4d 50%, + #f8b500 51%, + #fbdf93 100% + ); + background: -ms-linear-gradient( + -45deg, + #fceabb 0%, + #fccd4d 50%, + #f8b500 51%, + #fbdf93 100% + ); + background: linear-gradient( + 135deg, + #fceabb 0%, + #fccd4d 50%, + #f8b500 51%, + #fbdf93 100% + ); + filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#fceabb', endColorstr='#fbdf93',GradientType=1 ); + border-color: #fccf5a; +} +.promoBox.warning-box h4 { + color: #775600; + border-color: #9e8135; +} .promoBox.danger-box { - background: #f85032; - background: -moz-linear-gradient(-45deg, #f85032 0%, #f16f5c 50%, #f6290c 51%, #f02f17 71%, #e73827 100%); - background: -webkit-gradient(linear, left top, right bottom, color-stop(0%,#f85032), color-stop(50%,#f16f5c), color-stop(51%,#f6290c), color-stop(71%,#f02f17), color-stop(100%,#e73827)); - background: -webkit-linear-gradient(-45deg, #f85032 0%,#f16f5c 50%,#f6290c 51%,#f02f17 71%,#e73827 100%); - background: -o-linear-gradient(-45deg, #f85032 0%,#f16f5c 50%,#f6290c 51%,#f02f17 71%,#e73827 100%); - background: -ms-linear-gradient(-45deg, #f85032 0%,#f16f5c 50%,#f6290c 51%,#f02f17 71%,#e73827 100%); - background: linear-gradient(135deg, #f85032 0%,#f16f5c 50%,#f6290c 51%,#f02f17 71%,#e73827 100%); - filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#f85032', endColorstr='#e73827',GradientType=1 ); - border-color: #ff433e; - color: #fff; -} -.promoBox.danger-box h4 { color: #fff; border-color: #ff706d; } - -.promoBox.success-box { - background: #9dd53a; - background: -moz-linear-gradient(-45deg, #9dd53a 0%, #a1d54f 50%, #80c217 51%, #7cbc0a 100%); - background: -webkit-gradient(linear, left top, right bottom, color-stop(0%,#9dd53a), color-stop(50%,#a1d54f), color-stop(51%,#80c217), color-stop(100%,#7cbc0a)); - background: -webkit-linear-gradient(-45deg, #9dd53a 0%,#a1d54f 50%,#80c217 51%,#7cbc0a 100%); - background: -o-linear-gradient(-45deg, #9dd53a 0%,#a1d54f 50%,#80c217 51%,#7cbc0a 100%); - background: -ms-linear-gradient(-45deg, #9dd53a 0%,#a1d54f 50%,#80c217 51%,#7cbc0a 100%); - background: linear-gradient(135deg, #9dd53a 0%,#a1d54f 50%,#80c217 51%,#7cbc0a 100%); - filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#9dd53a', endColorstr='#7cbc0a',GradientType=1 ); - border-color: #9dd53a; - color: #fff; + background: #f85032; + background: -moz-linear-gradient( + -45deg, + #f85032 0%, + #f16f5c 50%, + #f6290c 51%, + #f02f17 71%, + #e73827 100% + ); + background: -webkit-gradient( + linear, + left top, + right bottom, + color-stop(0%, #f85032), + color-stop(50%, #f16f5c), + color-stop(51%, #f6290c), + color-stop(71%, #f02f17), + color-stop(100%, #e73827) + ); + background: -webkit-linear-gradient( + -45deg, + #f85032 0%, + #f16f5c 50%, + #f6290c 51%, + #f02f17 71%, + #e73827 100% + ); + background: -o-linear-gradient( + -45deg, + #f85032 0%, + #f16f5c 50%, + #f6290c 51%, + #f02f17 71%, + #e73827 100% + ); + background: -ms-linear-gradient( + -45deg, + #f85032 0%, + #f16f5c 50%, + #f6290c 51%, + #f02f17 71%, + #e73827 100% + ); + background: linear-gradient( + 135deg, + #f85032 0%, + #f16f5c 50%, + #f6290c 51%, + #f02f17 71%, + #e73827 100% + ); + filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#f85032', endColorstr='#e73827',GradientType=1 ); + border-color: #ff433e; + color: #fff; +} +.promoBox.danger-box h4 { + color: #fff; + border-color: #ff706d; } -.promoBox.success-box h4 { color: #4d690b; border-color: #ccfc5a; } - - -table.dataTable tr.selected td, table.dataTable td.selected { - background-color: #ff0039 !important; +.promoBox.success-box { + background: #9dd53a; + background: -moz-linear-gradient( + -45deg, + #9dd53a 0%, + #a1d54f 50%, + #80c217 51%, + #7cbc0a 100% + ); + background: -webkit-gradient( + linear, + left top, + right bottom, + color-stop(0%, #9dd53a), + color-stop(50%, #a1d54f), + color-stop(51%, #80c217), + color-stop(100%, #7cbc0a) + ); + background: -webkit-linear-gradient( + -45deg, + #9dd53a 0%, + #a1d54f 50%, + #80c217 51%, + #7cbc0a 100% + ); + background: -o-linear-gradient( + -45deg, + #9dd53a 0%, + #a1d54f 50%, + #80c217 51%, + #7cbc0a 100% + ); + background: -ms-linear-gradient( + -45deg, + #9dd53a 0%, + #a1d54f 50%, + #80c217 51%, + #7cbc0a 100% + ); + background: linear-gradient( + 135deg, + #9dd53a 0%, + #a1d54f 50%, + #80c217 51%, + #7cbc0a 100% + ); + filter: progid:DXImageTransform.Microsoft.gradient( startColorstr='#9dd53a', endColorstr='#7cbc0a',GradientType=1 ); + border-color: #9dd53a; + color: #fff; +} +.promoBox.success-box h4 { + color: #4d690b; + border-color: #ccfc5a; +} + +table.dataTable tr.selected td, +table.dataTable td.selected { + background-color: #ff0039 !important; +} + +table.dataTable tr:hover td { + background-color: #2c3237 !important; +} + +table.dataTable th { + color: #fff; + background-color: #212529; + border-color: #32383e; + height: 35px; +} + +table.dataTable tr td { + color: #fff; + background-color: #212529 !important; + border-color: #32383e !important; } - - -table.dataTable tr:hover td{ - background-color: #2c3237!important; - } - -table.dataTable th{ - color: #fff; - background-color: #212529; - border-color: #32383e; - height:35px; - } - -table.dataTable tr td{ - color: #fff; - background-color: #212529 !important; - border-color: #32383e !important; - } diff --git a/shiny/ViewMet/DESCRIPTION b/shiny/ViewMet/DESCRIPTION index 74df27a9964..513ef86631c 100644 --- a/shiny/ViewMet/DESCRIPTION +++ b/shiny/ViewMet/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Plot data from CF-formatted meteorology files -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Author: Betsy Cowdery Tags: PEcAn Imports: diff --git a/shiny/ViewMet/server.R b/shiny/ViewMet/server.R index ed4cd4325af..3cb45c022e0 100644 --- a/shiny/ViewMet/server.R +++ b/shiny/ViewMet/server.R @@ -3,7 +3,6 @@ lapply(c( "shiny", "ggplot2", "stringr", "ncdf4", - "ncdf4.helpers", "DT", "plyr", "dplyr"),function(pkg){ @@ -139,9 +138,11 @@ server <- function(input, output, session) { formatid <- tbl(bety, "inputs") %>% filter(id == inputid) %>% pull(format_id) siteid <- tbl(bety, "inputs") %>% filter(id == inputid) %>% pull(site_id) - site = query.site(con = bety$con, siteid) + site = query.site(con = bety, siteid) - vars_in_file <- ncdf4::nc_open(rv$load.paths[i]) %>% ncdf4.helpers::nc.get.variable.list() + current_nc <- ncdf4::nc_open(rv$load.paths[i]) + vars_in_file <- names(current_nc[["var"]]) + ncdf4::nc_close(current_nc) format = query.format.vars(bety, inputid, formatid) format$vars <- format$vars %>% filter(input_name %in% vars_in_file) @@ -149,7 +150,7 @@ server <- function(input, output, session) { dat <- try(load_data(data.path = rv$load.paths[i], format = format, site = site, )) - if(class(dat) == "data.frame"){ + if(inherits(dat, "data.frame")) { dat$met <- rv$load.paths[i] %>% dirname() %>% basename() %>% gsub(pattern = "\\_site_.*",replacement = "", x = .) data[[i]] <- dat @@ -199,4 +200,4 @@ server <- function(input, output, session) { -} \ No newline at end of file +} diff --git a/shiny/dbsync/DESCRIPTION b/shiny/dbsync/DESCRIPTION new file mode 100644 index 00000000000..9cb073d559a --- /dev/null +++ b/shiny/dbsync/DESCRIPTION @@ -0,0 +1,6 @@ +Type: Shiny +Title: Database Sync Vis +License: BSD_3_clause + file LICENSE +Author: Rob Kooper +Tags: PEcAn +Imports: shiny diff --git a/shiny/dbsync/Dockerfile b/shiny/dbsync/Dockerfile new file mode 100644 index 00000000000..d5a89a6ca0f --- /dev/null +++ b/shiny/dbsync/Dockerfile @@ -0,0 +1,21 @@ +FROM rocker/shiny + +ENV PGHOST=postgres \ + PGDATABASE=bety \ + PGUSER=bety \ + PGPASSWORD=bety \ + GEOCACHE=/srv/shiny-server/geoip.json + +RUN apt-get update \ + && apt-get -y install libpq-dev libssl-dev \ + && install2.r -e -s -n -1 curl dbplyr DT leaflet RPostgreSQL \ + && rm -rf /srv/shiny-server/* \ + && rm -rf /var/lib/apt/lists/* +ADD . /srv/shiny-server/ + +ADD https://raw.githubusercontent.com/rocker-org/shiny/master/shiny-server.sh /usr/bin/ + +RUN chmod +x /usr/bin/shiny-server.sh + +# special script to start shiny server and preserve env variable +CMD /srv/shiny-server/save-env-shiny.sh diff --git a/shiny/dbsync/LICENSE b/shiny/dbsync/LICENSE new file mode 100644 index 00000000000..26efbfea4dc --- /dev/null +++ b/shiny/dbsync/LICENSE @@ -0,0 +1,34 @@ +## This is the master copy of the PEcAn License + +University of Illinois/NCSA Open Source License + +Copyright (c) 2012, University of Illinois, NCSA. All rights reserved. + +PEcAn project +www.pecanproject.org + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the + "Software"), to deal with the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + + - Redistributions of source code must retain the above copyright +notice, this list of conditions and the following disclaimers. +- Redistributions in binary form must reproduce the above copyright +notice, this list of conditions and the following disclaimers in the +documentation and/or other materials provided with the distribution. +- Neither the names of University of Illinois, NCSA, nor the names +of its contributors may be used to endorse or promote products +derived from this Software without specific prior written permission. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE CONTRIBUTORS OR COPYRIGHT HOLDERS BE LIABLE FOR +ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF +CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS WITH THE SOFTWARE. + diff --git a/shiny/dbsync/app.R b/shiny/dbsync/app.R new file mode 100644 index 00000000000..da4f3065247 --- /dev/null +++ b/shiny/dbsync/app.R @@ -0,0 +1,309 @@ +library(shiny) +library(leaflet) +library(dbplyr) +library(RPostgreSQL) + +# cached geo information to prevent frequent lookups +geoip <- list() +geocache <- Sys.getenv("GEOCACHE", "geoip.json") + +# maximum number of lines to consider of sync log, if this is +# large the update sync can take long time +maxlines <- 5000 + +# maximum time in hours before sync is red +maxtime <- 24 + +# number of bins to use when rendering lines +maxbins <- 5 + +# show hosts with missing sync_url +allow_no_url <- FALSE + +# mapping to fix hostnames +host_mapping <- list( + "wisconsin"="tree.aos.wisc.edu", + "terra-mepp.igb.illinois.edu"="terra-mepp.illinois.edu", + "ecn.purdue.edu"="engineering.purdue.edu", + "paleon-pecan.virtual.crc.nd.edu"="crc.nd.edu" +) + +# ignored servers, is reset on refresh +ignored_servers <- c() + +# given a IP address lookup geo spatital info +# uses a cache to prevent to many requests (1000 per day) +get_geoip <- function(ip) { + if (length(geoip) == 0 && file.exists("geoip.json")) { + geoip <<- jsonlite::read_json(geocache, simplifyVector = TRUE) + } + if (! ip %in% geoip$ip) { + print(paste("CACHE MISS", ip)) + res <- curl::curl_fetch_memory(paste0("http://free.ipwhois.io/json/", ip)) + if (res$status -- 200) { + geoloc <- jsonlite::parse_json(rawToChar(res$content)) + geoloc[lengths(geoloc) == 0] <- NA + geoloc <- type.convert(geoloc, as.is = TRUE) + } else { + geoloc <- list(ip=ip, lat=0, lon=0, city="?", countr="?") + } + if (length(geoip) == 0) { + geoip <<- as.data.frame(geoloc) + } else { + geoip <<- rbind(geoip, as.data.frame(geoloc)) + } + jsonlite::write_json(geoip, geocache) + } +} + +# get a list of all servers in BETY and their geospatial location +get_servers <- function() { + ignored_servers <<- c() + + # connect to BETYdb + bety <- DBI::dbConnect( + DBI::dbDriver("PostgreSQL"), + dbname = Sys.getenv("PGDATABASE", "bety"), + host = Sys.getenv("PGHOST", "localhost"), + user = Sys.getenv("PGUSER", "bety"), + password = Sys.getenv("PGPASSWORD", "bety") + ) + + servers <- dplyr::tbl(bety, "machines") %>% + dplyr::filter(!is.na(sync_host_id)) %>% + dplyr::filter(sync_url != "" || allow_no_url) %>% + dplyr::arrange(sync_host_id) %>% + dplyr::select(hostname, sync_host_id, sync_url, sync_start, sync_end) %>% + dplyr::collect() %>% + dplyr::mutate(ip = unlist(lapply(hostname, function(x) { + if (x %in% names(host_mapping)) { + ip <- nsl(host_mapping[[x]]) + } else { + ip <- nsl(x) + } + ifelse(is.null(ip), NA, ip) + }))) %>% + dplyr::mutate(version = NA, lastdump = NA, migrations = NA) %>% + dplyr::filter(!is.na(ip)) %>% + dplyr::arrange(ip) + + # close connection + DBI::dbDisconnect(bety) + + # convert ip address to geo location + lapply(servers$ip, get_geoip) + locations <- geoip %>% + dplyr::filter(ip %in% servers$ip) %>% + dplyr::arrange(ip) %>% + dplyr::select("city", "country", "latitude", "longitude") + + # combine tables + servers <- cbind(servers, locations) + + # add columns for all sync_ids + servers[, paste0("server_", servers$sync_host_id)] <- NA + + # return servers + servers %>% dplyr::arrange(sync_host_id) +} + +# fetch information from the actual servers +check_servers <- function(servers, progress) { + check_servers <- servers$sync_url[! servers$sync_host_id %in% ignored_servers] + + # generic failure message to increment progress + failure <- function(res) { + print(res) + progress$inc(amount = 1) + } + + # version information + server_version <- function(res) { + url <- sub("version.txt", "bety.tar.gz", res$url) + progress$inc(amount = 0, message = paste("Processing", progress$getValue(), "of", progress$getMax())) + print(paste(res$status, url)) + if (res$status == 200 || res$status == 226) { + check_servers <<- check_servers[check_servers != url] + version <- strsplit(rawToChar(res$content), '\t', fixed = TRUE)[[1]] + if (!is.na(as.numeric(version[1]))) { + servers[servers$sync_url == url,'version'] <<- version[2] + servers[servers$sync_url == url,'lastdump'] <<- version[4] + servers[servers$sync_url == url,'migrations'] <<- version[1] + } else { + servers[servers$sync_url == url,'version'] <<- NA + servers[servers$sync_url == url,'lastdump'] <<- NA + servers[servers$sync_url == url,'migrations'] <<- NA + } + } + progress$inc(amount = 1) + } + urls <- sapply(check_servers, function(x) { sub("bety.tar.gz", "version.txt", x) }) + lapply(urls, function(x) { curl::curl_fetch_multi(x, done = server_version, fail = failure) } ) + + # log information + server_log <- function(res) { + url <- sub("sync.log", "bety.tar.gz", res$url) + progress$inc(amount = 0, message = paste("Processing", progress$getValue(), "of", progress$getMax())) + print(paste(res$status, url)) + if (res$status == 200 || res$status == 226) { + lines <- strsplit(rawToChar(res$content), '\n', fixed = TRUE)[[1]] + now <- as.POSIXlt(Sys.time(), tz="UTC") + for (line in tail(lines, maxlines)) { + pieces <- strsplit(trimws(line), ' ', fixed=TRUE)[[1]] + if (length(pieces) == 8) { + if (pieces[8] == 0) { + when <- strptime(paste(pieces[1:6], collapse = " "), format="%a %b %d %T UTC %Y", tz="UTC") + tdiff <- min(maxtime, difftime(now, when, units = "hours")) + servers[servers$sync_url == url, paste0('server_', pieces[7])] <<- tdiff + } + } else { + print(line) + } + } + } + progress$inc(amount = 1) + } + urls <- sapply(check_servers, function(x) { sub("bety.tar.gz", "sync.log", x) }) + lapply(urls, function(x) { curl::curl_fetch_multi(x, done = server_log, fail = failure) } ) + + # run queries in parallel + curl::multi_run() + ignored_servers <<- c(ignored_servers, servers[servers$sync_url %in% check_servers, "sync_host_id"]) + + return(servers) +} + +# return vector to use in polylines +check_sync <- function(servers) { + ids <- servers$sync_host_id + + # helper function to see if two servers are connected + connected <- function(src, dst) { + v <- servers[servers$sync_host_id==src, paste0("server_", dst)] + !is.null(v) && !is.na(v) + } + + # build up list of all connections + lat <- c() + lon <- c() + tdiff <- c() + + for (src in ids) { + src_x <- servers[servers$sync_host_id==src, 'longitude'] + src_y <- servers[servers$sync_host_id==src, 'latitude'] + for (dst in ids) { + if (connected(src, dst)) { + tdiff <- c(tdiff, servers[servers$sync_host_id==src, paste0("server_", dst)]) + + dst_x <- servers[servers$sync_host_id==dst, 'longitude'] + lon <- c(lon, c(src_x, (src_x + (dst_x - src_x) / 2), NA)) + + dst_y <- servers[servers$sync_host_id==dst, 'latitude'] + lat <- c(lat, c(src_y, (src_y + (dst_y - src_y) / 2), NA)) + } + } + } + + # need to have at least one polyline, will draw a line from server 1 to server 1 + if (length(tdiff) == 0) { + src_x <- servers[1, 'longitude'] + src_y <- servers[1, 'latitude'] + return(list(latitude=c(src_y, src_y, NA), longitude=c(src_x, src_x, NA), value=c(0))) + } else { + return(list(latitude=lat, longitude=lon, value=tdiff)) + } +} + +# Define UI for application that draws a histogram +ui <- fluidPage( + singleton(tags$head(HTML( + ' + + ' + ))), + + # Application title + titlePanel("PEcAn DB Sync"), + + # Map with sites + leaflet::leafletOutput("map"), + + # data table + DT::dataTableOutput("table"), + + # Refresh button + actionButton("refresh_servers", "Update Servers"), + actionButton("refresh_sync", "Update Sync") +) + +# Define server logic required to draw map +server <- function(input, output, session) { + # red -> green color spectrum + colors <- leaflet::colorBin("RdYlGn", domain = c(0, maxtime), bins = maxbins, na.color = "purple", reverse = TRUE) + + # servers is what is changed, start with just data from database + servers <- get_servers() + values <- reactiveValues(servers=servers, + sync=check_sync(servers)) + + # update server list (quick) + observeEvent(input$refresh_servers, { + session$sendCustomMessage("disableUI", "") + values$servers <- get_servers() + session$sendCustomMessage("enableUI", "") + }) + + # update sync list (slow) + observeEvent(input$refresh_sync, { + servers <- values$servers + session$sendCustomMessage("disableUI", "") + progress <- Progress$new(session, min=0, max=2*(nrow(servers)-length(ignored_servers))) + servers <- check_servers(servers, progress) + sync <- check_sync(servers) + progress$close() + session$sendCustomMessage("enableUI", "") + values$servers <- servers + values$sync <- sync + }) + + # create a map of all servers that have a sync_host_id and sync_url + output$map <- renderLeaflet({ + leaflet(values$servers) %>% + addProviderTiles(providers$Stamen.TonerLite, + options = providerTileOptions(noWrap = TRUE) + ) %>% + addMarkers(~longitude, ~latitude, + label = ~htmltools::htmlEscape(hostname), + clusterOptions = markerClusterOptions(maxClusterRadius = 1)) %>% + addPolylines(~longitude, ~latitude, + color = colors(values$sync$value), data=values$sync) %>% + addLegend("bottomright", colors, values$sync$value, + title = "since last sync", labFormat = labelFormat(suffix =" hours")) + }) + + # create a table of all servers that have a sync_host_id and sync_url + output$table <- DT::renderDataTable({ + ignored <- rep("gray", length(ignored_servers) + 1) + DT::datatable(values$servers %>% + dplyr::select("sync_host_id", "hostname", "city", "country", "lastdump", "migrations"), + rownames = FALSE) %>% + DT::formatStyle('sync_host_id', target = "row", color = DT::styleEqual(c(ignored_servers, "-1"), ignored)) + }) +} + +# Run the application +shinyApp(ui = ui, server = server) diff --git a/shiny/dbsync/geoip.json b/shiny/dbsync/geoip.json new file mode 100644 index 00000000000..3632da7f652 --- /dev/null +++ b/shiny/dbsync/geoip.json @@ -0,0 +1 @@ +[{"ip":"128.174.124.54","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Illinois","city":"Urbana","latitude":40.1106,"longitude":-88.2073,"asn":"AS38","org":"University of Illinois","isp":"University of Illinois","timezone":"America/Chicago","timezone_name":"Central Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-21600,"timezone_gmt":"GMT -6:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":92},{"ip":"128.197.168.114","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Massachusetts","city":"Boston","latitude":42.3601,"longitude":-71.0589,"asn":"AS111","org":"Boston University","isp":"Boston University","timezone":"America/New_York","timezone_name":"Eastern Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-18000,"timezone_gmt":"GMT -5:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":92},{"ip":"130.199.3.21","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"New York","city":"Bellport","latitude":40.757,"longitude":-72.9393,"asn":"AS43","org":"Brookhaven National Laboratory","isp":"Brookhaven National Laboratory","timezone":"America/New_York","timezone_name":"Eastern Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-18000,"timezone_gmt":"GMT -5:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":92},{"ip":"144.92.131.21","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Wisconsin","city":"Madison","latitude":43.0731,"longitude":-89.4012,"asn":"AS59","org":"University of Wisconsin Madison","isp":"University of Wisconsin Madison","timezone":"America/Chicago","timezone_name":"Central Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-21600,"timezone_gmt":"GMT -6:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":92},{"ip":"141.142.227.158","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Illinois","city":"Urbana","latitude":40.1106,"longitude":-88.2073,"asn":"AS1224","org":"National Center Supercomputing Applications","isp":"National Center for Supercomputing Applications","timezone":"America/Chicago","timezone_name":"Central Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-21600,"timezone_gmt":"GMT -6:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":92},{"ip":"128.174.124.40","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Illinois","city":"Urbana","latitude":40.1106,"longitude":-88.2073,"asn":"AS38","org":"University of Illinois","isp":"University of Illinois","timezone":"America/Chicago","timezone_name":"Central Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-21600,"timezone_gmt":"GMT -6:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":92},{"ip":"128.196.65.37","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Arizona","city":"Tucson","latitude":32.2217,"longitude":-110.9265,"asn":"AS1706","org":"University of Arizona","isp":"University of Arizona","timezone":"America/Phoenix","timezone_name":"Mountain Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-25200,"timezone_gmt":"GMT -7:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":92},{"ip":"193.166.223.38","success":true,"type":"IPv4","continent":"Europe","country":"Finland","country_code":"FI","country_flag":"https://cdn.ipwhois.io/flags/fi.svg","country_capital":"Helsinki","country_phone":358,"country_neighbours":"NO,RU,SE","region":"Uusimaa","city":"Helsinki","latitude":60.1699,"longitude":24.9384,"asn":"AS1741","org":"FUNET","isp":"CSC - Tieteen tietotekniikan keskus Oy","timezone":"Europe/Helsinki","timezone_name":"Eastern European Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":7200,"timezone_gmt":"GMT +2:00","currency":"Euro","currency_code":"EUR","currency_symbol":"€","currency_rates":0.9195,"currency_plural":"euros","completed_requests":92,"continent_code":"EU"},{"ip":"128.210.26.15","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Indiana","city":"West Lafayette","latitude":40.4259,"longitude":-86.9081,"asn":"AS17","org":"Purdue University","isp":"Purdue University","timezone":"America/New_York","timezone_name":"Eastern Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-18000,"timezone_gmt":"GMT -5:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":100},{"ip":"141.142.227.159","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Illinois","city":"Urbana","latitude":40.1106,"longitude":-88.2073,"asn":"AS1224","org":"National Center Supercomputing Applications","isp":"National Center for Supercomputing Applications","timezone":"America/Chicago","timezone_name":"Central Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-21600,"timezone_gmt":"GMT -6:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":100},{"ip":"130.127.204.30","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"South Carolina","city":"Clemson","latitude":34.6834,"longitude":-82.8374,"asn":"AS12148","org":"Clemson University","isp":"Clemson University","timezone":"America/New_York","timezone_name":"Eastern Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-18000,"timezone_gmt":"GMT -5:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":103},{"ip":"131.243.130.42","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"California","city":"Berkeley","latitude":37.8716,"longitude":-122.2727,"asn":"AS16","org":"Lawrence Berkeley National Laboratory","isp":"Lawrence Berkeley National Laboratory","timezone":"America/Los_Angeles","timezone_name":"Pacific Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-28800,"timezone_gmt":"GMT -8:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":103},{"ip":"128.46.104.5","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Indiana","city":"West Lafayette","latitude":40.4259,"longitude":-86.9081,"asn":"AS17","org":"Purdue University","isp":"Purdue University","timezone":"America/New_York","timezone_name":"Eastern Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-18000,"timezone_gmt":"GMT -5:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":105},{"ip":"54.85.105.29","success":true,"type":"IPv4","continent":"North America","country":"United States","country_code":"US","country_flag":"https://cdn.ipwhois.io/flags/us.svg","country_capital":"Washington","country_phone":1,"country_neighbours":"CA,MX,CU","region":"Virginia","city":"Ashburn","latitude":39.0438,"longitude":-77.4874,"asn":"AS14618","org":"Amazon.com, Inc.","isp":"Amazon.com, Inc.","timezone":"America/New_York","timezone_name":"Eastern Standard Time","timezone_dstOffset":0,"timezone_gmtOffset":-18000,"timezone_gmt":"GMT -5:00","currency":"US Dollar","currency_code":"USD","currency_symbol":"$","currency_rates":1,"currency_plural":"US dollars","completed_requests":105}] diff --git a/shiny/dbsync/save-env-shiny.sh b/shiny/dbsync/save-env-shiny.sh new file mode 100755 index 00000000000..d681b66d457 --- /dev/null +++ b/shiny/dbsync/save-env-shiny.sh @@ -0,0 +1,8 @@ +#!/bin/sh + +# save env +env > /home/shiny/.Renviron +chown shiny.shiny /home/shiny/.Renviron + +# start shiny server +/usr/bin/shiny-server.sh diff --git a/shiny/global-sensitivity/DESCRIPTION b/shiny/global-sensitivity/DESCRIPTION index c5c3c1bfbbf..614542e2d03 100644 --- a/shiny/global-sensitivity/DESCRIPTION +++ b/shiny/global-sensitivity/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Global sensitivity analysis -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Author: Alexey Shiklomanov AuthorUrl: http://ashiklom.github.io Tags: PEcAn diff --git a/shiny/workflowPlot/DESCRIPTION b/shiny/workflowPlot/DESCRIPTION index 0a8328ec6fb..1706a85b67f 100644 --- a/shiny/workflowPlot/DESCRIPTION +++ b/shiny/workflowPlot/DESCRIPTION @@ -1,6 +1,6 @@ Type: Shiny Title: Workflow Output -License: FreeBSD + file LICENSE +License: BSD_3_clause + file LICENSE Author: Rob Kooper AuthorUrl: http://www.ncsa.illinois.edu/assets/php/directory/contact.php?contact=kooper Tags: PEcAn diff --git a/shiny/workflowPlot/helper.R b/shiny/workflowPlot/helper.R index 7115f781bca..dc23e4656ac 100644 --- a/shiny/workflowPlot/helper.R +++ b/shiny/workflowPlot/helper.R @@ -2,7 +2,7 @@ checkAndDownload<-function(packageNames) { for(packageName in packageNames) { if(!isInstalled(packageName)) { - install.packages(packageName,repos="http://lib.stat.cmu.edu/R/CRAN") + install.packages(packageName) } library(packageName,character.only=TRUE,quietly=TRUE,verbose=FALSE) } diff --git a/shiny/workflowPlot/markdown/app_documentation.Rmd b/shiny/workflowPlot/markdown/app_documentation.Rmd new file mode 100644 index 00000000000..f83bf101ba3 --- /dev/null +++ b/shiny/workflowPlot/markdown/app_documentation.Rmd @@ -0,0 +1,16 @@ +--- +title: "app domumentation" +output: + html_document: + theme: united +--- + +This is the shiny app for: + +- Visualizing model output data alongside external data +- Registering Reference Runs +- Calculating Benchmarks + +Do you have ideas for new features? + +[Add your comments here!](https://github.com/PecanProject/pecan/issues/1894) diff --git a/shiny/workflowPlot/markdown/benchmarking_plots.Rmd b/shiny/workflowPlot/markdown/benchmarking_plots.Rmd new file mode 100644 index 00000000000..316e5cebc63 --- /dev/null +++ b/shiny/workflowPlot/markdown/benchmarking_plots.Rmd @@ -0,0 +1,8 @@ +--- +title: "Documentation for the Visualization and Benchmarking Shiny App" +output: + html_document: + theme: united +--- + +More interactive ploty plots! diff --git a/shiny/workflowPlot/markdown/benchmarking_scores.Rmd b/shiny/workflowPlot/markdown/benchmarking_scores.Rmd new file mode 100644 index 00000000000..fc9eb818cf2 --- /dev/null +++ b/shiny/workflowPlot/markdown/benchmarking_scores.Rmd @@ -0,0 +1,10 @@ +--- +title: "Documentation for the Visualization and Benchmarking Shiny App" +output: + html_document: + theme: united +--- + +A table of all outputs of the selected metrics. +- For numerical metrics, the score is printed. +- For visual metrics, the path to the PDF is printed. Eventually it might be nice to have a download button. For now, you can navigate back to rstudio and download from there. diff --git a/shiny/workflowPlot/markdown/benchmarking_setting.Rmd b/shiny/workflowPlot/markdown/benchmarking_setting.Rmd new file mode 100644 index 00000000000..2ece16a2007 --- /dev/null +++ b/shiny/workflowPlot/markdown/benchmarking_setting.Rmd @@ -0,0 +1,34 @@ +--- +title: "Documentation for the Visualization and Benchmarking Shiny App" +output: + html_document: + theme: united +--- + +[See additional documentation on benchmarking](https://pecanproject.github.io/pecan-documentation/develop/intermediate-user.html#benchmarking) + + +All benchmarks that are calcualted are automatcally registered in to the database. + +#### Setup Reference Run + +You need to register a run before performing benchmarks. + +[See documentation on reference runs](https://pecanproject.github.io/pecan-documentation/develop/reference-runs.html) + +#### Setup Benchmarks + +**Variables** + +These are the variables that the model and data have in common. + +**Metrics** + +Warning: Don't use Frechet for large datasets, it is not efficient at all. I should probably remove it if data dimensions are too large. + +**Plots** + +These plots will be saved as PDFs in the model output directory. You can also load them interactively in Benchmarking > Plots. + + + diff --git a/shiny/workflowPlot/markdown/exploratory_plot.Rmd b/shiny/workflowPlot/markdown/exploratory_plot.Rmd new file mode 100644 index 00000000000..bc41125a732 --- /dev/null +++ b/shiny/workflowPlot/markdown/exploratory_plot.Rmd @@ -0,0 +1,26 @@ +--- +title: "Documentation for the Visualization and Benchmarking Shiny App" +output: + html_document: + theme: united +--- + +All our plots are made with [plotly](https://plot.ly/) and [Highcharter](http://jkunst.com/highcharter/). + +They are interactive and packed full of features. All plotly plots have a toolbar with the following features: + +![](plotly_bar.png) + +- Download plot as a png +- Zoom +- Pan +- Box select +- Lasso select +- Zoom in +- Zoom out +- Autoscale +- Reset axes +- Toggle spike lines +- Show closest data on hover +- Compare data on hover +- Collaborate diff --git a/shiny/workflowPlot/markdown/setup_page.Rmd b/shiny/workflowPlot/markdown/setup_page.Rmd new file mode 100644 index 00000000000..6ee4c24e12e --- /dev/null +++ b/shiny/workflowPlot/markdown/setup_page.Rmd @@ -0,0 +1,8 @@ +--- +title: "setup_page" +output: + html_document: + theme: united +--- + +For now this is just a place to see some information about the run you just loaded. diff --git a/shiny/workflowPlot/server.R b/shiny/workflowPlot/server.R index 75e4bdc002e..1254dce87bf 100644 --- a/shiny/workflowPlot/server.R +++ b/shiny/workflowPlot/server.R @@ -11,16 +11,22 @@ lapply(c("PEcAn.visualization", # Shiny and plotting packages lapply(c( "shiny", - "ggplot2", "plotly", + "highcharter", "shinyjs", "dplyr", - "reshape2", + "plyr", + "stringr", + "XML", + "xts", "purrr", - "ncdf4", - "scales", "lubridate", - "shinythemes" + "listviewer", + "shinythemes", + "shinytoastr", + "shinyFiles", + "data.table", + "shinyWidgets" ),function(pkg){ if (!(pkg %in% installed.packages()[,1])){ install.packages(pkg) @@ -33,10 +39,64 @@ lapply(c( "shiny", # Maximum size of file allowed to be uploaded: 100MB options(shiny.maxRequestSize=100*1024^2) +# Port forwarding +# options(shiny.port = 6438) +# options(shiny.launch.browser = 'FALSE') + # Define server logic server <- shinyServer(function(input, output, session) { - bety <- betyConnect() + + dbConnect <- reactiveValues(bety = NULL) + + # Try `betyConnect` function. + # If it breaks, ask user to enter user, password and host information + # then use the `db.open` function to connect to the database + tryCatch({ + #dbConnect$bety <- betyConnect() + #For betyConnect to break to test shiny modal + dbConnect$bety <- betyConnect(".") + }, + error = function(e){ + + #---- shiny modal---- + showModal( + modalDialog( + title = "Connect to Database", + fluidRow(column(12,textInput('user', h4('User:'), width = "100%", value = "bety"))), + fluidRow(column(12,textInput('password', h4('Password:'), width = "100%", value = "bety"))), + fluidRow(column(12,textInput('host', h4('Host:'), width = "100%", value = "psql-pecan.bu.edu"))), + fluidRow( + column(3), + column(6,br(),actionButton('submitInfo', 'Submit', width = "100%", class="btn-primary")), + column(3) + ), + footer = NULL, + size = 's' + ) + ) + + # --- connect to database --- + observeEvent(input$submitInfo,{ + tryCatch({ + + dbConnect$bety <- dplyr::src_postgres(dbname ='bety' , + host =input$host, user = input$user, + password = input$password) + # For testing reactivity of bety connection + #dbConnect$bety <- betyConnect() + + removeModal() + toastr_success("Connect to Database") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + } + ) + }) + }) + + # Hiding the animation and showing the application content hide(id = "loading-content", anim = TRUE, animType = "fade") showElement("app") @@ -49,12 +109,16 @@ server <- shinyServer(function(input, output, session) { # Page 1: Select Data source("server_files/select_data_server.R", local = TRUE) + + # Page 2: History Runs + source("server_files/history_server.R", local = TRUE) - # Page 2: Exploratory Plots + # Page 3: Exploratory Plots source("server_files/model_plots_server.R", local = TRUE) source("server_files/model_data_plots_server.R", local = TRUE) + source("server_files/pdf_viewer_server.R", local = TRUE) - # Page 3: Benchmarking + # Page 4: Benchmarking observeEvent(input$load_model,{ req(input$all_run_id) ids_DF <- parse_ids_from_input_runID(input$all_run_id) diff --git a/shiny/workflowPlot/server_files/benchmarking_server.R b/shiny/workflowPlot/server_files/benchmarking_server.R index 6e8e3204c61..403ea35626d 100644 --- a/shiny/workflowPlot/server_files/benchmarking_server.R +++ b/shiny/workflowPlot/server_files/benchmarking_server.R @@ -8,52 +8,72 @@ bm <- reactiveValues() ## as a reference run. If not, create the record upon button click observeEvent(input$load_model,{ - req(input$all_run_id) - ids_DF <- parse_ids_from_input_runID(input$all_run_id) - button <- FALSE - if(nrow(ids_DF) == 1){ - - # Check to see if the run has been saved as a reference run - ens_id <- dplyr::tbl(bety, 'runs') %>% dplyr::filter(id == ids_DF$runID) %>% dplyr::pull(ensemble_id) - ens_wf <- dplyr::tbl(bety, 'ensembles') %>% dplyr::filter(id == ens_id) %>% - dplyr::rename(ensemble_id = id) %>% - dplyr::left_join(.,tbl(bety, "workflows") %>% dplyr::rename(workflow_id = id), by="workflow_id") %>% dplyr::collect() - bm$model_vars <- var_names_all(bety,ids_DF$wID,ids_DF$runID) - - clean <- PEcAn.benchmark::clean_settings_BRR(inputfile = file.path(ens_wf$folder,"pecan.CHECKED.xml")) - settings_xml <- toString(PEcAn.settings::listToXml(clean, "pecan")) - ref_run <- PEcAn.benchmark::check_BRR(settings_xml, bety$con) - - if(length(ref_run) == 0){ - # If not registered, button appears with option to run create.BRR - brr_message <- sprintf("Would you like to save this run (run id = %.0f, ensemble id = %0.f) as a reference run?", ids_DF$runID, ens_id) - button <- TRUE - }else if(dim(ref_run)[1] == 1){ - bm$BRR <- ref_run %>% rename(.,reference_run_id = id) - bm$BRR - brr_message <- sprintf("This run has been registered as a reference run (id = %.0f)", bm$BRR$reference_run_id) - }else if(dim(ref_run)[1] > 1){ # There shouldn't be more than one reference run per run - brr_message <- ("There is more than one reference run in the database for this run. Review for duplicates.") + tryCatch({ + req(input$all_run_id) + ids_DF <- parse_ids_from_input_runID(input$all_run_id) + button <- FALSE + if(nrow(ids_DF) == 1){ + + # Check to see if the run has been saved as a reference run + ens_id <- dplyr::tbl(dbConnect$bety, 'runs') %>% dplyr::filter(id == ids_DF$runID) %>% dplyr::pull(ensemble_id) + ens_wf <- dplyr::tbl(dbConnect$bety, 'ensembles') %>% dplyr::filter(id == ens_id) %>% + dplyr::rename(ensemble_id = id) %>% + dplyr::left_join(.,tbl(dbConnect$bety, "workflows") %>% dplyr::rename(workflow_id = id), by="workflow_id") %>% dplyr::collect() + bm$model_vars <- var_names_all(dbConnect$bety,ids_DF$wID,ids_DF$runID) + + clean <- PEcAn.benchmark::clean_settings_BRR(inputfile = file.path(ens_wf$folder,"pecan.CHECKED.xml")) + settings_xml <- toString(PEcAn.settings::listToXml(clean, "pecan")) + ref_run <- PEcAn.benchmark::check_BRR(settings_xml, dbConnect$bety$con) + + if(length(ref_run) == 0){ + # If not registered, button appears with option to run create.BRR + brr_message <- sprintf("Would you like to save this run (run id = %.0f, ensemble id = %0.f) as a reference run?", ids_DF$runID, ens_id) + button <- TRUE + }else if(dim(ref_run)[1] == 1){ + bm$BRR <- ref_run %>% dplyr::rename(.,reference_run_id = id) + bm$BRR + brr_message <- sprintf("This run has been registered as a reference run (id = %.0f)", bm$BRR$reference_run_id) + }else if(dim(ref_run)[1] > 1){ # There shouldn't be more than one reference run per run + brr_message <- ("There is more than one reference run in the database for this run. Review for duplicates.") + } + }else if(nrow(ids_DF) > 1){ + brr_message <- "Benchmarking currently only works when one run is selected." + }else{ + brr_message <- "Cannot do benchmarking" } - }else if(nrow(ids_DF) > 1){ - brr_message <- "Benchmarking currently only works when one run is selected." - }else{ - brr_message <- "Cannot do benchmarking" - } - - # This is redundant but better for debugging - bm$brr_message <- brr_message - bm$button_BRR <- button - bm$ens_wf <- ens_wf - bm$ready <- 0 + + # This is redundant but better for debugging + bm$brr_message <- brr_message + bm$button_BRR <- button + bm$ens_wf <- ens_wf + bm$ready <- 0 + #Signaling the success of the operation + toastr_success("Check for reference run") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) # When button to register run is clicked, create.BRR is run and the button is removed. observeEvent(input$create_bm,{ - bm$BRR <- PEcAn.benchmark::create_BRR(bm$ens_wf, con = bety$con) - bm$brr_message <- sprintf("This run has been successfully registered as a reference run (id = %.0f)", bm$BRR$reference_run_id) - bm$button_BRR <- FALSE - bm$ready <- bm$ready + 1 + tryCatch({ + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...', + value = 0,{ + bm$BRR <- PEcAn.benchmark::create_BRR(bm$ens_wf, con = dbConnect$bety$con) + incProgress( 10/ 15) + bm$brr_message <- sprintf("This run has been successfully registered as a reference run (id = %.0f)", bm$BRR$reference_run_id) + bm$button_BRR <- FALSE + bm$ready <- bm$ready + 1 + incProgress(5/15) + }) + #Signaling the success of the operation + toastr_success("Registered reference run") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) observeEvent({ @@ -71,25 +91,40 @@ observeEvent({ ## have already been run. In addition, setup and run new benchmarks. observeEvent(input$load_data,{ - req(input$all_input_id) - req(input$all_site_id) - - bm$metrics <- dplyr::tbl(bety,'metrics') %>% dplyr::select(one_of("id","name","description")) %>% collect() - - # Need to write warning message that can only use one input id - bm$input <- getInputs(bety,c(input$all_site_id)) %>% - dplyr::filter(input_selection_list == input$all_input_id) - format <- PEcAn.DB::query.format.vars(bety = bety, input.id = bm$input$input_id) - # Are there more human readable names? - bm$vars <- dplyr::inner_join( - data.frame(read_name = names(bm$model_vars), - pecan_name = bm$model_vars, stringsAsFactors = FALSE), - format$vars[-grep("%",format$vars$storage_type), - c("variable_id", "pecan_name")], - by = "pecan_name") - - #This will be a longer set of conditions - bm$ready <- bm$ready + 1 + tryCatch({ + req(input$all_input_id) + req(input$all_site_id) + + bm$metrics <- dplyr::tbl(dbConnect$bety,'metrics') %>% dplyr::select(one_of("id","name","description")) %>% collect() + + # Need to write warning message that can only use one input id + bm$input <- getInputs(dbConnect$bety,c(input$all_site_id)) %>% + dplyr::filter(input_selection_list == input$all_input_id) + format <- PEcAn.DB::query.format.vars(bety = dbConnect$bety, input.id = bm$input$input_id) + + # If format has Null time.row and NAs for var$column_number, skip loading + if(is.null(format$time.row) & is.na(format$var$column_number)){ + print("File_format has Null time.row and NAs for var$column_number, skip loading") + toastr_warning("This file format cannot do benchmarking") + }else{ + # Are there more human readable names? + bm$vars <- dplyr::inner_join( + data.frame(read_name = names(bm$model_vars), + pecan_name = bm$model_vars, stringsAsFactors = FALSE), + format$vars[-grep("%",format$vars$storage_type), + c("variable_id", "pecan_name")], + #format$vars[c("variable_id", "pecan_name")], #for AmeriFlux.level2.h.nc, format$vars$storage_type is NA + by = "pecan_name") + + #This will be a longer set of conditions + bm$ready <- bm$ready + 1 + #Signaling the success of the operation + toastr_success("Check for benchmarks") + } + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) observeEvent(bm$ready,{ @@ -127,44 +162,54 @@ observeEvent({ plot_ind <- grep("_plot",bm$metrics$name) + variable_choices <- bm$vars$variable_id + names(variable_choices) <- bm$vars$read_name + metrics_choices <- bm$metrics$id[-plot_ind] + names(metrics_choices) <- bm$metrics$description[-plot_ind] + plot_choices <- bm$metrics$id[plot_ind] + names(plot_choices) <- bm$metrics$description[plot_ind] + output$bm_inputs <- renderUI({ if(bm$ready > 0){ - list( - column(4, wellPanel( - checkboxGroupInput("vars", label = "Variables", - choiceNames = bm$vars$read_name, - choiceValues = bm$vars$variable_id), - # actionButton("selectall.var","Select /Deselect all variables"), - label=h3("Label") - )), - column(4, wellPanel( - checkboxGroupInput("metrics", label = "Numerical Metrics", - choiceNames = bm$metrics$description[-plot_ind], - choiceValues = bm$metrics$id[-plot_ind]), - # actionButton("selectall.num","Select/Deselect all numerical metrics") , - label=h3("Label") - )), - column(4, wellPanel( - checkboxGroupInput("plots", label = "Plot Metrics", - choiceNames = bm$metrics$description[plot_ind], - choiceValues = bm$metrics$id[plot_ind]), - # actionButton("selectall.plot","Select/Deselect all plot metrics"), - label=h3("Label") - )) - # column(4, wellPanel( - # textInput("start_year", label = "Benchmarking Start Year", - # value = "don't use this"), - # label=h3("Label") - # )), - # column(4, wellPanel( - # textInput("end_year", label = "Benchmarking End Year", - # value = "don't use this"), - # label=h3("Label") - # )) + wellPanel( + fluidRow( + column(4, + pickerInput("vars", "Variables", + choices = variable_choices, + multiple = TRUE, + options = list(`actions-box` = TRUE, `dropup-auto` = FALSE)) + ), + column(4, + pickerInput("metrics", "Numerical Metrics", + choices = metrics_choices, + multiple = TRUE, + options = list(`actions-box` = TRUE, `dropup-auto` = FALSE)) + ), + column(4, + pickerInput("plots", "Plot Metrics", + choices = plot_choices, + multiple = TRUE, + options = list(`actions-box` = TRUE, `dropup-auto` = FALSE)) + ) + ) + ) + } + }) + + output$calc_bm <- renderUI({ + if(bm$ready > 0){ + fluidRow( + column(5), + column(2, + shinyjs::disabled( + actionButton('calc_bm_button', "Calculate", icon = icon("calculator"), + width = "100%", class="btn-primary") + ) + ), + column(5) ) } }) - if(bm$ready > 0){bm$calc_bm_message <- sprintf("Please select at least one variable and one metric")} }) observeEvent({ @@ -176,9 +221,9 @@ observeEvent({ n <- ifelse(is.null(input$metrics),0,length(input$metrics)) p <- ifelse(is.null(input$plots),0,length(input$plots)) m <- n + p - output$report <- renderText(sprintf("Number of vars: %0.f, Number of metrics: %0.f", v,m)) + #output$report <- renderText(sprintf("Number of vars: %0.f, Number of metrics: %0.f", v,m)) if(v > 0 & m > 0){ - output$calc_bm_button <- renderUI({actionButton("calc_bm", "Calculate Benchmarks")}) + shinyjs::enable("calc_bm_button") bm$bm_vars <- input$vars bm$bm_metrics <- c() if(n > 0) bm$bm_metrics <- c(bm$bm_metrics, input$metrics) @@ -187,93 +232,136 @@ observeEvent({ }, ignoreNULL = FALSE) -observeEvent(input$calc_bm,{ - req(input$all_input_id) - req(input$all_site_id) - bm$calc_bm_message <- sprintf("Setting up benchmarks") - output$reportvars <- renderText(paste(bm$bm_vars, seq_along(bm$bm_vars))) - output$reportmetrics <- renderText(paste(bm$bm_metrics)) - - inputs_df <- getInputs(bety,c(input$all_site_id)) %>% - dplyr::filter(input_selection_list == input$all_input_id) - output$inputs_df_table <- renderTable(inputs_df) - - config.list <- PEcAn.utils::read_web_config("../../web/config.php") - output$config_list_table <- renderTable(as.data.frame.list(config.list)) - - bm$bm_settings$info <- list(userid = 1000000003) # This is my user id. I have no idea how to get people to log in to their accounts through the web interface and right now the benchmarking code has sections dependent on user id - I will fix this. - bm$bm_settings$database <- list( - bety = list( - user = config.list$db_bety_username, - password = config.list$db_bety_password, - host = config.list$db_bety_hostname, - dbname = config.list$db_bety_database, - driver = config.list$db_bety_type, - write = TRUE - ), - dbfiles = config.list$dbfiles_folder - ) - bm$bm_settings$benchmarking <- list( - ensemble_id = bm$ens_wf$ensemble_id, - new_run = FALSE - ) - - for(i in seq_along(bm$bm_vars)){ - benchmark <- list( - input_id = inputs_df$input_id, - variable_id = bm$bm_vars[i], - site_id = inputs_df$site_id, - metrics = list() - ) - for(j in seq_along(bm$bm_metrics)){ - benchmark$metrics = append(benchmark$metrics, list(metric_id = bm$bm_metrics[j])) - } - bm$bm_settings$benchmarking <- append(bm$bm_settings$benchmarking,list(benchmark = benchmark)) - } - - # output$calc_bm_button <- renderUI({}) - output$print_bm_settings <- renderPrint(bm$bm_settings) - - basePath <- dplyr::tbl(bety, 'workflows') %>% dplyr::filter(id %in% bm$ens_wf$workflow_id) %>% dplyr::pull(folder) - - settings_path <- file.path(basePath, "pecan.BENCH.xml") - saveXML(PEcAn.settings::listToXml(bm$bm_settings,"pecan"), file = settings_path) - bm$settings_path <- settings_path - - bm$calc_bm_message <- sprintf("Benchmarking settings have been saved here: %s", bm$settings_path) - - ############################################################################## - # Run the benchmarking functions - # The following seven functions are essentially - # "the benchmarking workflow" in its entirety - - settings <- PEcAn.settings::read.settings(bm$settings_path) - bm.settings <- PEcAn.benchmark::define_benchmark(settings,bety) - settings <- PEcAn.benchmark::add_workflow_info(settings,bety) +observeEvent(input$calc_bm_button,{ + tryCatch({ + req(input$all_input_id) + req(input$all_site_id) + req(input$host) + req(input$user) + req(input$password) + + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...', + value = 0,{ - settings$benchmarking <- PEcAn.benchmark::bm_settings2pecan_settings(bm.settings) - settings <- PEcAn.benchmark::read_settings_BRR(settings) - - # This is a hack to get old runs that don't have the right pecan.CHECKED.xml data working - if(is.null(settings$settings.info)){ - settings$settings.info <- list( - deprecated.settings.fixed = TRUE, - settings.updated = TRUE, - checked = TRUE - ) - } - - settings <- PEcAn.settings::prepare.settings(settings) - settings$host$name <- "localhost" # This may not be the best place to set this, but it isn't set by any of the other functions. Another option is to have it set by the default_hostname function (if input is NULL, set to localhost) - # results <- PEcAn.settings::papply(settings, function(x) calc_benchmark(x, bety, start_year = input$start_year, end_year = input$end_year)) - results <- PEcAn.settings::papply(settings, function(x) - calc_benchmark(settings = x, bety = bety)) - bm$load_results <- bm$load_results + 1 - -}) + inputs_df <- getInputs(dbConnect$bety,c(input$all_site_id)) %>% + dplyr::filter(input_selection_list == input$all_input_id) + output$inputs_df_title <- renderText("Benchmark Input Data") + output$inputs_df_table <- DT::renderDataTable( + DT::datatable(inputs_df, + rownames = FALSE, + options = list( + dom = 't', + scrollX = TRUE, + initComplete = DT::JS( + "function(settings, json) {", + "$(this.api().table().header()).css({'background-color': '#404040', 'color': '#fff'});", + "}"))) + ) + + + # config.list <- PEcAn.utils::read_web_config("../../web/config.php") + # output$config_list_table <- renderTable(as.data.frame.list(config.list)) + + + bm$bm_settings$info <- list(userid = 1000000003) # This is my user id. I have no idea how to get people to log in to their accounts through the web interface and right now the benchmarking code has sections dependent on user id - I will fix this. + # bm$bm_settings$database <- list( + # bety = list( + # user = config.list$db_bety_username, + # password = config.list$db_bety_password, + # host = config.list$db_bety_hostname, + # dbname = config.list$db_bety_database, + # driver = config.list$db_bety_type, + # write = TRUE + # ), + # dbfiles = config.list$dbfiles_folder + # ) + + bm$bm_settings$database <- list( + bety = list( + user = input$user, + password = input$password, + host = input$host, + dbname = "bety", + driver = "pgsql", + write = TRUE + ), + dbfiles = "/home/carya/output/dbfiles" + ) + bm$bm_settings$benchmarking <- list( + ensemble_id = bm$ens_wf$ensemble_id, + new_run = FALSE + ) -observeEvent(bm$calc_bm_message,{ - output$calc_bm_message <- renderText({bm$calc_bm_message}) + + for(i in seq_along(bm$bm_vars)){ + benchmark <- list( + input_id = inputs_df$input_id, + variable_id = bm$bm_vars[i], + site_id = inputs_df$site_id, + metrics = list() + ) + for(j in seq_along(bm$bm_metrics)){ + benchmark$metrics = append(benchmark$metrics, list(metric_id = bm$bm_metrics[j])) + } + bm$bm_settings$benchmarking <- append(bm$bm_settings$benchmarking,list(benchmark = benchmark)) + } + + + disable("calc_bm_button") + output$print_bm_settings <- renderPrint(print(bm$bm_settings)) + + + basePath <- dplyr::tbl(dbConnect$bety, 'workflows') %>% dplyr::filter(id %in% bm$ens_wf$workflow_id) %>% dplyr::pull(folder) + + settings_path <- file.path(basePath, "pecan.BENCH.xml") + saveXML(PEcAn.settings::listToXml(bm$bm_settings,"pecan"), file = settings_path) + bm$settings_path <- settings_path + + output$settings_path <- renderText({ + sprintf("Benchmarking settings have been saved here: %s", bm$settings_path) + }) + incProgress(1/2) + + ############################################################################## + # Run the benchmarking functions + # The following seven functions are essentially + # "the benchmarking workflow" in its entirety + + settings <- PEcAn.settings::read.settings(bm$settings_path) + bm.settings <- PEcAn.benchmark::define_benchmark(settings,dbConnect$bety) + settings <- PEcAn.benchmark::add_workflow_info(settings,dbConnect$bety) + + settings$benchmarking <- PEcAn.benchmark::bm_settings2pecan_settings(bm.settings) + settings <- PEcAn.benchmark::read_settings_BRR(settings) + + # This is a hack to get old runs that don't have the right pecan.CHECKED.xml data working + if(is.null(settings$settings.info)){ + settings$settings.info <- list( + deprecated.settings.fixed = TRUE, + settings.updated = TRUE, + checked = TRUE + ) + } + + settings <- PEcAn.settings::prepare.settings(settings) + settings$host$name <- "localhost" # This may not be the best place to set this, but it isn't set by any of the other functions. Another option is to have it set by the default_hostname function (if input is NULL, set to localhost) + # browser() + #results <-calc_benchmark(settings, bety = dbConnect$bety) + # results <- PEcAn.settings::papply(settings, function(x) calc_benchmark(x, bety, start_year = input$start_year, end_year = input$end_year)) + results <- PEcAn.settings::papply(settings, function(x) + calc_benchmark(settings = x, bety = dbConnect$bety)) + bm$load_results <- bm$load_results + 1 + + incProgress(1/2) + }) + #Signaling the success of the operation + toastr_success("Calculate benchmarks") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) + }) observeEvent(bm$results_message,{ @@ -281,43 +369,107 @@ observeEvent(bm$results_message,{ }) observeEvent(bm$load_results,{ - if(bm$load_results > 0){ - load(file.path(bm$ens_wf$folder,"benchmarking",bm$input$input_id,"benchmarking.output.Rdata")) - bm$bench.results <- result.out$bench.results - bm$aligned.dat <- result.out$aligned.dat - output$results_table <- DT::renderDataTable(DT::datatable(bm$bench.results)) - plots_used <- grep("plot", result.out$bench.results$metric) - if(length(plots_used) > 0){ - plot_list <- apply( - result.out$bench.results[plots_used,c("variable", "metric")], - 1, paste, collapse = " ") - selection <- as.list(as.numeric(names(plot_list))) - names(selection) <- as.vector(plot_list) - output$bm_plots <- renderUI({ - selectInput("bench_plot", "Benchmark Plot", multiple = FALSE, - choices = selection) - }) - } - } + tryCatch({ + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...', + value = 0,{ + if(bm$load_results > 0){ + load(file.path(bm$ens_wf$folder,"benchmarking",bm$input$input_id,"benchmarking.output.Rdata")) + incProgress(1/3) + + bm$bench.results <- result.out$bench.results + bm$aligned.dat <- result.out$aligned.dat + plots_used <- grep("plot", result.out$bench.results$metric) + output$results_df_title <- renderText("Benchmark Scores") + output$results_table <- DT::renderDataTable( + DT::datatable(bm$bench.results[-plots_used,], + rownames = FALSE, + options = list(dom = 'ft', + initComplete = JS( + "function(settings, json) {", + "$(this.api().table().header()).css({'background-color': '#404040', 'color': '#fff'});", + "}") + ))) + incProgress(1/3) + + if(length(plots_used) > 0){ + plot_list <- apply( + result.out$bench.results[plots_used,c("variable", "metric")], + 1, paste, collapse = " ") + selection <- as.list(as.numeric(names(plot_list))) + names(selection) <- as.vector(plot_list) + output$plots_tilte <- renderText("Benchmark Plots") + output$bm_plots <- renderUI({ + selectInput("bench_plot", label = NULL, multiple = FALSE, + choices = selection) + }) + output$plotlybars <- renderUI({ + div( + id = "plot-container", + div( + class = "plotlybars-wrapper", + div( + class = "plotlybars", + div(class = "plotlybars-bar b1"), + div(class = "plotlybars-bar b2"), + div(class = "plotlybars-bar b3"), + div(class = "plotlybars-bar b4"), + div(class = "plotlybars-bar b5"), + div(class = "plotlybars-bar b6"), + div(class = "plotlybars-bar b7") + ), + div(class = "plotlybars-text", + p("Updating the plot. Hold tight!")) + ) + ) + }) + } + incProgress(1/3) + } + incProgress(1) + }) + #Signaling the success of the operation + toastr_success("Calculate Scores") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) observeEvent(input$bench_plot,{ - var <- bm$bench.results[input$bench_plot,"variable"] - metric_dat = bm$aligned.dat[[var]] - names(metric_dat)[grep("[.]m", names(metric_dat))] <- "model" - names(metric_dat)[grep("[.]o", names(metric_dat))] <- "obvs" - names(metric_dat)[grep("posix", names(metric_dat))] <- "time" - fcn <- get(paste0("metric_",bm$bench.results[input$bench_plot,"metric"]), asNamespace("PEcAn.benchmark")) - # fcn <- paste0("metric_",bm$bench.results[input$bench_plot,"metric"]) - args <- list( - metric_dat = metric_dat, - var = var, - filename = NA, - draw.plot = TRUE - ) - p <- do.call(fcn, args) - output$bmPlot <- renderPlotly({ - plotly::ggplotly(p) + tryCatch({ + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...', + value = 0,{ + var <- bm$bench.results[input$bench_plot,"variable"] + metric_dat = bm$aligned.dat[[var]] + names(metric_dat)[grep("[.]m", names(metric_dat))] <- "model" + names(metric_dat)[grep("[.]o", names(metric_dat))] <- "obvs" + names(metric_dat)[grep("posix", names(metric_dat))] <- "time" + incProgress(2 / 15) + + fcn <- get(paste0("metric_",bm$bench.results[input$bench_plot,"metric"]), asNamespace("PEcAn.benchmark")) + # fcn <- paste0("metric_",bm$bench.results[input$bench_plot,"metric"]) + args <- list( + metric_dat = metric_dat, + var = var, + filename = NA, + draw.plot = TRUE + ) + p <- do.call(fcn, args) + incProgress(9 / 15) + + output$bmPlot <- renderPlotly({ + plotly::ggplotly(p)%>% + layout(height = "100%", width = "100%") + }) + incProgress(4 / 15) + }) + #Signaling the success of the operation + toastr_success("Generate Plots") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) }) }) diff --git a/shiny/workflowPlot/server_files/history_server.R b/shiny/workflowPlot/server_files/history_server.R new file mode 100644 index 00000000000..25767dea028 --- /dev/null +++ b/shiny/workflowPlot/server_files/history_server.R @@ -0,0 +1,113 @@ +# db.query query statement +cmd <- paste0("SELECT workflows.id, workflows.folder, workflows.start_date, workflows.end_date, workflows.started_at, workflows.finished_at, attributes.value," , + "CONCAT(coalesce(sites.id, -99), ' / ', coalesce(sites.sitename, ''), ', ', ', ') AS sitename, " , + "CONCAT(coalesce(models.model_name, ''), ' ', coalesce(models.revision, '')) AS modelname, modeltypes.name " , + "FROM workflows " , + "LEFT OUTER JOIN sites on workflows.site_id=sites.id " , + "LEFT OUTER JOIN models on workflows.model_id=models.id " , + "LEFT OUTER JOIN modeltypes on models.modeltype_id=modeltypes.id " , + "LEFT OUTER JOIN attributes ON workflows.id=attributes.container_id AND attributes.container_type='workflows' ") + + +observeEvent(input$workflowclassrand, { + tryCatch({ + history <- PEcAn.DB::db.query(cmd, dbConnect$bety$con) + workflow_id <- strsplit(input$workflowselected, "_")[[1]] + workflow_id <- trimws(workflow_id[2]) + val.jason <- history$value[history$id == workflow_id] + fld <- history$folder[history$id == workflow_id] + + if (!is.na(val.jason)) { + # server and ui for the listviewer + output$jsed <- renderJsonedit({ + jsonedit(jsonlite::fromJSON(val.jason)) + + }) + + showModal(modalDialog( + title = "Details", + tabsetPanel( + tabPanel("Info", br(), + jsoneditOutput("jsed", height = "500px") + )), + easyClose = TRUE, + footer = NULL, + size = 'l' + )) + } + }, + error = function(e){ + toastr_error(title = "Error", conditionMessage(e)) + }) +}) + +observeEvent(input$workflow_explor_classrand, { + tryCatch({ + #history <- PEcAn.DB::db.query(cmd, dbConnect$bety$con) + workflow_id <- strsplit(input$workflows_explor_selected, "_")[[1]] + + workflow_id <- trimws(workflow_id[1]) + + updateSelectizeInput(session, + "all_workflow_id", + choices = c(input$all_workflow_id, workflow_id), + selected = c(input$all_workflow_id, workflow_id)) + + }, + error = function(e){ + toastr_error(title = "Error", conditionMessage(e)) + }) +}) + + +observeEvent(input$submitInfo, { + tryCatch({ + history <- PEcAn.DB::db.query(cmd, dbConnect$bety$con) + output$historyfiles <- DT::renderDT( + DT::datatable(history %>% + dplyr::select(-value, -modelname) %>% + mutate(id = id %>% as.character()) %>% + mutate(id=paste0(""), + Action= paste0('
+ + +
') + + )%>% + dplyr::rename(model=name), + escape = F, + filter = 'top', + selection="none", + style='bootstrap', + rownames = FALSE, + options = list( + autowidth = TRUE, + columnDefs = list(list(width = '90px', targets = -1)), #set column width for action button + dom = 'ftp', + pageLength = 10, + scrollX = FALSE, + scrollCollapse = FALSE, + initComplete = DT::JS( + "function(settings, json) {", + "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});", + "}") + ) + ) + + ) + toastr_success("Generate history runs") + }, + error = function(e) { + toastr_error(title = "Error in History Runs Page", message = "" + #, conditionMessage(e) + ) + }) + +}) diff --git a/shiny/workflowPlot/server_files/model_data_plots_server.R b/shiny/workflowPlot/server_files/model_data_plots_server.R index 97a1f4896b0..03f7f0885b7 100644 --- a/shiny/workflowPlot/server_files/model_data_plots_server.R +++ b/shiny/workflowPlot/server_files/model_data_plots_server.R @@ -1,6 +1,6 @@ -# Renders ggplotly +# Renders highcharter -output$modelDataPlot <- renderPlotly({ +output$modelDataPlot <- renderHighchart({ validate( need(length(input$all_workflow_id) == 1, "Select only ONE workflow ID"), need(length(input$all_run_id) == 1, "Select only ONE run ID"), @@ -9,9 +9,29 @@ output$modelDataPlot <- renderPlotly({ need(length(input$all_input_id) == 1, 'Select only ONE Input ID'), need(input$load_data > 0, 'Select Load External Data') ) - plt <- ggplot(data.frame(x = 0, y = 0), aes(x,y)) + - annotate("text", x = 0, y = 0, label = "You are ready to plot!", - size = 10, color = "grey") + highchart() %>% + hc_add_series(data = c(), showInLegend = F) %>% + hc_xAxis(title = list(text = "Time")) %>% + hc_yAxis(title = list(text = "y")) %>% + hc_title(text = "You are ready to plot!") %>% + hc_add_theme(hc_theme_flat()) +}) + +output$modelDataPlotscatter <- renderHighchart({ + validate( + need(length(input$all_workflow_id) == 1, "Select only ONE workflow ID"), + need(length(input$all_run_id) == 1, "Select only ONE run ID"), + need(input$load_model > 0, 'Select Load Data'), + need(length(input$all_site_id) == 1, 'Select only ONE Site ID'), + need(length(input$all_input_id) == 1, 'Select only ONE Input ID'), + need(input$load_data > 0, 'Select Load External Data') + ) + highchart() %>% + hc_add_series(data = c(), showInLegend = F) %>% + hc_xAxis(title = list(text = "Time")) %>% + hc_yAxis(title = list(text = "y")) %>% + hc_title(text = "You are ready to plot!") %>% + hc_add_theme(hc_theme_flat()) }) # Update units every time a variable is selected @@ -36,105 +56,159 @@ observeEvent(input$units_modeldata,{ } }) +# update date range input limit +observe({ + df <- load.model() + updateDateRangeInput(session, "date_range2", + start = as.Date(min(df$dates)), + end = as.Date(max(df$dates)), + min = as.Date(min(df$dates)), + max = as.Date(max(df$dates)) + ) +}) +# update "function" select box choice according to "agrregation" select box +observe({ + if(input$agg2 == "NONE"){ + updateSelectInput(session, "func2", choices = "NONE") + }else{ + updateSelectInput(session, "func2", choices = c("mean", "sum")) + } +}) observeEvent(input$ex_plot_modeldata,{ - - output$modelDataPlot <- renderPlotly({ - input$ex_plot_modeldata - isolate({ - - var = input$var_name_modeldata - - model_data <- dplyr::filter(load.model(), var_name == var) - - updateSliderInput(session,"smooth_n_modeldata", min = 0, max = nrow(model_data)) - title <- unique(model_data$title) - xlab <- unique(model_data$xlab) - ylab <- unique(model_data$ylab) - - model_data <- model_data %>% dplyr::select(posix = dates, !!var := vals) - external_data <- load.model.data() - aligned_data = PEcAn.benchmark::align_data( - model.calc = model_data, obvs.calc = external_data, - var = var, align_method = "mean_over_larger_timestep") %>% - dplyr::select(everything(), - model = matches("[.]m"), - observations = matches("[.]o"), - Date = posix) - - print(head(aligned_data)) - # Melt dataframe to plot two types of columns together - aligned_data <- tidyr::gather(aligned_data, variable, value, -Date) - - unit <- ylab - if(input$units_modeldata != unit & udunits2::ud.are.convertible(unit, input$units_modeldata)){ - aligned_data$value <- udunits2::ud.convert(aligned_data$value,unit,input$units_modeldata) - ylab <- input$units_modeldata - } - - - data_geom <- switch(input$plotType_modeldata, point = geom_point, line = geom_line) - - plt <- ggplot(aligned_data, aes(x=Date, y=value, color=variable)) - plt <- plt + data_geom() - plt <- plt + labs(title=title, x=xlab, y=ylab) - plt <- plt + geom_smooth(n=input$smooth_n_modeldata) - ply <- ggplotly(plt) - - - }) - }) - output$modelDataPlotStatic <- renderPlotly({ + output$modelDataPlot <- renderHighchart({ input$ex_plot_modeldata isolate({ - - var = input$var_name_modeldata - - model_data <- dplyr::filter(load.model(), var_name == var) - - updateSliderInput(session,"smooth_n_modeldata", min = 0, max = nrow(model_data)) - title <- unique(model_data$title) - xlab <- unique(model_data$xlab) - ylab <- unique(model_data$ylab) - - model_data <- model_data %>% dplyr::select(posix = dates, !!var := vals) - external_data <- load.model.data() - aligned_data = PEcAn.benchmark::align_data( - model.calc = model_data, obvs.calc = external_data, - var = var, align_method = "mean_over_larger_timestep") %>% - dplyr::select(everything(), - model = matches("[.]m"), - observations = matches("[.]o"), - Date = posix) - - print(head(aligned_data)) - # Melt dataframe to plot two types of columns together - aligned_data <- tidyr::gather(aligned_data, variable, value, -Date) - - unit <- ylab - if(input$units_modeldata != unit & udunits2::ud.are.convertible(unit, input$units_modeldata)){ - aligned_data$value <- udunits2::ud.convert(aligned_data$value,unit,input$units_modeldata) - ylab <- input$units_modeldata - } - - - data_geom <- switch(input$plotType_modeldata, point = geom_point, line = geom_line) - - plt <- ggplot(aligned_data, aes(x=Date, y=value, color=variable)) - plt <- plt + data_geom() - plt <- plt + labs(title=title, x=xlab, y=ylab) - plt <- plt + geom_smooth(n=input$smooth_n_modeldata) - ply <- ggplotly(plt) - ply <- plotly::config(ply, collaborate = F, doubleClick = F, displayModeBar = F, staticPlot = T) + tryCatch({ + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...',{ + + var = input$var_name_modeldata + + model_data <- dplyr::filter(load.model(), var_name == var) + + #updateSliderInput(session,"smooth_n_modeldata", min = 0, max = nrow(model_data)) + title <- unique(model_data$title) + xlab <- unique(model_data$xlab) + ylab <- unique(model_data$ylab) + + model_data <- model_data %>% dplyr::select(posix = dates, !!var := vals) + external_data <- load.model.data() + aligned_data = PEcAn.benchmark::align_data( + model.calc = model_data, obvs.calc = external_data, + var = var, align_method = "mean_over_larger_timestep") %>% + dplyr::select(everything(), + model = matches("[.]m"), + observations = matches("[.]o"), + Date = posix) + + print(head(aligned_data)) + # Melt dataframe to plot two types of columns together + aligned_data <- tidyr::gather(aligned_data, variable, value, -Date) + + + + + model <- filter(aligned_data, variable == "model") + observasions <- filter(aligned_data, variable == "observations") + + #convert dataframe to xts object + model.xts <- xts(model$value, order.by = model$Date) + observasions.xts <- xts(observasions$value, order.by = observasions$Date) + + # subsetting of a date range + date_range2 <- paste0(input$date_range2, collapse = "/") + model.xts <- model.xts[date_range2] + observasions.xts <- observasions.xts[date_range2] + + # Aggregation function + aggr <- function(xts.df){ + + if(input$agg2=="NONE") return(xts.df) + + if(input$agg2 == "daily"){ + xts.df <- apply.daily(xts.df, input$func2) + }else if(input$agg2 == "weekly"){ + xts.df <- apply.weekly(xts.df, input$func2) + }else if(input$agg2 == "monthly"){ + xts.df <- apply.monthly(xts.df, input$func2) + }else if(input$agg2 == "quarterly"){ + xts.df <- apply.quarterly(xts.df, input$func2) + }else{ + xts.df <- apply.yearly(xts.df, input$func2) + } + } + + model.xts <- aggr(model.xts) + observasions.xts <- aggr(observasions.xts) + + #Scatter plot + output$modelDataPlotscatter <- renderHighchart({ + scatter.df <- data.frame ( + 'y' = zoo::coredata(model.xts), + 'x' = zoo::coredata(observasions.xts) + ) + hlim <- max(max(scatter.df$y, scatter.df$x)) + llim <- min(min(scatter.df$y, scatter.df$x)) + + + highchart() %>% + hc_chart(type = 'scatter') %>% + hc_add_series(scatter.df, name = "Model data comparison", showInLegend = FALSE) %>% + hc_legend(enabled = FALSE) %>% + hc_yAxis(title = list(text = "Simulated",fontSize=19), min=llim, max=hlim)%>% + hc_exporting(enabled = TRUE, filename=paste0("Model_data_comparison")) %>% + hc_add_theme(hc_theme_elementary(yAxis = list(title = list(style = list(color = "#373b42",fontSize=15)), + labels = list(style = list(color = "#373b42",fontSize=15))), + xAxis = list(title = list(style = list(color = "#373b42",fontSize=15)), + labels = list(style = list(color = "#373b42",fontSize=15))) + ))%>% + hc_xAxis(title = list(text ="Observed" ,fontSize=19), min=llim, max=hlim) + + }) + + unit <- ylab + if(input$units_modeldata != unit & udunits2::ud.are.convertible(unit, input$units_modeldata)){ + aligned_data$value <- udunits2::ud.convert(aligned_data$value,unit,input$units_modeldata) + ylab <- input$units_modeldata + } + + + plot_type <- switch(input$plotType_model, point = "scatter", line = "line") + + #smooth_param <- input$smooth_n_model / nrow(df) *100 + smooth_param <- input$smooth_n_model * 100 + + ply <- highchart() %>% + hc_add_series(model.xts, name = "model", type = plot_type, + regression = TRUE, + regressionSettings = list(type = "loess", loessSmooth = smooth_param)) %>% + hc_add_series(observasions.xts, name = "observations", type = plot_type, + regression = TRUE, + regressionSettings = list(type = "loess", loessSmooth = smooth_param)) %>% + hc_add_dependency("plugins/highcharts-regression.js") %>% + hc_title(text = title) %>% + hc_xAxis(title = list(text = xlab), type = 'datetime') %>% + hc_yAxis(title = list(text = ylab)) %>% + hc_tooltip(pointFormat = " Date: {point.x:%Y-%m-%d %H:%M}
y: {point.y}") %>% + hc_exporting(enabled = TRUE) %>% + hc_chart(zoomType = "x") + + }) + + #Signaling the success of the operation + toastr_success("Generate plot") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) + ply }) }) -observeEvent(input$model_data_toggle_plot,{ - toggleElement("model_data_plot_interactive") - toggleElement("model_data_plot_static") -}) + @@ -242,3 +316,4 @@ observeEvent(input$model_data_toggle_plot,{ # }) + diff --git a/shiny/workflowPlot/server_files/model_plots_server.R b/shiny/workflowPlot/server_files/model_plots_server.R index e98be8fc413..7a0d7dbd6fd 100644 --- a/shiny/workflowPlot/server_files/model_plots_server.R +++ b/shiny/workflowPlot/server_files/model_plots_server.R @@ -1,22 +1,35 @@ -# Renders ggplotly +# Renders highcharter -output$modelPlot <- renderPlotly({ +output$modelPlot <- renderHighchart({ validate( need(input$all_workflow_id, 'Select workflow id'), need(input$all_run_id, 'Select Run id'), need(input$load_model > 0, 'Select Load Model Outputs') ) - plt <- ggplot(data.frame(x = 0, y = 0), aes(x,y)) + - annotate("text", x = 0, y = 0, label = "Ready to plot!", - size = 10, color = "grey") + highchart() %>% + hc_add_series(data = c(), showInLegend = F) %>% + hc_xAxis(title = list(text = "Time")) %>% + hc_yAxis(title = list(text = "y")) %>% + hc_title(text = "You are ready to plot!") %>% + hc_add_theme(hc_theme_flat()) }) # Update units every time a variable is selected observeEvent(input$var_name_model, { - model.df <- load.model() - default.unit <- model.df %>% filter(var_name == input$var_name_model) %>% pull(ylab) %>% unique() - updateTextInput(session, "units_model", value = default.unit) + req(input$var_name_model) + tryCatch({ + model.df <- load.model() + default.unit <- + model.df %>% filter(var_name == input$var_name_model) %>% pull(ylab) %>% unique() + updateTextInput(session, "units_model", value = default.unit) + + #Signaling the success of the operation + toastr_success("Variables were updated.") + }, + error = function(e) { + toastr_error(title = "Error in reading the run files.", conditionMessage(e)) + }) }) # Check that new units are parsible and can be used for conversion @@ -35,70 +48,111 @@ observeEvent(input$units_model,{ } }) +# update date range input limit +observe({ + df <- load.model() + updateDateRangeInput(session, "date_range", + start = as.Date(min(df$dates)), + end = as.Date(max(df$dates)), + min = as.Date(min(df$dates)), + max = as.Date(max(df$dates)) + ) +}) + +# update "function" select box choice according to "agrregation" select box +observe({ + if(input$agg == "NONE"){ + updateSelectInput(session, "func", choices = "NONE") + }else{ + updateSelectInput(session, "func", choices = c("mean", "sum")) + } +}) observeEvent(input$ex_plot_model,{ req(input$units_model) - - output$modelPlot <- renderPlotly({ + + output$modelPlot <- renderHighchart({ + input$ex_plot_model isolate({ - df <- dplyr::filter(load.model(), var_name == input$var_name_model) - - updateSliderInput(session,"smooth_n_model", min = 0, max = nrow(df)) - - title <- unique(df$title) - xlab <- unique(df$xlab) - ylab <- unique(df$ylab) - - unit <- ylab - if(input$units_model != unit & udunits2::ud.are.convertible(unit, input$units_model)){ - df$vals <- udunits2::ud.convert(df$vals,unit,input$units_model) - ylab <- input$units_model - } - - data_geom <- switch(input$plotType_model, point = geom_point, line = geom_line) - - plt <- ggplot(df, aes(x = dates, y = vals, color = run_id)) - plt <- plt + data_geom() - plt <- plt + labs(title=title, x=xlab, y=ylab) - plt <- plt + geom_smooth(n=input$smooth_n_model) - ply <- ggplotly(plt) - }) - }) - - output$modelPlotStatic <- renderPlotly({ - input$ex_plot_model - isolate({ - df <- dplyr::filter(load.model(), var_name == input$var_name_model) - - updateSliderInput(session,"smooth_n_model", min = 0, max = nrow(df)) - - title <- unique(df$title) - xlab <- unique(df$xlab) - ylab <- unique(df$ylab) - - unit <- ylab - if(input$units_model != unit & udunits2::ud.are.convertible(unit, input$units_model)){ - df$vals <- udunits2::ud.convert(df$vals,unit,input$units_model) - ylab <- input$units_model - } - - data_geom <- switch(input$plotType_model, point = geom_point, line = geom_line) - - plt <- ggplot(df, aes(x = dates, y = vals, color = run_id)) - plt <- plt + data_geom() - plt <- plt + labs(title=title, x=xlab, y=ylab) - plt <- plt + geom_smooth(n=input$smooth_n_model) - ply <- ggplotly(plt) - ply <- plotly::config(ply, collaborate = F, doubleClick = F, displayModeBar = F, staticPlot = T) + tryCatch({ + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...',{ + + df <- dplyr::filter(load.model(), var_name == input$var_name_model) + + #updateSliderInput(session,"smooth_n_model", min = 0, max = nrow(df)) + + title <- unique(df$title) + xlab <- unique(df$xlab) + ylab <- unique(df$ylab) + + unit <- ylab + if(input$units_model != unit & udunits2::ud.are.convertible(unit, input$units_model)){ + df$vals <- udunits2::ud.convert(df$vals,unit,input$units_model) + ylab <- input$units_model + } + + date_range <- paste0(input$date_range, collapse = "/") + + plot_type <- switch(input$plotType_model, point = "scatter", line = "line") + + smooth_param <- input$smooth_n_model * 100 + + # function that converts dataframe to xts object, + # selects subset of a date range and does data aggregtion + func <- function(df){ + xts.df <- xts(df$vals, order.by = df$dates) + xts.df <- xts.df[date_range] + + if(input$agg=="NONE") return(xts.df) + + if(input$agg == "daily"){ + xts.df <- apply.daily(xts.df, input$func) + }else if(input$agg == "weekly"){ + xts.df <- apply.weekly(xts.df, input$func) + }else if(input$agg == "monthly"){ + xts.df <- apply.monthly(xts.df, input$func) + }else if(input$agg == "quarterly"){ + xts.df <- apply.quarterly(xts.df, input$func) + }else{ + xts.df <- apply.yearly(xts.df, input$func) + } + } + + list <- split(df, df$run_id) + xts.list <- lapply(list, func) + + ply <- highchart() + + for(i in 1:length(xts.list)){ + ply <- ply %>% + hc_add_series(xts.list[[i]], type = plot_type, name = names(xts.list[i]), + regression = TRUE, + regressionSettings = list(type = "loess", loessSmooth = smooth_param)) + } + + ply <- ply %>% + hc_add_dependency("plugins/highcharts-regression.js") %>% + hc_title(text = title) %>% + hc_xAxis(title = list(text = xlab), type = 'datetime') %>% + hc_yAxis(title = list(text = ylab)) %>% + hc_tooltip(pointFormat = " Date: {point.x:%Y-%m-%d %H:%M}
y: {point.y}") %>% + hc_exporting(enabled = TRUE) %>% + hc_chart(zoomType = "x") + + }) + #Signaling the success of the operation + toastr_success("Generate plot") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) + ply }) }) -observeEvent(input$model_toggle_plot,{ - toggleElement("model_plot_static") - toggleElement("model_plot_interactive") -}) # masterDF <- loadNewData() # # Convert from factor to character. For subsetting diff --git a/shiny/workflowPlot/server_files/pdf_viewer_server.R b/shiny/workflowPlot/server_files/pdf_viewer_server.R new file mode 100644 index 00000000000..66022d2e9f0 --- /dev/null +++ b/shiny/workflowPlot/server_files/pdf_viewer_server.R @@ -0,0 +1,61 @@ +# data table that lists file names +observe({ + req(input$all_workflow_id) + w_ids <- input$all_workflow_id + folder.path <- c() + for(w_id in w_ids){ + folder.path <- c(folder.path, workflow(dbConnect$bety, w_id) %>% collect() %>% pull(folder)) + } + + output$files <- DT::renderDT( + DT::datatable(list.files(folder.path,"*.pdf") %>% + as.data.frame()%>% + `colnames<-`(c("File name")), + escape = F, + selection="single", + style='bootstrap', + rownames = FALSE, + options = list( + dom = 'ft', + pageLength = 10, + scrollX = TRUE, + scrollCollapse = TRUE, + initComplete = DT::JS( + "function(settings, json) {", + "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});", + "}") + ) + ) + + ) +}) + + +# displays pdf views +observeEvent(input$files_cell_clicked, { + req(input$all_workflow_id) + w_ids <- input$all_workflow_id + folder.path <- c() + for(w_id in w_ids){ + folder.path <- c(folder.path, workflow(dbConnect$bety, w_id) %>% collect() %>% pull(folder)) + } + + if (length(input$files_cell_clicked) > 0) { + # File needs to be copied to the www folder + if(file.access("www", 2) == 0){ #check write permission + for(i in length(folder.path)){ + file.copy(file.path(folder.path[i], input$files_cell_clicked$value), + "www", + overwrite = T) + } + }else{ + print("Pdf files cannot not be copied to www folfer. Do not have write permission.") + } + + output$pdfview <- renderUI({ + tags$iframe(style = "height:800px; width:100%; border: 1px grey solid;", + src = input$files_cell_clicked$value) + }) + } + +}) diff --git a/shiny/workflowPlot/server_files/select_data_server.R b/shiny/workflowPlot/server_files/select_data_server.R index 9028ec85ac5..3d828642e81 100644 --- a/shiny/workflowPlot/server_files/select_data_server.R +++ b/shiny/workflowPlot/server_files/select_data_server.R @@ -1,36 +1,133 @@ observeEvent(input$load_model,{ - req(input$all_run_id) - - df <- load.model() - # output$results_table <- DT::renderDataTable(DT::datatable(head(masterDF))) - - ids_DF <- parse_ids_from_input_runID(input$all_run_id) - README.text <- c() - - for(i in seq(nrow(ids_DF))){ - - dfsub <- df %>% filter(run_id == ids_DF$runID[i]) - - diff.m <- diff(dfsub$dates) - mode.m <- diff.m[which.max(tabulate(match(unique(diff.m), diff.m)))] - diff_units.m = units(mode.m) - - diff_message <- sprintf("timestep: %.2f %s", mode.m, diff_units.m) - wf.folder <- workflow(bety, ids_DF$wID[i]) %>% collect() %>% pull(folder) + tryCatch({ + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...', + value = 0,{ + + req(input$all_run_id) + incProgress(1 / 15) + + df <- load.model() + if (nrow(df)==0) return(NULL) + # output$results_table <- DT::renderDataTable(DT::datatable(head(masterDF))) + incProgress(10 / 15) + + ids_DF <- parse_ids_from_input_runID(input$all_run_id) + + select.df <- data.frame() + + for(i in seq(nrow(ids_DF))){ + + dfsub <- df %>% filter(run_id == ids_DF$runID[i]) + + diff.m <- diff(dfsub$dates) + mode.m <- diff.m[which.max(tabulate(match(unique(diff.m), diff.m)))] + diff_units.m = units(mode.m) + + diff_message <- sprintf("timestep: %.2f %s", mode.m, diff_units.m) + wf.folder <- workflow(dbConnect$bety, ids_DF$wID[i]) %>% collect() %>% pull(folder) + + README.text <- tryCatch({ + c(readLines(file.path(wf.folder, 'run', ids_DF$runID[i], "README.txt")), + diff_message) + }, + error = function(e){ + return(NULL) + }) + + README.df <- data.frame() + + if(!is.null(README.text)){ + README.df <- read.delim(textConnection(README.text), + header=FALSE,sep=":",strip.white=TRUE) + + if("pft names" %in% levels(README.df$V1)){ + levels(README.df$V1)[levels(README.df$V1)=="pft names"] <- "pft name" + } + if(!"trait" %in% levels(README.df$V1)){ + README.df <- rbind(README.df, data.frame(V1 = "trait", V2 = "-")) + } + if(!"quantile" %in% levels(README.df$V1)){ + README.df <- rbind(README.df, data.frame(V1 = "quantile", V2 = "-")) + } + } + + select.df <- rbind(select.df, README.df) + } + + #hide the into msg + shinyjs::hide("intromsg") + + select.data <- select.df %>% + dlply(.(V1), function(x) x[[2]]) %>% + as.data.frame() %>% + dplyr::rename(site.id = site..id) %>% + dplyr::select(runtype, workflow.id, ensemble.id, pft.name, quantile, trait, run.id, + model, site.id, start.date, end.date, hostname, timestep, rundir, outdir) + + output$runsui<-renderUI({ + seq_len(nrow(select.data)) %>% + map( + function(rown){ + + HTML(paste0(' +
+

',select.data$workflow.id[rown],'

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Runtype:
',select.data$runtype[rown],'
Ensemble.id:
',select.data$ensemble.id[rown],'
Pft.name
',select.data$pft.name[rown],'
Run.id
',select.data$run.id[rown],'
Model
',select.data$model[rown],'
Site.id
',select.data$site.id[rown],'
Start.date
',select.data$start.date[rown],'
End.date
',select.data$end.date[rown],'
Hostname
',select.data$hostname[rown],'
Outdir
',select.data$outdir[rown],'
+
+ + ')) + } + ) + }) + + #output$README <- renderUI({HTML(paste(README.text, collapse = '
'))}) + + output$dim_message <- renderText({sprintf("This data has %.0f rows,\nthink about skipping exploratory plots if this is a large number...", dim(df)[1])}) + incProgress(4 / 15) + }) - README.text <- c(README.text, - paste("SELECTION",i), - "============", - readLines(file.path(wf.folder, 'run', ids_DF$runID[i], "README.txt")), - diff_message, - "" - ) - } - - output$README <- renderUI({HTML(paste(README.text, collapse = '
'))}) - - output$dim_message <- renderText({sprintf("This data has %.0f rows, think about skipping exploratory plots if this is a large number...", dim(df)[1])}) - + #Signaling the success of the operation + toastr_success("Load model outputs") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) diff --git a/shiny/workflowPlot/server_files/sidebar_server.R b/shiny/workflowPlot/server_files/sidebar_server.R index 4fdba4c61a8..6aac39ad572 100644 --- a/shiny/workflowPlot/server_files/sidebar_server.R +++ b/shiny/workflowPlot/server_files/sidebar_server.R @@ -2,17 +2,31 @@ # Loading Model Output(s) -----------------------------------------------------# + # Update workflow ids observe({ - # get_workflow_ids function (line 137) in db/R/query.dplyr.R takes a flag to check - # if we want to load all workflow ids. - # get_workflow_id function from query.dplyr.R - all_ids <- get_workflow_ids(bety, query, all.ids=TRUE) - updateSelectizeInput(session, "all_workflow_id", choices = all_ids) - # Get URL prameters - query <- parseQueryString(session$clientData$url_search) - # Pre-select workflow_id from URL prams - updateSelectizeInput(session, "all_workflow_id", selected = query[["workflow_id"]]) + tryCatch({ + # get_workflow_ids function (line 137) in db/R/query.dplyr.R takes a flag to check + # if we want to load all workflow ids. + # get_workflow_id function from query.dplyr.R + all_ids <- get_workflow_ids(dbConnect$bety, query, all.ids=TRUE) + selectList <- as.data.table(all_ids) + + updateSelectizeInput(session, + "all_workflow_id", + choices = all_ids, + server = TRUE) + # Get URL prameters + query <- parseQueryString(session$clientData$url_search) + + # Pre-select workflow_id from URL prams + if(length(query)>0) updateSelectizeInput(session, "all_workflow_id", selected = query[["workflow_id"]]) + #Signaling the success of the operation + toastr_success("Update workflow IDs") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) # Update run ids @@ -25,7 +39,7 @@ all_run_ids <- reactive({ run_id_list <- c() for(w_id in w_ids){ # For all the workflow ids - r_ids <- get_run_ids(bety, w_id) + r_ids <- get_run_ids(dbConnect$bety, w_id) for(r_id in r_ids){ # Each workflow id can have more than one run ids # ',' as a separator between workflow id and run id @@ -36,14 +50,21 @@ all_run_ids <- reactive({ return(run_id_list) }) # Update all run_ids ('workflow ',w_id,', run ',r_id) -observe({ - updateSelectizeInput(session, "all_run_id", choices = all_run_ids()) - # Get URL parameters - query <- parseQueryString(session$clientData$url_search) - # Make the run_id string with workflow_id - url_run_id <- paste0('workflow ', query[["workflow_id"]],', run ', query[["run_id"]]) - # Pre-select run_id from URL params - updateSelectizeInput(session, "all_run_id", selected = url_run_id) +observeEvent(input$all_workflow_id,{ + tryCatch({ + updateSelectizeInput(session, "all_run_id", choices = all_run_ids()) + # Get URL parameters + query <- parseQueryString(session$clientData$url_search) + # Make the run_id string with workflow_id + url_run_id <- paste0('workflow ', query[["workflow_id"]],', run ', query[["run_id"]]) + # Pre-select run_id from URL params + updateSelectizeInput(session, "all_run_id", selected = url_run_id) + #Signaling the success of the operation + toastr_success("Update run IDs") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) }) @@ -55,7 +76,15 @@ load.model <- eventReactive(input$load_model,{ req(input$all_run_id) # Get IDs DF from 'all_run_id' string ids_DF <- parse_ids_from_input_runID(input$all_run_id) - globalDF <- map2_df(ids_DF$wID, ids_DF$runID, ~load_data_single_run(bety, .x, .y)) + globalDF <- map2_df(ids_DF$wID, ids_DF$runID, + ~tryCatch({ + load_data_single_run(dbConnect$bety, .x, .y) + }, + error = function(e){ + toastr_error(title = paste("Error in WorkflowID", .x), + conditionMessage(e)) + return() + })) print("Yay the model data is loaded!") print(head(globalDF)) globalDF$var_name <- as.character(globalDF$var_name) @@ -70,7 +99,13 @@ observeEvent(input$load_model, { ids_DF <- parse_ids_from_input_runID(input$all_run_id) var_name_list <- c() for(row_num in 1:nrow(ids_DF)){ - var_name_list <- c(var_name_list, var_names_all(bety, ids_DF$wID[row_num], ids_DF$runID[row_num])) + var_name_list <- c(var_name_list, + tryCatch({ + var_names_all(dbConnect$bety, ids_DF$wID[row_num], ids_DF$runID[row_num]) + }, + error = function(e){ + return(NULL) + })) } updateSelectizeInput(session, "var_name_model", choices = var_name_list) }) @@ -81,7 +116,13 @@ observeEvent(input$load_model,{ ids_DF <- parse_ids_from_input_runID(input$all_run_id) site_id_list <- c() for(row_num in 1:nrow(ids_DF)){ - settings <- getSettingsFromWorkflowId(bety,ids_DF$wID[row_num]) + settings <- + tryCatch({ + getSettingsFromWorkflowId(dbConnect$bety,ids_DF$wID[row_num]) + }, + error = function(e){ + return(NULL) + }) site.id <- c(settings$run$site$id) site_id_list <- c(site_id_list,site.id) } @@ -90,8 +131,8 @@ observeEvent(input$load_model,{ # Update input id list as (input id, name) observe({ req(input$all_site_id) - inputs_df <- getInputs(bety, c(input$all_site_id)) - formats_1 <- dplyr::tbl(bety, 'formats_variables') %>% + inputs_df <- getInputs(dbConnect$bety, c(input$all_site_id)) + formats_1 <- dplyr::tbl(dbConnect$bety, 'formats_variables') %>% dplyr::filter(format_id %in% inputs_df$format_id) if (dplyr.count(formats_1) == 0) { logger.warn("No inputs found. Returning NULL.") @@ -106,25 +147,33 @@ observe({ }) load.model.data <- eventReactive(input$load_data, { - req(input$all_input_id) - inputs_df <- getInputs(bety,c(input$all_site_id)) + req(input$all_input_id) + + inputs_df <- getInputs(dbConnect$bety,c(input$all_site_id)) inputs_df <- inputs_df %>% dplyr::filter(input_selection_list == input$all_input_id) - + input_id <- inputs_df$input_id # File_format <- getFileFormat(bety,input_id) - File_format <- PEcAn.DB::query.format.vars(bety = bety, input.id = input_id) + File_format <- PEcAn.DB::query.format.vars(bety = dbConnect$bety, input.id = input_id) start.year <- as.numeric(lubridate::year(inputs_df$start_date)) end.year <- as.numeric(lubridate::year(inputs_df$end_date)) File_path <- inputs_df$filePath + # TODO There is an issue with the db where file names are not saved properly. # To make it work with the VM, uncomment the line below - # File_path <- paste0(inputs_df$filePath,'.csv') + #File_path <- paste0(inputs_df$filePath,'.csv') site.id <- inputs_df$site_id - site <- PEcAn.DB::query.site(site.id,bety$con) + site <- PEcAn.DB::query.site(site.id,dbConnect$bety$con) + observations <- PEcAn.benchmark::load_data( data.path = File_path, format = File_format, time.row = File_format$time.row, site = site, start_year = start.year, end_year = end.year) + # Manually select variables to deal with the error + # observations <- PEcAn.benchmark::load_data( + # data.path = File_path, format = File_format, + # site = site, start_year = start.year, end_year = end.year, + # vars.used.index = c(1,2,3,5,6,7,9,10,12,13,14,15,16,19)) print("Yay the observational data is loaded!") print(head(observations)) return(observations) @@ -133,8 +182,205 @@ load.model.data <- eventReactive(input$load_data, { # Update all variable names observeEvent(input$load_data, { - model.df <- load.model() - obvs.df <- load.model.data() - updateSelectizeInput(session, "var_name_modeldata", - choices = intersect(model.df$var_name, names(obvs.df))) -}) \ No newline at end of file + tryCatch({ + withProgress(message = 'Calculation in progress', + detail = 'This may take a while...', + value = 0,{ + model.df <- load.model() + incProgress(7 / 15) + obvs.df <- load.model.data() + incProgress(7 / 15) + updateSelectizeInput(session, "var_name_modeldata", + choices = intersect(model.df$var_name, names(obvs.df))) + incProgress(1 / 15) + }) + #Signaling the success of the operation + toastr_success("Update variable names") + }, + error = function(e) { + toastr_error(title = "Error", conditionMessage(e)) + }) +}) + +# These are required for shinyFiles which allows to select target folder on server machine +volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()()) +shinyDirChoose(input, "regdirectory", roots = volumes, session = session, restrictions = system.file(package = "base")) + + +output$formatPreview <- DT::renderDT({ + req(input$format_sel_pre) + tryCatch({ + Fids <- + PEcAn.DB::get.id("formats", + "name", + input$format_sel_pre, + dbConnect$bety$con) %>% + as.character() + + if (length(Fids) > 1) + toastr_warning(title = "Format Preview", + message = "More than one id was found for this format. The first one will be used.") + + mimt<-tbl(dbConnect$bety$con,"formats") %>% + left_join(tbl(dbConnect$bety$con,"mimetypes"), by=c('mimetype_id'='id'))%>% + dplyr::filter(id==Fids[1]) %>% + dplyr::pull(type_string) + + output$mimt_pre<-renderText({ + mimt + }) + + DT::datatable( + tbl(dbConnect$bety$con, "formats_variables") %>% + dplyr::filter(format_id == Fids[1]) %>% + dplyr::select(-id, -format_id,-variable_id,-created_at,-updated_at) %>% + dplyr::filter(name != "") %>% + collect(), + escape = F, + filter = 'none', + selection = "none", + style = 'bootstrap', + rownames = FALSE, + options = list( + autowidth = TRUE, + columnDefs = list(list( + width = '90px', targets = -1 + )), + #set column width for action button + dom = 'tp', + pageLength = 10, + scrollX = TRUE, + scrollCollapse = FALSE, + initComplete = DT::JS( + "function(settings, json) {", + "$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});", + "}" + ) + ) + ) + + + + }, + error = function(e) { + toastr_error(title = "Error in format preview", message = conditionMessage(e)) + }) +}) + +# Register external data +observeEvent(input$register_data,{ + #browser() + req(input$all_site_id) + + showModal( + modalDialog( + title = "Register External Data", + tabsetPanel( + tabPanel("Register", + br(), + fluidRow( + column(6, + fileInput("Datafile", "Choose CSV/NC File", + width = "100%", + accept = c( + "text/csv", + "text/comma-separated-values,text/plain", + ".csv", + ".nc") + )), + column(6,br(), + shinyFiles::shinyDirButton("regdirectory", "Choose your target dir", "Please select a folder") + ), + tags$hr() + ), + fluidRow( + column(6, dateInput("date3", "Start Date:", value = Sys.Date()-10)), + column(6, dateInput("date4", "End Date:", value = Sys.Date()-10) ) + ),tags$hr(), + fluidRow( + column(6, shinyTime::timeInput("time2", "Start Time:", value = Sys.time())), + column(6, shinyTime::timeInput("time2", "End Time:", value = Sys.time())) + ),tags$hr(), + fluidRow( + column(6, selectizeInput("format_sel", "Format Name", tbl(dbConnect$bety,"formats") %>% + pull(name) %>% + unique() + ) ), + column(6) + ) + ), + tabPanel("Fromat Preview", br(), + fluidRow( + column(6,selectizeInput("format_sel_pre", "Format Name", tbl(dbConnect$bety,"formats") %>% + pull(name) %>% unique())), + column(6, h5(shiny::tags$b("Mimetypes")), textOutput("mimt_pre")) + ), + fluidRow( + column(12, + DT::dataTableOutput("formatPreview") + ) + + ) + ) + ), + footer = tagList( + actionButton("register_button", "Register", class="btn-primary"), + modalButton("Cancel") + ), + size = 'l' + ) + ) +}) + +# register input file in database +observeEvent(input$register_button,{ + tryCatch({ + inFile <- input$Datafile + dir.name <- gsub(".[a-z]+", "", inFile$name) + dir.create(file.path(parseDirPath(volumes, input$regdirectory), dir.name)) + file.copy(inFile$datapath, + file.path(parseDirPath(volumes, input$regdirectory), dir.name, inFile$name), + overwrite = T) + + mt <- tbl(dbConnect$bety,"formats") %>% + left_join(tbl(dbConnect$bety,"mimetypes"), by = c("mimetype_id" = "id")) %>% + filter(name == input$format_sel) %>% + pull(type_string) + + PEcAn.DB::dbfile.input.insert(in.path = file.path(parseDirPath(volumes, input$regdirectory), dir.name), + in.prefix = inFile$name, + siteid = input$all_site_id, # select box + startdate = input$date3, + enddate = input$date4, + mimetype = mt, + formatname = input$format_sel, + #parentid = input$parentID, + con = dbConnect$bety$con + #hostname = localhost #?, #default to localhost for now + #allow.conflicting.dates#? #default to FALSE for now + ) + removeModal() + toastr_success("Register External Data") + }, + error = function(e){ + toastr_error(title = "Error", conditionMessage(e)) + }) +}) + +# update input id list when register button is clicked +observeEvent(input$register_button,{ + req(input$all_site_id) + inputs_df <- getInputs(dbConnect$bety, c(input$all_site_id)) + formats_1 <- dplyr::tbl(dbConnect$bety, 'formats_variables') %>% + dplyr::filter(format_id %in% inputs_df$format_id) + if (dplyr.count(formats_1) == 0) { + logger.warn("No inputs found. Returning NULL.") + return(NULL) + } else { + formats_sub <- formats_1 %>% + dplyr::pull(format_id) %>% + unique() + inputs_df <- inputs_df %>% dplyr::filter(format_id %in% formats_sub) # Only data sets with formats with associated variables will show up + updateSelectizeInput(session, "all_input_id", choices=inputs_df$input_selection_list) + } +}) diff --git a/shiny/workflowPlot/ui.R b/shiny/workflowPlot/ui.R index 509b66e93f4..9dd8c3d0d76 100644 --- a/shiny/workflowPlot/ui.R +++ b/shiny/workflowPlot/ui.R @@ -1,19 +1,40 @@ library(shiny) library(plotly) +library(highcharter) library(shinythemes) library(knitr) library(shinyjs) +library(shinytoastr) +library(shinyWidgets) +library(bsplus) source("ui_utils.R", local = TRUE) # Define UI -ui <- fluidPage(theme = shinytheme("simplex"), +ui <- fluidPage(theme = shinytheme("paper"), + tags$head(HTML("PEcAn WorkFlow App")), # Initializing shinyJs useShinyjs(), + # Initializing shinytoastr + useToastr(), + shinyWidgets::useShinydashboard(), # Adding CSS to head tags$head( tags$link(rel = "stylesheet", type = "text/css", href = "style.css") ), + tags$head( + tags$script(src="scripts.js") + ), + tags$head( + tags$style(HTML(" + .modal-lg {width: 85%;} + .navbar-default .navbar-nav{font-size: 16px; + padding-top: 10px; + padding-bottom: 10px; + } + ") + ) + ), # Showing the animation div( id = "loading-content", div(class = "plotlybars-wrapper", @@ -35,34 +56,59 @@ ui <- fluidPage(theme = shinytheme("simplex"), hidden( div( id = "app", - sidebarLayout( - source_ui("sidebar_UI.R"), # Sidebar - mainPanel(navbarPage(title = NULL, - tabPanel(h4("Select Data"), - # tabsetPanel( - source_ui("select_data_UI.R") - # ) + navbarPage(title = NULL, + tabPanel("Select Data", + icon = icon("hand-pointer"), + tagList( + column(3, + source_ui("sidebar_UI.R") + ), + column(9, + HTML(' +
+

Hello PEcAn user,

+

- This app is designed to help you better explore your runs.

+

- First thing first is to choose your workflow ID. You don\'t know it ? It\'s alright. Use the history runs tab to explore all the runs at all sites.

+

- You can choose previously registered input files to assess your model\'s performance. You have\'nt registered your file ? It\'s alright. Use the register button to do so.

+
+

If you are interested to learn more the PEcAn project or maybe become a member of our community use the following links:

+

+ Learn more about PEcAn + Slack Channel +

+
+ '), + source_ui("select_data_UI.R") + ) + ) + ), + tabPanel("History Runs", + icon = icon("history"), + DT::DTOutput("historyfiles") ), - tabPanel(h4("Exploratory Plots"), + tabPanel("Exploratory Plots", + icon = icon("chart-bar"), tabsetPanel( source_ui("model_plots_UI.R"), - source_ui("model_data_plots_UI.R") + source_ui("model_data_plots_UI.R"), + source_ui("pdf_viewer_UI.R") ) ), - tabPanel(h4("Benchmarking"), + tabPanel("Benchmarking", + icon = icon("pencil-ruler"), tabsetPanel( - source_ui("benchmarking_settings_UI.R"), - source_ui("benchmarking_scores_UI.R"), - source_ui("benchmarking_plots_UI.R") + source_ui("benchmarking_ScoresPlots_UI.R"), + source_ui("benchmarking_settings_UI.R") ) ), - tabPanel(h4("Documentation"), - withMathJax(includeMarkdown("markdown/workflowPlot_doc.Rmd")) + tabPanel("Documentation", + icon = icon("book"), + #withMathJax(includeMarkdown("markdown/workflowPlot_doc.Rmd")) + source_ui("documentation_UI.R"), + use_bs_accordion_sidebar() + ) ) - - ) - ) ) ) - ) \ No newline at end of file + ) diff --git a/shiny/workflowPlot/ui_files/benchmarking_ScoresPlots_UI.R b/shiny/workflowPlot/ui_files/benchmarking_ScoresPlots_UI.R new file mode 100644 index 00000000000..d2ccc1b61b0 --- /dev/null +++ b/shiny/workflowPlot/ui_files/benchmarking_ScoresPlots_UI.R @@ -0,0 +1,40 @@ +tabPanel("Scores/Plots", + column(12, h3("Setup Reference Run")), + column(12, + verbatimTextOutput("brr_message"), + uiOutput("button_BRR") + ), + column(12, + h3("Setup Benchmarks")), + column(12, + uiOutput("results_message"), + br(), + uiOutput("bm_inputs"), + uiOutput("calc_bm"), + tags$hr(), + br() + ), + column(12, + # verbatimTextOutput("report"), + textOutput("inputs_df_title"), + br(), + DT::dataTableOutput("inputs_df_table"), + br() + ), + fluidRow( + column(8, + fluidRow( + column(3,offset = 1, textOutput("plots_tilte")), + column(8, uiOutput("bm_plots")) + ), + uiOutput("plotlybars"), + plotlyOutput("bmPlot"), + br() + ), + column(4, + textOutput("results_df_title"), + br(), + DT::dataTableOutput("results_table") + ) + ) +) diff --git a/shiny/workflowPlot/ui_files/benchmarking_plots_UI.R b/shiny/workflowPlot/ui_files/benchmarking_plots_UI.R deleted file mode 100644 index 9b365456731..00000000000 --- a/shiny/workflowPlot/ui_files/benchmarking_plots_UI.R +++ /dev/null @@ -1,22 +0,0 @@ -tabPanel("Plots", - uiOutput("bm_plots"), - div( - id = "plot-container", - div( - class = "plotlybars-wrapper", - div( - class = "plotlybars", - div(class = "plotlybars-bar b1"), - div(class = "plotlybars-bar b2"), - div(class = "plotlybars-bar b3"), - div(class = "plotlybars-bar b4"), - div(class = "plotlybars-bar b5"), - div(class = "plotlybars-bar b6"), - div(class = "plotlybars-bar b7") - ), - div(class = "plotlybars-text", - p("Updating the plot. Hold tight!")) - ), - plotlyOutput("bmPlot") - ) -) diff --git a/shiny/workflowPlot/ui_files/benchmarking_scores_UI.R b/shiny/workflowPlot/ui_files/benchmarking_scores_UI.R deleted file mode 100644 index 31c779fba95..00000000000 --- a/shiny/workflowPlot/ui_files/benchmarking_scores_UI.R +++ /dev/null @@ -1,3 +0,0 @@ -tabPanel("Scores", - DT::dataTableOutput("results_table") -) \ No newline at end of file diff --git a/shiny/workflowPlot/ui_files/benchmarking_settings_UI.R b/shiny/workflowPlot/ui_files/benchmarking_settings_UI.R index e4bf0083c04..8f1db5ab5c2 100644 --- a/shiny/workflowPlot/ui_files/benchmarking_settings_UI.R +++ b/shiny/workflowPlot/ui_files/benchmarking_settings_UI.R @@ -1,24 +1,5 @@ -tabPanel("Settings", - column(12, h3("Setup Reference Run")), - column(12, - verbatimTextOutput("brr_message"), - uiOutput("button_BRR") - ), - column(12, - h3("Setup Benchmarks")), - column(12, - uiOutput("results_message"), - uiOutput("bm_inputs") - ), - column(12, h3("Calculate Benchmarks")), - column(12, - verbatimTextOutput("calc_bm_message"), - # verbatimTextOutput("report"), - uiOutput("calc_bm_button"), - uiOutput("inputs_df_table"), - uiOutput("config_list_table"), - uiOutput("reportvars"), - uiOutput("reportmetrics"), - uiOutput("print_bm_settings") +tabPanel("Benchmark Settings", + br(), + verbatimTextOutput("settings_path"), + verbatimTextOutput("print_bm_settings") ) -) \ No newline at end of file diff --git a/shiny/workflowPlot/ui_files/documentation_UI.R b/shiny/workflowPlot/ui_files/documentation_UI.R new file mode 100644 index 00000000000..96d5d7eb295 --- /dev/null +++ b/shiny/workflowPlot/ui_files/documentation_UI.R @@ -0,0 +1,48 @@ +bs_accordion_sidebar(id = "documentation", + spec_side = c(width = 3, offset = 0), + spec_main = c(width = 9, offset = 0)) %>% + bs_append( + title_side = "App Documentation", + content_side = NULL, + content_main = withMathJax(includeMarkdown("markdown/app_documentation.Rmd")) + ) %>% + bs_append( + title_side = "Setup Page", + content_side = NULL, + content_main = withMathJax(includeMarkdown("markdown/setup_page.Rmd")) + ) %>% + bs_append( + title_side = "History Runs", + content_side = NULL, + content_main = HTML(" +

This page is for seaching history runs.

+

If you don\'t know the workflow Id to select in the first panel, use this page to explore all the runs at all sites. +
Select the one you wish to explore using the explore button.

+ ") + ) %>% + bs_append( + title_side = "Exploratory Plots", + content_side = NULL, + content_main = withMathJax(includeMarkdown("markdown/exploratory_plot.Rmd")) + ) %>% + bs_append( + title_side = "Benchmarking", + content_side = NULL, + content_main = + bs_accordion_sidebar(id = "benchmarking") %>% + bs_append( + title_side = "Settings", + content_side = NULL, + content_main = withMathJax(includeMarkdown("markdown/benchmarking_setting.Rmd")) + ) %>% + bs_append( + title_side = "Scores", + content_side = NULL, + content_main = withMathJax(includeMarkdown("markdown/benchmarking_scores.Rmd")) + ) %>% + bs_append( + title_side = "Plots", + content_side = NULL, + content_main = withMathJax(includeMarkdown("markdown/benchmarking_plots.Rmd")) + ) + ) diff --git a/shiny/workflowPlot/ui_files/model_data_plots_UI.R b/shiny/workflowPlot/ui_files/model_data_plots_UI.R index dd1c5e35aab..473776fd091 100644 --- a/shiny/workflowPlot/ui_files/model_data_plots_UI.R +++ b/shiny/workflowPlot/ui_files/model_data_plots_UI.R @@ -1,61 +1,25 @@ tabPanel( "Model-Data Plots", - hidden(div(id = "model_data_plot_interactive", column( - 12, - div( - id = "plot-container", - div( - class = "plotlybars-wrapper", - div( - class = "plotlybars", - div(class = "plotlybars-bar b1"), - div(class = "plotlybars-bar b2"), - div(class = "plotlybars-bar b3"), - div(class = "plotlybars-bar b4"), - div(class = "plotlybars-bar b5"), - div(class = "plotlybars-bar b6"), - div(class = "plotlybars-bar b7") - ), - div(class = "plotlybars-text", - p("Updating the plot. Hold tight!")) - ), - plotlyOutput("modelDataPlot") - ) - ))), - div(id = "model_data_plot_static", column( - 12, - div( - id = "plot-container", - div( - class = "plotlybars-wrapper", - div( - class = "plotlybars", - div(class = "plotlybars-bar b1"), - div(class = "plotlybars-bar b2"), - div(class = "plotlybars-bar b3"), - div(class = "plotlybars-bar b4"), - div(class = "plotlybars-bar b5"), - div(class = "plotlybars-bar b6"), - div(class = "plotlybars-bar b7") - ), - div(class = "plotlybars-text", - p("Updating the plot. Hold tight!")) - ), - plotlyOutput("modelDataPlotStatic") - ) - )), - column(12, wellPanel( - actionButton("ex_plot_modeldata", "Generate Plot"), - div(actionButton("model_data_toggle_plot", "Toggle Plot"), - style = "float:right") - )), + br(), column( - 12, + 3, wellPanel( selectInput("var_name_modeldata", "Variable Name", ""), textInput("units_modeldata", "Units", placeholder = "Type units in udunits2 compatible format"), verbatimTextOutput("unit_text2"), + dateRangeInput("date_range2", "Date Range", separator = " - "), + fluidRow( + column(6, + selectInput("agg2", "Aggregation", + choices = c("NONE", "daily", "weekly", "monthly", "quarterly", "annually"), + selected = "daily")), + column(6, + selectInput("func2", "function", + choices = c("mean", "sum"), + selected = "mean") + ) + ), radioButtons( "plotType_modeldata", "Plot Type (for Model Outputs)", @@ -66,9 +30,19 @@ tabPanel( "smooth_n_modeldata", "Value for smoothing:", min = 0, - max = 100, - value = 80 - ) + max = 1, + value = 0.8 + ), + tags$hr(), + actionButton("ex_plot_modeldata", "Generate Plot", icon = icon("pencil-alt"), + width = "100%", class="btn-primary") ) + ), + column( + 9, + h3("Time series"), + highchartOutput("modelDataPlot", height = "500px"), br(), + h3("Scatter Plot"), + highchartOutput("modelDataPlotscatter", height = "500px") ) ) diff --git a/shiny/workflowPlot/ui_files/model_plots_UI.R b/shiny/workflowPlot/ui_files/model_plots_UI.R index 7ed8888d3bb..975f76eba85 100644 --- a/shiny/workflowPlot/ui_files/model_plots_UI.R +++ b/shiny/workflowPlot/ui_files/model_plots_UI.R @@ -1,61 +1,25 @@ tabPanel( "Model Plots", - hidden(div(id = "model_plot_interactive", column( - 12, - div( - id = "plot-container", - div( - class = "plotlybars-wrapper", - div( - class = "plotlybars", - div(class = "plotlybars-bar b1"), - div(class = "plotlybars-bar b2"), - div(class = "plotlybars-bar b3"), - div(class = "plotlybars-bar b4"), - div(class = "plotlybars-bar b5"), - div(class = "plotlybars-bar b6"), - div(class = "plotlybars-bar b7") - ), - div(class = "plotlybars-text", - p("Updating the plot. Hold tight!")) - ), - plotlyOutput("modelPlot") - ) - ))), - div(id = "model_plot_static", column( - 12, - div( - id = "plot-container", - div( - class = "plotlybars-wrapper", - div( - class = "plotlybars", - div(class = "plotlybars-bar b1"), - div(class = "plotlybars-bar b2"), - div(class = "plotlybars-bar b3"), - div(class = "plotlybars-bar b4"), - div(class = "plotlybars-bar b5"), - div(class = "plotlybars-bar b6"), - div(class = "plotlybars-bar b7") - ), - div(class = "plotlybars-text", - p("Updating the plot. Hold tight!")) - ), - plotlyOutput("modelPlotStatic") - ) - )), - column(12, wellPanel( - actionButton("ex_plot_model", "Generate Plot"), - div(actionButton("model_toggle_plot", "Toggle Plot"), - style = "float:right") - )), + br(), column( - 12, + 3, wellPanel( selectInput("var_name_model", "Variable Name", ""), textInput("units_model", "Units", placeholder = "Type units in udunits2 compatible format"), verbatimTextOutput("unit_text"), + dateRangeInput("date_range", "Date Range", separator = " - "), + fluidRow( + column(6, + selectInput("agg", "Aggregation", + choices = c("NONE", "daily", "weekly", "monthly", "quarterly", "annually"), + selected = "daily")), + column(6, + selectInput("func", "function", + choices = c("mean", "sum"), + selected = "mean") + ) + ), radioButtons( "plotType_model", "Plot Type (for Model Outputs)", @@ -66,9 +30,16 @@ tabPanel( "smooth_n_model", "Value for smoothing:", min = 0, - max = 100, - value = 80 - ) + max = 1, + value = 0.8 + ), + tags$hr(), + actionButton("ex_plot_model", "Generate Plot", icon = icon("pencil-alt"), + width = "100%", class="btn-primary") ) + ), + column( + 9, + highchartOutput("modelPlot", height = "500px") ) ) diff --git a/shiny/workflowPlot/ui_files/pdf_viewer_UI.R b/shiny/workflowPlot/ui_files/pdf_viewer_UI.R new file mode 100644 index 00000000000..bf9063b0dd7 --- /dev/null +++ b/shiny/workflowPlot/ui_files/pdf_viewer_UI.R @@ -0,0 +1,12 @@ +tabPanel( + "PDF Viewer", + br(), + column( + 3, + DT::DTOutput("files") + ), + column( + 9, + uiOutput("pdfview") + ) +) diff --git a/shiny/workflowPlot/ui_files/select_data_UI.R b/shiny/workflowPlot/ui_files/select_data_UI.R index 873ad1b06e5..537fe3aa753 100644 --- a/shiny/workflowPlot/ui_files/select_data_UI.R +++ b/shiny/workflowPlot/ui_files/select_data_UI.R @@ -1,6 +1,9 @@ # Select_Data tagList( - column(6, htmlOutput("README")), - column(6, verbatimTextOutput("dim_message")) + #column(6, htmlOutput("README")), +# DT::dataTableOutput("datatable"), + br(), + uiOutput("runsui"), + verbatimTextOutput("dim_message") ) diff --git a/shiny/workflowPlot/ui_files/sidebar_UI.R b/shiny/workflowPlot/ui_files/sidebar_UI.R index 505afa80afa..ccb91b0d275 100644 --- a/shiny/workflowPlot/ui_files/sidebar_UI.R +++ b/shiny/workflowPlot/ui_files/sidebar_UI.R @@ -1,18 +1,35 @@ -sidebarPanel( - h3("Load Model Output"), +tagList( + h4("Load Model Output"), wellPanel( p("Please select the workflow IDs to continue. You can select multiple IDs"), selectizeInput("all_workflow_id", "Mutliple Workflow IDs", c(), multiple=TRUE), p("Please select the run IDs. You can select multiple IDs"), selectizeInput("all_run_id", "Mutliple Run IDs", c(), multiple=TRUE), - actionButton("load_model", "Load Model outputs") + fluidRow( + column(6, + actionButton("NewRun", "New Run", icon = icon("plus"), + width = "120%", class="btn-primary") + + ), + column(6, + actionButton("load_model", "Load", icon = icon("download"), width = "100%") + ) + ) ), - h3("Load External Data"), + h4("Load External Data"), wellPanel( selectizeInput("all_site_id", "Select Site ID", c()), # If loading multiple sites in future # selectizeInput("all_site_id", "Select Site ID", c(), multiple=TRUE), selectizeInput("all_input_id", "Select Input ID", c()), - actionButton("load_data", "Load External Data") + fluidRow( + column(6, + actionButton("register_data", "Register", icon = icon("upload"), + width = "120%", class="btn-primary") + ), + column(6, + actionButton("load_data", "Load", icon = icon("download"), width = "100%") + ) + ) ) -) \ No newline at end of file +) diff --git a/shiny/workflowPlot/www/scripts.js b/shiny/workflowPlot/www/scripts.js new file mode 100644 index 00000000000..5d5be4e0caf --- /dev/null +++ b/shiny/workflowPlot/www/scripts.js @@ -0,0 +1,11 @@ +$(document).on("click", ".workflowclass", function() { + Shiny.onInputChange("workflowselected", this.id); + // to report changes on the same selectInput + Shiny.onInputChange("workflowclassrand", Math.random()); +}); + +$(document).on("click", ".expanclass", function() { + Shiny.onInputChange("workflows_explor_selected", this.id); + // to report changes on the same selectInput + Shiny.onInputChange("workflow_explor_classrand", Math.random()); +}); diff --git a/shiny/workflowPlot/www/style.css b/shiny/workflowPlot/www/style.css index e4d0d017911..36675369b8a 100644 --- a/shiny/workflowPlot/www/style.css +++ b/shiny/workflowPlot/www/style.css @@ -1,322 +1,343 @@ +.table { + width: 100%; + max-width: 100%; + margin-bottom: 0px; +} + +.badge { + background-color: #4c4343; + font-size: 14px; +} + +.alert h5 { + margin-top: 0; + color: inherit; +} + +.alert h6 { + margin-top: 0; + color: inherit; +} + #loading-content { - position: absolute; - background: #ffffff; - opacity: 0.9; - z-index: 100; - text-align: center; - color: #FFFFFF; - top: 50%; - left: 50%; - height: 30%; - width: 50%; - margin: -15% 0 0 -25%; + position: absolute; + background: #ffffff; + opacity: 0.9; + z-index: 100; + text-align: center; + color: #ffffff; + top: 50%; + left: 50%; + height: 30%; + width: 50%; + margin: -15% 0 0 -25%; } .plotly.html-widget.html-widget-output.shiny-bound-output.js-plotly-plot { - z-index: 22; - position: relative; + z-index: 22; + position: relative; } .plotlybars { - padding: 0 10px; - vertical-align: bottom; - width: 100%; - height: 100%; - overflow: hidden; - position: relative; - box-sizing: border-box; + padding: 0 10px; + vertical-align: bottom; + width: 100%; + height: 100%; + overflow: hidden; + position: relative; + box-sizing: border-box; } .plotlybars-wrapper { - width: 165px; - height: 100px; - margin: 0 auto; - left: 0; - right: 0; - position: absolute; - z-index: 1; + width: 165px; + height: 100px; + margin: 0 auto; + left: 0; + right: 0; + position: absolute; + z-index: 1; } .plotlybars-text { - color: #2E86C1; - font-family: 'Open Sans', verdana, arial, sans-serif; - font-size: 80%; - text-align: center; - margin-top: 5px; + color: #2e86c1; + font-family: "Open Sans", verdana, arial, sans-serif; + font-size: 80%; + text-align: center; + margin-top: 5px; } .plotlybars-bar { - background-color: #2874A6; - height: 100%; - width: 13.3%; - position: absolute; - -webkit-transform: translateZ(0); - transform: translateZ(0); - animation-duration: 2s; - animation-iteration-count: infinite; - animation-direction: normal; - animation-timing-function: linear; - -webkit-animation-duration: 2s; - -webkit-animation-iteration-count: infinite; - -webkit-animation-direction: normal; - -webkit-animation-timing-function: linear; + background-color: #2874a6; + height: 100%; + width: 13.3%; + position: absolute; + -webkit-transform: translateZ(0); + transform: translateZ(0); + animation-duration: 2s; + animation-iteration-count: infinite; + animation-direction: normal; + animation-timing-function: linear; + -webkit-animation-duration: 2s; + -webkit-animation-iteration-count: infinite; + -webkit-animation-direction: normal; + -webkit-animation-timing-function: linear; } .b1 { - left: 0%; - top: 88%; - animation-name: b1; - -webkit-animation-name: b1; + left: 0%; + top: 88%; + animation-name: b1; + -webkit-animation-name: b1; } .b2 { - left: 14.3%; - top: 76%; - animation-name: b2; - -webkit-animation-name: b2; + left: 14.3%; + top: 76%; + animation-name: b2; + -webkit-animation-name: b2; } .b3 { - left: 28.6%; - top: 16%; - animation-name: b3; - -webkit-animation-name: b3; + left: 28.6%; + top: 16%; + animation-name: b3; + -webkit-animation-name: b3; } .b4 { - left: 42.9%; - top: 40%; - animation-name: b4; - -webkit-animation-name: b4; + left: 42.9%; + top: 40%; + animation-name: b4; + -webkit-animation-name: b4; } .b5 { - left: 57.2%; - top: 26%; - animation-name: b5; - -webkit-animation-name: b5; + left: 57.2%; + top: 26%; + animation-name: b5; + -webkit-animation-name: b5; } .b6 { - left: 71.5%; - top: 67%; - animation-name: b6; - -webkit-animation-name: b6; + left: 71.5%; + top: 67%; + animation-name: b6; + -webkit-animation-name: b6; } .b7 { - left: 85.8%; - top: 89%; - animation-name: b7; - -webkit-animation-name: b7; + left: 85.8%; + top: 89%; + animation-name: b7; + -webkit-animation-name: b7; } @keyframes b1 { - 0% { - top: 88%; - } - 44% { - top: 0%; - } - 94% { - top: 100%; - } - 100% { - top: 88%; - } + 0% { + top: 88%; + } + 44% { + top: 0%; + } + 94% { + top: 100%; + } + 100% { + top: 88%; + } } @-webkit-keyframes b1 { - 0% { - top: 88%; - } - 44% { - top: 0%; - } - 94% { - top: 100%; - } - 100% { - top: 88%; - } + 0% { + top: 88%; + } + 44% { + top: 0%; + } + 94% { + top: 100%; + } + 100% { + top: 88%; + } } @keyframes b2 { - 0% { - top: 76%; - } - 38% { - top: 0%; - } - 88% { - top: 100%; - } - 100% { - top: 76%; - } + 0% { + top: 76%; + } + 38% { + top: 0%; + } + 88% { + top: 100%; + } + 100% { + top: 76%; + } } @-webkit-keyframes b2 { - 0% { - top: 76%; - } - 38% { - top: 0%; - } - 88% { - top: 100%; - } - 100% { - top: 76%; - } + 0% { + top: 76%; + } + 38% { + top: 0%; + } + 88% { + top: 100%; + } + 100% { + top: 76%; + } } @keyframes b3 { - 0% { - top: 16%; - } - 8% { - top: 0%; - } - 58% { - top: 100%; - } - 100% { - top: 16%; - } + 0% { + top: 16%; + } + 8% { + top: 0%; + } + 58% { + top: 100%; + } + 100% { + top: 16%; + } } @-webkit-keyframes b3 { - 0% { - top: 16%; - } - 8% { - top: 0%; - } - 58% { - top: 100%; - } - 100% { - top: 16%; - } + 0% { + top: 16%; + } + 8% { + top: 0%; + } + 58% { + top: 100%; + } + 100% { + top: 16%; + } } @keyframes b4 { - 0% { - top: 40%; - } - 20% { - top: 0%; - } - 70% { - top: 100%; - } - 100% { - top: 40%; - } + 0% { + top: 40%; + } + 20% { + top: 0%; + } + 70% { + top: 100%; + } + 100% { + top: 40%; + } } @-webkit-keyframes b4 { - 0% { - top: 40%; - } - 20% { - top: 0%; - } - 70% { - top: 100%; - } - 100% { - top: 40%; - } + 0% { + top: 40%; + } + 20% { + top: 0%; + } + 70% { + top: 100%; + } + 100% { + top: 40%; + } } @keyframes b5 { - 0% { - top: 26%; - } - 13% { - top: 0%; - } - 63% { - top: 100%; - } - 100% { - top: 26%; - } + 0% { + top: 26%; + } + 13% { + top: 0%; + } + 63% { + top: 100%; + } + 100% { + top: 26%; + } } @-webkit-keyframes b5 { - 0% { - top: 26%; - } - 13% { - top: 0%; - } - 63% { - top: 100%; - } - 100% { - top: 26%; - } + 0% { + top: 26%; + } + 13% { + top: 0%; + } + 63% { + top: 100%; + } + 100% { + top: 26%; + } } @keyframes b6 { - 0% { - top: 67%; - } - 33.5% { - top: 0%; - } - 83% { - top: 100%; - } - 100% { - top: 67%; - } + 0% { + top: 67%; + } + 33.5% { + top: 0%; + } + 83% { + top: 100%; + } + 100% { + top: 67%; + } } @-webkit-keyframes b6 { - 0% { - top: 67%; - } - 33.5% { - top: 0%; - } - 83% { - top: 100%; - } - 100% { - top: 67%; - } + 0% { + top: 67%; + } + 33.5% { + top: 0%; + } + 83% { + top: 100%; + } + 100% { + top: 67%; + } } @keyframes b7 { - 0% { - top: 89%; - } - 44.5% { - top: 0%; - } - 94.5% { - top: 100%; - } - 100% { - top: 89%; - } + 0% { + top: 89%; + } + 44.5% { + top: 0%; + } + 94.5% { + top: 100%; + } + 100% { + top: 89%; + } } @-webkit-keyframes b7 { - 0% { - top: 89%; - } - 44.5% { - top: 0%; - } - 94.5% { - top: 100%; - } - 100% { - top: 89%; - } + 0% { + top: 89%; + } + 44.5% { + top: 0%; + } + 94.5% { + top: 100%; + } + 100% { + top: 89%; + } } diff --git a/tests/api.sipnet.xml b/tests/api.sipnet.xml new file mode 100644 index 00000000000..2c390bdf0d1 --- /dev/null +++ b/tests/api.sipnet.xml @@ -0,0 +1,46 @@ + + + + + temperate.coniferous + + + + + 3000 + FALSE + 1.2 + AUTO + + + + NPP + + + + + -1 + 1 + + NPP + + + + SIPNET + r136 + + + + + 772 + + + + 99000000003 + + + 2002-01-01 00:00:00 + 2005-12-31 00:00:00 + pecan/dbfiles + + diff --git a/tests/docker.sipnet.xml b/tests/docker.sipnet.xml new file mode 100644 index 00000000000..3da74156bc5 --- /dev/null +++ b/tests/docker.sipnet.xml @@ -0,0 +1,67 @@ + + + /data/tests/sipnet + + + + PostgreSQL + bety + bety + postgres + bety + FALSE + + + + + + temperate.coniferous + + + + + 3000 + FALSE + 1.2 + AUTO + + + + NPP + + + + + -1 + 1 + + NPP + + + + SIPNET + r136 + + + + + 772 + + + + 5000000005 + + + 2002-01-01 00:00:00 + 2005-12-31 00:00:00 + pecan/dbfiles + + + + localhost + + amqp://guest:guest@rabbitmq/%2F + SIPNET_r136 + + + diff --git a/tests/fail.ghaction.sipnet_Postgres.xml b/tests/fail.ghaction.sipnet_Postgres.xml new file mode 100644 index 00000000000..8b8fab9f297 --- /dev/null +++ b/tests/fail.ghaction.sipnet_Postgres.xml @@ -0,0 +1,62 @@ + + + pecan + + + + Postgres + bety + bety + postgres + bety + FALSE + + + + + + temperate.coniferous + + + + + 3000 + FALSE + 1.2 + AUTO + + + + NPP + + + + + -1 + 1 + + NPP + + + + ${GITHUB_WORKSPACE}/sipnet/sipnet + SIPNET + + + + + 772 + + + + ${GITHUB_WORKSPACE}/sipnet/Sites/Niwot/niwot.clim + + + 2002-01-01 00:00:00 + 2005-12-31 00:00:00 + + localhost + + pecan/dbfiles + + diff --git a/tests/ghaction.sipnet_PostgreSQL.xml b/tests/ghaction.sipnet_PostgreSQL.xml new file mode 100644 index 00000000000..202750c9bbe --- /dev/null +++ b/tests/ghaction.sipnet_PostgreSQL.xml @@ -0,0 +1,62 @@ + + + pecan + + + + PostgreSQL + bety + bety + postgres + bety + FALSE + + + + + + temperate.coniferous + + + + + 3000 + FALSE + 1.2 + AUTO + + + + NPP + + + + + -1 + 1 + + NPP + + + + ${GITHUB_WORKSPACE}/sipnet/sipnet + SIPNET + + + + + 772 + + + + ${GITHUB_WORKSPACE}/sipnet/Sites/Niwot/niwot.clim + + + 2002-01-01 00:00:00 + 2005-12-31 00:00:00 + + localhost + + pecan/dbfiles + + diff --git a/tests/integration.sh b/tests/integration.sh index 8ed5c484d72..36514665749 100755 --- a/tests/integration.sh +++ b/tests/integration.sh @@ -2,9 +2,10 @@ NAME=${1:-$HOSTNAME} +set -o pipefail + cd $( dirname $0 ) for f in ${NAME}.*.xml; do - echo -en 'travis_fold:start:TEST $f\r' rm -rf pecan output.log Rscript --vanilla ../web/workflow.R --settings $f 2>&1 | tee output.log if [ $? -ne 0 ]; then @@ -24,5 +25,4 @@ for f in ${NAME}.*.xml; do echo "----------------------------------------------------------------------" fi rm -rf output.log pecan - echo -en 'travis_fold:end:TEST $f\r' done diff --git a/web/03-inputs.php b/web/03-inputs.php index a63b53b4031..3728b7359ac 100644 --- a/web/03-inputs.php +++ b/web/03-inputs.php @@ -168,6 +168,14 @@ if (preg_match("/ \([A-Z]{2}-.*\)$/", $siteinfo["sitename"])) { $x['files'][] = array("id"=>"Fluxnet2015." . $type, "name"=>"Use Fluxnet2015"); } + if (preg_match("/ \([A-Z]{2}-.*\)$/", $siteinfo["sitename"])) { + $product = ".drought2018"; + $x['files'][] = array("id"=>"ICOS." . $type .$product, "name"=>"Use ICOS Drought 2018"); + } + if (preg_match("/ \([A-Z]{2}-.*\)$/", $siteinfo["sitename"])) { + $product = ".etc"; + $x['files'][] = array("id"=>"ICOS." . $type .$product, "name"=>"Use ICOS Ecosystem Archive"); + } // check for NARR,this is not exact since it is a conical projection if ($siteinfo['lat'] > 1 && $siteinfo['lat'] < 85 && $siteinfo['lon'] < -68 && $siteinfo['lon'] > -145) { $x['files'][] = array("id"=>"NARR." . $type, "name"=>"Use NARR"); diff --git a/web/04-runpecan.php b/web/04-runpecan.php index 005b648b65b..5f2f7609201 100644 --- a/web/04-runpecan.php +++ b/web/04-runpecan.php @@ -163,9 +163,9 @@ // create the workflow execution $userid=get_userid(); if ($userid != -1) { - $q=$pdo->prepare("INSERT INTO workflows (site_id, model_id, notes, folder, hostname, start_date, end_date, advanced_edit, started_at, created_at, user_id) values (:siteid, :modelid, :notes, '', :hostname, :startdate, :enddate, :advanced_edit, NOW(), NOW(), :userid)"); + $q=$pdo->prepare("INSERT INTO workflows (site_id, model_id, notes, folder, hostname, start_date, end_date, advanced_edit, started_at, user_id) values (:siteid, :modelid, :notes, '', :hostname, :startdate, :enddate, :advanced_edit, NOW(), :userid)"); } else { - $q=$pdo->prepare("INSERT INTO workflows (site_id, model_id, notes, folder, hostname, start_date, end_date, advanced_edit, started_at, created_at) values (:siteid, :modelid, :notes, '', :hostname, :startdate, :enddate, :advanced_edit, NOW(), NOW())"); + $q=$pdo->prepare("INSERT INTO workflows (site_id, model_id, notes, folder, hostname, start_date, end_date, advanced_edit, started_at) values (:siteid, :modelid, :notes, '', :hostname, :startdate, :enddate, :advanced_edit, NOW())"); } $q->bindParam(':siteid', $siteid, PDO::PARAM_INT); $q->bindParam(':modelid', $modelid, PDO::PARAM_INT); @@ -212,7 +212,7 @@ } # setup umask so group has write as well -umask(0002); +umask(0000); # create the folder(s) if (!mkdir($folder)) { @@ -260,11 +260,7 @@ fwrite($fh, " ${db_bety_port}" . PHP_EOL); } fwrite($fh, " ${db_bety_database}" . PHP_EOL); -if ($db_bety_type == "mysql") { - fwrite($fh, " MySQL" . PHP_EOL); -} else if ($db_bety_type = "pgsql") { - fwrite($fh, " PostgreSQL" . PHP_EOL); -} +fwrite($fh, " PostgreSQL" . PHP_EOL); fwrite($fh, " true" . PHP_EOL); fwrite($fh, " " . PHP_EOL); @@ -296,16 +292,11 @@ fwrite($fh, " " . PHP_EOL); } -$pft_id=1; fwrite($fh, " " . PHP_EOL); foreach($pft as $p) { fwrite($fh, " " . PHP_EOL); fwrite($fh, " ${p} " . PHP_EOL); - fwrite($fh, " " . PHP_EOL); - fwrite($fh, " ${pft_id}" . PHP_EOL); - fwrite($fh, " " . PHP_EOL); fwrite($fh, " " . PHP_EOL); - $pft_id++; } fwrite($fh, " " . PHP_EOL); @@ -407,9 +398,10 @@ if (is_numeric($val)) { fwrite($fh, " ${val}" . PHP_EOL); } else { - $parts=explode(".", $val, 2); + $parts=explode(".", $val, 3); fwrite($fh, " ${parts[0]}" . PHP_EOL); fwrite($fh, " ${parts[1]}" . PHP_EOL); + fwrite($fh, " ${parts[2]}" . PHP_EOL); if (isset($_REQUEST['fluxusername'])) { fwrite($fh, " ${_REQUEST['fluxusername']}" . PHP_EOL); } @@ -541,7 +533,11 @@ } # create the message - $message = '{"folder": "' . $folder . '", "workflowid": "' . $workflowid . '"}'; + $message = '{"folder": "' . $folder . '", "workflowid": "' . $workflowid . '"'; + if ($model_edit) { + $message .= ', "modeledit": true'; + } + $message .= '}'; send_rabbitmq_message($message, $rabbitmq_uri, $rabbitmq_queue); #done diff --git a/web/07-continue.php b/web/07-continue.php index 9b319de9799..6e5142c5a44 100644 --- a/web/07-continue.php +++ b/web/07-continue.php @@ -53,7 +53,6 @@ $stmt->closeCursor(); close_database(); -$exec = "R_LIBS_USER=\"$R_library_path\" $Rbinary CMD BATCH"; $path = "05-running.php?workflowid=$workflowid&hostname=${hostname}"; if ($pecan_edit) { $path .= "&pecan_edit=pecan_edit"; @@ -74,13 +73,6 @@ $fh = fopen($folder . DIRECTORY_SEPARATOR . "STATUS", 'a') or die("can't open file"); fwrite($fh, "\t" . date("Y-m-d H:i:s") . "\tDONE\t\n"); fclose($fh); - - $exec .= " --continue workflow.R workflow2.Rout"; -} else { - if ($model_edit) { - $exec .= " --advanced"; - } - $exec .= " workflow.R"; } # start the workflow again @@ -91,11 +83,28 @@ } else { $rabbitmq_queue = "pecan"; } - $msg_exec = str_replace("\"", "'", $exec); - $message = '{"folder": "' . $folder . '", "custom_application": "' . $msg_exec . '"}'; + + $message = '{"folder": "' . $folder . '", "workflowid": "' . $workflowid . '"'; + if (file_exists($folder . DIRECTORY_SEPARATOR . "STATUS")) { + $message .= ', "continue": true'; + } else if ($model_edit) { + $message .= ', "modeledit": true'; + } + $message .= '}'; send_rabbitmq_message($message, $rabbitmq_uri, $rabbitmq_queue); } else { chdir($folder); + + $exec = "R_LIBS_USER=\"$R_library_path\" $Rbinary CMD BATCH"; + if (file_exists($folder . DIRECTORY_SEPARATOR . "STATUS")) { + $exec .= " --continue workflow.R workflow2.Rout"; + } else { + if ($model_edit) { + $exec .= " --advanced"; + } + $exec .= " workflow.R"; + } + pclose(popen("$exec &", 'r')); } diff --git a/web/08-finished.php b/web/08-finished.php index 97e590a0938..13d2393f02d 100644 --- a/web/08-finished.php +++ b/web/08-finished.php @@ -542,9 +542,9 @@ function startsWith(haystack, needle) {

Documentation
- Chat Room + Chat Room
- Bug Report + Bug Report

diff --git a/web/checkfailed.php b/web/checkfailed.php index 5e5968231c0..a4f6008635d 100644 --- a/web/checkfailed.php +++ b/web/checkfailed.php @@ -80,9 +80,9 @@ function nextStep() {

Documentation
- Chat Room + Chat Room
- Bug Report + Bug Report

diff --git a/web/common.php b/web/common.php index 23a0dcc14ab..e82330c5abc 100644 --- a/web/common.php +++ b/web/common.php @@ -11,8 +11,10 @@ function get_footer() { return "The PEcAn project is supported by the National Science Foundation (ABI #1062547, ABI #1458021, DIBBS #1261582, ARC #1023477, EF #1318164, EF #1241894, EF #1241891), NASA - Terrestrial Ecosystems, Department of Energy (ARPA-E #DE-AR0000594 and #DE-AR0000598), the Energy Biosciences Institute, and an Amazon AWS in Education Grant. - PEcAn Version 1.7.1"; + Terrestrial Ecosystems, Department of Energy (ARPA-E #DE-AR0000594 and #DE-AR0000598), + Department of Defense, the Arizona Experiment Station, the Energy Biosciences Institute, + and an Amazon AWS in Education Grant. + PEcAn Version 1.7.2"; } function whoami() { @@ -42,9 +44,9 @@ function left_footer() {

Documentation
- Chat Room + Chat Room
- Bug Report + Bug Report setAttribute(PDO::ATTR_ERRMODE, PDO::ERRMODE_EXCEPTION); } catch (PDOException $e) { // handler to input database configurations manually diff --git a/web/config.example.php b/web/config.example.php index 653cd64fcfb..1148ecafe16 100644 --- a/web/config.example.php +++ b/web/config.example.php @@ -104,20 +104,7 @@ # of BETYDB $betydb="/bety"; -# ---------------------------------------------------------------------- -# SIMPLE EDITING OF BETY DATABSE -# ---------------------------------------------------------------------- -# Number of items to show on a page -$pagesize = 30; - -# Location where logs should be written -$logfile = "/home/carya/output/betydb.log"; - -# uncomment the following variable to enable the simple interface -#$simpleBETY = TRUE; - # syncing details - $server_url="192.168.0.5"; // local test server $client_sceret=""; $server_auth_token=""; diff --git a/web/db/bety.css b/web/db/bety.css deleted file mode 100644 index a8e0e0eff02..00000000000 --- a/web/db/bety.css +++ /dev/null @@ -1,204 +0,0 @@ -#cssmenu ul, -#cssmenu li, -#cssmenu span, -#cssmenu a { - margin: 0; - padding: 0; - position: relative; -} -#cssmenu { - height: 49px; - border-radius: 5px 5px 0 0; - -moz-border-radius: 5px 5px 0 0; - -webkit-border-radius: 5px 5px 0 0; - background: #141414; - background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAAxCAIAAACUDVRzAAAAA3NCSVQICAjb4U/gAAAALElEQVQImWMwMrJi+v//PxMDw3+m//8ZoPR/qBgDEhuXGLoeYswhXg8R5gAAdVpfoJ3dB5oAAAAASUVORK5CYII=) 100% 100%; - background: -moz-linear-gradient(top, #32323a 0%, #141414 100%); - background: -webkit-gradient(linear, left top, left bottom, color-stop(0%, #32323a), color-stop(100%, #141414)); - background: -webkit-linear-gradient(top, #32323a 0%, #141414 100%); - background: -o-linear-gradient(top, #32323a 0%, #141414 100%); - background: -ms-linear-gradient(top, #32323a 0%, #141414 100%); - background: linear-gradient(to bottom, #32323a 0%, #141414 100%); - border-bottom: 2px solid #f1f1f1; -} -#cssmenu:after, -#cssmenu ul:after { - content: ''; - display: block; - clear: both; -} -#cssmenu a { - background: #141414; - background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAAxCAIAAACUDVRzAAAAA3NCSVQICAjb4U/gAAAALElEQVQImWMwMrJi+v//PxMDw3+m//8ZoPR/qBgDEhuXGLoeYswhXg8R5gAAdVpfoJ3dB5oAAAAASUVORK5CYII=) 100% 100%; - background: -moz-linear-gradient(top, #32323a 0%, #141414 100%); - background: -webkit-gradient(linear, left top, left bottom, color-stop(0%, #32323a), color-stop(100%, #141414)); - background: -webkit-linear-gradient(top, #32323a 0%, #141414 100%); - background: -o-linear-gradient(top, #32323a 0%, #141414 100%); - background: -ms-linear-gradient(top, #32323a 0%, #141414 100%); - background: linear-gradient(to bottom, #32323a 0%, #141414 100%); - color: #ffffff; - display: inline-block; - font-family: Helvetica, Arial, Verdana, sans-serif; - font-size: 12px; - line-height: 49px; - padding: 0 20px; - text-decoration: none; -} -#cssmenu ul { - list-style: none; -} -#cssmenu > ul { - float: left; -} -#cssmenu > ul > li { - float: left; -} -#cssmenu > ul > li:hover:after { - content: ''; - display: block; - width: 0; - height: 0; - position: absolute; - left: 50%; - bottom: 0; - border-left: 10px solid transparent; - border-right: 10px solid transparent; - border-bottom: 10px solid #f1f1f1; - margin-left: -10px; -} -#cssmenu > ul > li:first-child > a { - border-radius: 5px 0 0 0; - -moz-border-radius: 5px 0 0 0; - -webkit-border-radius: 5px 0 0 0; -} -#cssmenu > ul > li:last-child > a { - border-radius: 0 5px 0 0; - -moz-border-radius: 0 5px 0 0; - -webkit-border-radius: 0 5px 0 0; -} -#cssmenu > ul > li.active > a { - box-shadow: inset 0 0 3px #000000; - -moz-box-shadow: inset 0 0 3px #000000; - -webkit-box-shadow: inset 0 0 3px #000000; - background: #070707; - background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAAxCAIAAACUDVRzAAAAA3NCSVQICAjb4U/gAAAALklEQVQImWNQU9Nh+v//PxMDw3+m//8ZkNj/mRgYIHxy5f//Z0BSi18e2TwS5QG4MGB54HL+mAAAAABJRU5ErkJggg==) 100% 100%; - background: -moz-linear-gradient(top, #26262c 0%, #070707 100%); - background: -webkit-gradient(linear, left top, left bottom, color-stop(0%, #26262c), color-stop(100%, #070707)); - background: -webkit-linear-gradient(top, #26262c 0%, #070707 100%); - background: -o-linear-gradient(top, #26262c 0%, #070707 100%); - background: -ms-linear-gradient(top, #26262c 0%, #070707 100%); - background: linear-gradient(to bottom, #26262c 0%, #070707 100%); -} -#cssmenu > ul > li:hover > a { - background: #070707; - background:url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAAxCAIAAACUDVRzAAAAA3NCSVQICAjb4U/gAAAALklEQVQImWNQU9Nh+v//PxMDw3+m//8ZkNj/mRgYIHxy5f//Z0BSi18e2TwS5QG4MGB54HL+mAAAAABJRU5ErkJggg==) 100% 100%; - background: -moz-linear-gradient(top, #26262c 0%, #070707 100%); - background: -webkit-gradient(linear, left top, left bottom, color-stop(0%, #26262c), color-stop(100%, #070707)); - background: -webkit-linear-gradient(top, #26262c 0%, #070707 100%); - background: -o-linear-gradient(top, #26262c 0%, #070707 100%); - background: -ms-linear-gradient(top, #26262c 0%, #070707 100%); - background: linear-gradient(to bottom, #26262c 0%, #070707 100%); - box-shadow: inset 0 0 3px #000000; - -moz-box-shadow: inset 0 0 3px #000000; - -webkit-box-shadow: inset 0 0 3px #000000; -} -#cssmenu > ul > li ul a { - color: #333; -} -#cssmenu .has-sub { - z-index: 1; -} -#cssmenu .has-sub:hover > ul { - display: block; -} -#cssmenu .has-sub ul { - display: none; - position: absolute; - width: 200px; - top: 100%; - left: 0; -} -#cssmenu .has-sub ul li { - *margin-bottom: -1px; -} -#cssmenu .has-sub ul li a { - background: #f1f1f1; - border-bottom: 1px dotted #f7f7f7; - filter: none; - font-size: 11px; - display: block; - line-height: 120%; - padding: 10px; -} -#cssmenu .has-sub ul li:hover a { - background: #d8d8d8; -} -#cssmenu .has-sub .has-sub:hover > ul { - display: block; -} -#cssmenu .has-sub .has-sub ul { - display: none; - position: absolute; - left: 100%; - top: 0; -} -#cssmenu .has-sub .has-sub ul li a { - background: #d8d8d8; - border-bottom: 1px dotted #e7e7e7; -} -#cssmenu .has-sub .has-sub ul li a:hover { - background: #bebebe; -} - -#list { - display: table; - width: 100%; -} -#list .row { - display: table-row; - width: 100%; -} -#list .row:nth-child(even) { - background: #EEE; -} -#list .row:nth-chard(odd) { - background: #FFF; -} -#list .hdr { - background: #AAA; - display: table-cell; - text-align: left; - font-weight: bold; -} -#list .col { - display: table-cell; -} -#list .id { - width: 100px; -} - -#editor { - display: table; - width: 100%; -} -#editor .row { - display: table-row; - width: 100%; -} -#editor .key { - display: table-cell; - width: 10%; - vertical-align: center; -} -#editor .val { - display: table-cell; - width: 90%; -} - -.val input, textarea, select { - -webkit-box-sizing: border-box; - -moz-box-sizing: border-box; - box-sizing: border-box; - width: 100%; - text-align: left; -} diff --git a/web/db/common.php b/web/db/common.php deleted file mode 100644 index 6b02fb6fafd..00000000000 --- a/web/db/common.php +++ /dev/null @@ -1,1243 +0,0 @@ - array( - "section" => "BETY", - "list" => "SELECT id, author, title FROM citations", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "dbfiles" => array( - "section" => "BETY", - "list" => "SELECT dbfiles.id as id, machines.hostname as machine, dbfiles.file_path as filepath, dbfiles.file_name as filename FROM dbfiles, machines WHERE dbfiles.machine_id=machines.id", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "formats" => array( - "section" => "BETY", - "list" => "SELECT id, name, mime_type FROM formats", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "inputs" => array( - "section" => "BETY", - "list" => "SELECT inputs.id AS id, inputs.name AS name, CONCAT(sitename, ', ', city, ', ', state, ', ', country) as site, count(dbfiles.id) AS files FROM inputs". - " LEFT JOIN sites ON sites.id = inputs.site_id" . - " LEFT JOIN dbfiles ON dbfiles.container_id = inputs.id AND dbfiles.container_type='Input'" . - " GROUP BY inputs.id, site", - "files" => TRUE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "sites" => array( - "section" => "BETY", - "list" => "SELECT id, sitename, city, state, country FROM sites", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "species" => array( - "section" => "BETY", - "list" => "SELECT id, genus, species, scientificname FROM species", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "traits" => array( - "section" => "BETY", - "list" => "SELECT traits.id AS id, CONCAT(sitename, ', ', city, ', ', state, ', ', country) as site, species.commonname AS speciename, statname FROM traits". - " LEFT JOIN sites ON sites.id = traits.site_id" . - " LEFT JOIN species ON species.id = traits.specie_id", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "users" => array( - "section" => "BETY", - "list" => "SELECT id, login, name, email FROM users", - "files" => FALSE, - "level" => array( - "show" => 1, - "edit" => 1, - ) - ), - "ensembles" => array( - "section" => "PEcAn", - "list" => "SELECT id, runtype, workflow_id FROM ensembles", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "models" => array( - "section" => "PEcAn", - "list" => "SELECT models.id, models.model_name AS name, models.revision, count(dbfiles.id) AS files FROM models" . - " LEFT JOIN dbfiles ON dbfiles.container_id = models.id AND dbfiles.container_type='Model'" . - " GROUP BY models.id", - "files" => TRUE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "runs" => array( - "section" => "PEcAn", - "list" => "SELECT workflows.id as id, CONCAT(sitename, ', ', city, ', ', state, ', ', country) as site, models.model_name as model, workflows.started_at as start_date, workflows.finished_at as end_date FROM workflows, sites, models WHERE workflows.site_id=sites.id AND workflows.model_id=models.id", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ), - "workflows" => array( - "section" => "PEcAn", - "list" => "SELECT runs.id as id, CONCAT(sitename, ', ', city, ', ', state, ', ', country) AS site, CONCAT(model_name, ' (', revision, ')') AS model, runs.started_at as start_date, runs.finished_at as end_date FROM runs, sites, models WHERE runs.site_id=sites.id AND runs.model_id=models.id", - "files" => FALSE, - "level" => array( - "show" => 4, - "edit" => 3, - ) - ) -); - -# make sure we do a session start -session_start(); - -if (!isset($simpleBETY) || !$simpleBETY) { - header( "Location: ../index.php"); - exit; -} - -# ---------------------------------------------------------------------- -# DATABASE FUNCTIONS -# ---------------------------------------------------------------------- -function open_database() { - global $db_bety_hostname; - global $db_bety_username; - global $db_bety_password; - global $db_bety_database; - global $db_bety_type; - global $pdo; - - $pdo = new PDO("${db_bety_type}:host=${db_bety_hostname};dbname=${db_bety_database}", $db_bety_username, $db_bety_password); -} - -function close_database() { - global $pdo; - $pdo = null; -} - -function error_database() { - global $pdo; - $tmp = $pdo->errorInfo(); - return $tmp[2]; -} - -function column_names($table) { - global $pdo; - - $rs = $pdo->query("SELECT * FROM ${table} LIMIT 0"); - for ($i = 0; $i < $rs->columnCount(); $i++) { - $col = $rs->getColumnMeta($i); - $columns[$col['name']] = $col['native_type']; - } - $rs->closeCursor(); - return $columns; -} - -# ---------------------------------------------------------------------- -# COMMON HTML FUNCTIONS -# ---------------------------------------------------------------------- -function print_header($table="") { - global $sections; - - open_database(); - - print "\n"; - print "\n"; - if ($table == "") { - print "PEcAn DB\n"; - } else { - print "PEcAn DB [{$sections[$table]['section']}/{$table}]\n"; - } - print "\n"; - print "\n"; - print "\n"; -} - -function print_footer($msg="") { - if ($msg != "") { - print "
\n"; - print "$msg\n"; - } - print "
\n"; - print "\n"; - print "\n"; - print "\n"; - print "\n"; - - close_database(); -} - -function print_menu($active) { - global $sections; - - $menu=array("Home" => "index.php"); - - foreach($sections as $key => $entry) { - $section = $entry['section']; - # make sure there is an entry for the section - if (empty($menu[$section])) { - $menu[$section] = array(); - } - - # Add the entry - if (get_page_acccess_level() <= $entry['level']['show']) { - $menu[$section][$key]["#"] = "list.php?table={$key}"; - - # if edit capabilities add new option - if (get_page_acccess_level() <= $entry['level']['edit']) { - $menu[$section][$key]["New"] = "edit.php?table={$key}&id=-1"; - } - } - } - - if (check_login()) { - $menu[get_user_name()] = array( - "Edit" => "edit.php?table=users&id=" . get_userid(), - "Logout" => "logout.php", - ); - } else { - $menu["Login"] = "login.php"; - } - - print "
\n"; - print_menu_entry($active, $menu); - print "

\n"; -} - -function print_menu_entry($active, $menu) { - $keys = array_keys($menu); - $last = end($keys); - print "
    \n"; - foreach($menu as $key => $val) { - if ($key == "#") { - continue; - } - $class = ""; - if ($active == $key) { - $class .= " active"; - } - if (is_array($val)) { - $class .= " has-sub"; - } - if ($last == $key) { - $class .= " last"; - } - $class=trim($class); - if ($class != "") { - print "
  • "; - } else { - print "
  • "; - } - if (is_array($val)) { - if (array_key_exists("#", $val)) { - $url = $val['#']; - } else { - $url = "#"; - } - print "$key"; - } else if ($val != "") { - print "$key"; - } else { - print "$key"; - } - if (is_array($val)) { - print "\n"; - print_menu_entry($active, $val); - } - print "
    • \n"; - } - print "
\n"; -} - -# ---------------------------------------------------------------------- -# USER FUNCTIONS -# ---------------------------------------------------------------------- - -function login($username, $password) { - global $pdo; - - if (isset($_SESSION['userid'])) { - return TRUE; - } - - $q=$pdo->prepare("SELECT * FROM users WHERE login=:username"); - $q->bindParam(':username', $username, PDO::PARAM_STR); - if ($q->execute() === FALSE) { - die('Invalid query : ' . error_database()); - } - $row = $q->fetch(PDO::FETCH_ASSOC); - $q->closeCursor(); - - if (!isset($row['salt'])) { - return FALSE; - } - - $digest = encrypt_password($password, $row['salt']); - - if ($digest == $row['crypted_password']) { - $_SESSION['userid']=$row['id']; - $_SESSION['username']=$row['name']; - $_SESSION['useraccess']=$row['access_level']; - $_SESSION['userpageaccess']=$row['page_access_level']; - return TRUE; - } else { - return FALSE; - } -} - -function encrypt_password($password, $salt) { - global $REST_AUTH_SITE_KEY; - global $REST_AUTH_DIGEST_STRETCHES; - - $digest=$REST_AUTH_SITE_KEY; - for($i=0; $i<$REST_AUTH_DIGEST_STRETCHES; $i++) { - $digest=sha1($digest . "--" . $salt . "--" . $password . "--" . $REST_AUTH_SITE_KEY); - } - return $digest; -} - -function logout() { - unset($_SESSION['userid']); - unset($_SESSION['username']); - unset($_SESSION['useraccess']); - unset($_SESSION['userpageaccess']); -} - -function get_userid() { - if (isset($_SESSION['userid'])) { - return $_SESSION['userid']; - } else { - return -1; - } -} - -function check_login() { - return isset($_SESSION['userid']); -} - -function get_user_name() { - if (isset($_SESSION['username'])) { - return $_SESSION['username']; - } else { - return FALSE; - } -} - -function get_acccess_level() { - global $anonymous_level; - if (isset($_SESSION['useraccess'])) { - return $_SESSION['useraccess']; - } else { - return $anonymous_level; - } -} - -function get_page_acccess_level() { - global $anonymous_page; - if (isset($_SESSION['userpageaccess'])) { - return $_SESSION['userpageaccess']; - } else { - return $anonymous_page; - } -} - -# ---------------------------------------------------------------------- -# LIST PAGE FUNCTIONS -# ---------------------------------------------------------------------- - -function print_list($table, $query) { - global $pagesize; - global $sections; - global $pdo; - - $idkey = 'id'; - - # handle any information send in inputs form - $msg = ""; - if (isset($_REQUEST['action'])) { - if ($_REQUEST['action'] == "delete") { - if (($table != "users") || ((get_page_acccess_level() == 1) && ($_REQUEST['kill'] != get_userid()))) { - $q = "DELETE FROM $table WHERE ${idkey}={$_REQUEST['kill']};"; - if ($pdo->query($q) === FALSE) { - $msg = "Error updating database : " . error_database() . "
{$q}"; - editor_log("FAIL", $q); - } else { - $msg .= "Removed {$_REQUEST['kill']} from {$table}"; - editor_log("OK", $q); - } - } - } - } - - if (isset($_REQUEST['pagesize'])) { - $pagesize = $_REQUEST['pagesize']; - } - - # fix access_level - if (($table != "users") && (get_page_acccess_level() > 1)) { - if (in_array('access_level', array_keys(column_names($table)))) { - $pos = stripos($query, "WHERE"); - if ($pos !== false) { - $head = substr($query, 0, $pos + 5); - $tail = substr($query, $pos + 6); - $query = "$head (access_level >= " . get_acccess_level() . " OR access_level IS NULL) AND $tail"; - } else { - $pos = stripos($query, "group"); - if ($pos ) { - $head = substr($query, 0, $pos); - $tail = substr($query, $pos); - $query = "$head WHERE (access_level >= " . get_acccess_level() . " OR access_level IS NULL) $tail"; - } else { - $query .= " WHERE (access_level >= " . get_acccess_level() . " OR access_level IS NULL)"; - } - } - } - } - - # get the input that we want to show - if (isset($_REQUEST['page'])) { - $current = $_REQUEST['page']; - } else { - $current = 1; - } - $result = $pdo->query($query . " ORDER BY $idkey LIMIT $pagesize OFFSET " . (($current - 1) * $pagesize)); - if (!$result) { - die("Invalid query : $query " . error_database()); - } - - - print "
\n"; - print "
\n"; - print "
Action
\n"; - for ($i = 0; $i < $result->columnCount(); $i++) { - $md = $result->getColumnMeta($i); - $key = $md['name']; - if ($key == $idkey) { - print "
$key
\n"; - } - } - for ($i = 0; $i < $result->columnCount(); $i++) { - $md = $result->getColumnMeta($i); - $key = $md['name']; - if ($key != $idkey) { - print "
$key
\n"; - } - } - print "
\n"; - - while($row = @$result->fetch(PDO::FETCH_ASSOC)) { - print "
\n"; - if (array_key_exists($idkey, $row)) { - print "
"; - print "S "; - if (get_page_acccess_level() <= $sections[$table]['level']['edit']) { - print "E "; - } - if (get_page_acccess_level() <= $sections[$table]['level']['edit'] && (($table != "users") || ($row[$idkey] != get_userid()))) { - $url="list.php?table={$table}&page={$current}&action=delete&kill={$row[$idkey]}"; - print "D "; - } - print "
\n"; - print "
{$row[$idkey]}
\n"; - } - foreach ($row as $key => $value) { - if ($key != $idkey) { - print "
$value
\n"; - } - } - print "
\n"; - } - print "
\n"; - - $result->closeCursor(); - - print_pages($current, $pagesize, $query, $table); - - return $msg; -} - -function print_pages($current, $pagesize, $query, $table) { - global $pdo; - - # count items - $result = $pdo->query($query); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $count = $result->rowCount(); - $result->closeCursor(); - - if ($count <= $pagesize) { - return; - } - - $pages = ""; - if ($count > 0) { - $numpages = ceil($count / $pagesize); - - if ($numpages <= 15) { - for ($i=1; $i<$numpages+1; $i++) { - if ($i == $current) { - $pages .= " $i "; - } else { - $pages .= " $i "; - } - } - } else { - if ($current < 8) { - for ($i=1; $i<12; $i++) { - if ($i == $current) { - $pages .= " $i "; - } else { - $pages .= " $i "; - } - } - $pages .= "..."; - for ($i=$numpages-2; $i<$numpages; $i++) { - $pages .= " $i "; - } - } else { - for ($i=1; $i<3; $i++) { - $pages .= " $i "; - } - $pages .= "..."; - if ($current > ($numpages - 7)) { - for ($i=$numpages-10; $i<$numpages; $i++) { - if ($i == $current) { - $pages .= " $i "; - } else { - $pages .= " $i "; - } - } - } else { - for ($i=$current-4; $i<$current+5; $i++) { - if ($i == $current) { - $pages .= " $i "; - } else { - $pages .= " $i "; - } - } - $pages .= "..."; - for ($i=$numpages-2; $i<$numpages; $i++) { - $pages .= " $i "; - } - } - } - } - } - - print "

"; - if ($pages != "") { - if ($current > 1) { - $pages = "< $pages"; - } else { - $pages = "< $pages"; - } - if ($current < $numpages) { - $pages = "$pages >"; - } else { - $pages = "> $pages"; - } - print "

$pages
"; - } - print "

\n"; -} - -# ---------------------------------------------------------------------- -# SHOW FILES ASSOCIATED -# ---------------------------------------------------------------------- - -function show_files($id, $table, $readonly) { - global $pdo; - global $sections; - - $type = ucfirst(strtolower(substr($table, 0, -1))); - - # process the form - $msg = ""; - if (!$readonly && isset($_REQUEST['action'])) { - if ($_REQUEST['action'] == "add") { - $query = "UPDATE dbfiles SET container_id={$id}, container_type='{$type}' WHERE id={$_REQUEST['dbid']};"; - if ($pdo->query($query) === FALSE) { - $msg = "Error updating database : [" . error_database() . "] " . $pdo->errorInfo($pdo) . "
"; - editor_log("FAIL", $query); - } else { - $msg .= "Added dbfiles={$_REQUEST['dbid']} to inputs={$_REQUEST['id']}
\n"; - editor_log("OK", $query); - } - } - - if ($_REQUEST['action'] == "del") { - $query = "UPDATE dbfiles SET container_id=NULL WHERE id={$_REQUEST['dbid']};"; - if ($pdo->query($query) === FALSE) { - $msg = "Error updating database : [" . error_database() . "] " . $pdo->errorInfo($pdo) . "
"; - editor_log("FAIL", $query); - } else { - $msg .= "Removed dbfiles={$_REQUEST['dbid']} from inputs={$_REQUEST['id']}
\n"; - editor_log("OK", $query); - } - } - } - - print "
\n"; - print " Existing Files
\n"; - - # get the input that we want to show - $query="SELECT dbfiles.id, concat(machines.hostname, ':', dbfiles.file_path, '/', dbfiles.file_name) as filename" . - " FROM dbfiles, machines" . - " WHERE dbfiles.container_id={$id} AND dbfiles.container_type='{$type}' AND machines.id=dbfiles.machine_id;"; - $result = $pdo->query($query); - if (!$result) { - die("Invalid query [$query] " . $pdo->errorInfo($pdo)); - } - if ($result->rowCount() > 0) { - print " \n"; - print "
\n"; - print "
\n"; - print "
\n"; - print " S\n"; - if (!$readonly) { - print " E\n"; - print " D\n"; - } - print "
\n"; - print "
\n"; - print " \n"; - print "
\n"; - print "
\n"; - print "
\n"; - } - - if (!$readonly) { - print "
\n"; - print " Add a Files
\n"; - - # get the input that we want to show - $query="SELECT dbfiles.id, concat(machines.hostname, ':', dbfiles.file_path, '/', dbfiles.file_name) as filename" . - " FROM dbfiles, machines" . - " WHERE dbfiles.container_id IS NULL AND machines.id=dbfiles.machine_id;"; - $result = $pdo->query($query); - if (!$result) { - die("Invalid query [$query] " . $pdo->errorInfo($pdo)); - } - if ($result->rowCount() > 0) { - print "
\n"; - print "
\n"; - print "
\n"; - print " S\n"; - if (!$readonly) { - print " E\n"; - print " A\n"; - } - print "
\n"; - print "
\n"; - print " \n"; - print "
\n"; - print "
\n"; - print "
\n"; - } - } - - return $msg; -} - - - -# ---------------------------------------------------------------------- -# EDIT PAGE FUNCTIONS -# ---------------------------------------------------------------------- - -function editor_log($status, $query) { - global $logfile; - if (is_writeable($logfile)) { - file_put_contents($logfile, date("c") . "\t${status}\t" . get_userid() . "\t" . get_user_name() . "\t${query}\n", FILE_APPEND); - } -} - -function editor_update($id, $table) { - global $pdo; - - # get the row from the database (this can be empty) - $result = $pdo->query("SELECT * FROM $table WHERE id=$id;"); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $row = $result->fetch(PDO::FETCH_ASSOC); - $result->closeCursor(); - - $msg = ""; - $set = ""; - foreach($_REQUEST as $key => $val) { - if ($key == "id") continue; - if ($key == "table") continue; - if ($key == "action") continue; - - $pre = substr($key, 0, 1); - $key = substr($key, 2); - - if ($val == $row[$key]) { - continue; - } - - if ($pre == 's') { - if ($set != "") { - $set .= ", "; - } - if ($val == "") { - $set .= " $key=NULL"; - } else { - $set .= " $key=" . $pdo->quote($val); - } - } else if ($pre == 'n') { - if ($set != "") { - $set .= ", "; - } - $set .= " $key=" . $pdo->quote($val); - } else if ($pre == 'b') { - if ($set != "") { - $set .= ", "; - } - if ($val == 'on') { - $set .= " $key=true"; - } else { - $set .= " $key=false"; - } - } else if ($pre == 'u') { - if ($set != "") { - $set .= ", "; - } - $set .= " $key=NOW()"; - } else if ($pre == 'p') { - $salt = $_REQUEST['s_salt']; - if (($val != "") && ($salt != "")) { - $val = encrypt_password($val, $salt); - if ($set != "") { - $set .= ", "; - } - $set .= " $key=" . $pdo->quote($val); - } - } - } - if ($set != "") { - if ($id == "-1") { - $query = "INSERT INTO $table SET $set;"; - $pdo->query($query, $param); - $id = $pdo->lastInsertId(); - if (!$pdo->query($query)) { - $msg = "Error updating database : " . error_database() . "
$query"; - editor_log("FAIL", $query); - } else { - $msg .= "Added into $table table id=$id
\n"; - editor_log("OK", $query); - } - } else { - $query = "UPDATE $table SET $set WHERE id=$id;"; - if (!$pdo->query($query)) { - $msg = "Error updating database : " . error_database() . "
$query"; - editor_log("FAIL", $query); - } else { - $msg .= "Updated $table table for id=$id
\n"; - editor_log("OK", $query); - } - } - } else { - if ($id == "-1") { - $result = $pdo->query("SELECT id FROM $table ORDER BY id ASC LIMIT 1;"); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $row = $result->fetch(PDO::FETCH_ASSOC); - $id = $row[0]; - $result->closeCursor(); - $msg .= "No data entered showing first $table.
\n"; - } else { - $msg .= "Nothing changed.
\n"; - } - } - - return $msg; -} - -function print_entry($id, $table, $readonly) { - global $pdo; - global $sections; - - $edit = false; - if ($readonly) { - if ($sections[$table]['level']['show'] < get_page_acccess_level() && ($table != "users" || $id != get_userid())) { - #header("Location: index.php"); - die("no access"); - } - if ($sections[$table]['level']['edit'] >= get_page_acccess_level() || ($table == "users" && $id == get_userid())) { - $edit = true; - } - } else { - if ($sections[$table]['level']['edit'] < get_page_acccess_level() && ($table != "users" || $id != get_userid())) { - #header("Location: index.php"); - die("no access"); - } - } - - # update database - $msg = ""; - if (!$readonly && isset($_REQUEST['action']) && $_REQUEST['action'] == "update") { - $msg = editor_update($id, $table); - } - - # print navigation - print_prev_next($id, $table, $edit); - - if ($readonly) { - $disabled = "disabled"; - } else { - $disabled = ""; - } - - # get the row from the database (this can be empty) - $result = $pdo->query("SELECT * FROM $table WHERE id=$id;"); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $row = $result->fetch(PDO::FETCH_ASSOC); - $result->closeCursor(); - - # check access_level - if (is_array($row) && array_key_exists('access_level', $row) && ($row['access_level'] != "") && ($row['access_level'] != "-1")) { - if (get_acccess_level() > $row['access_level']) { - header("Location: index.php"); - return; - } - } - - if (!$readonly) { - print "
\n"; - print "\n"; - print "\n"; - } - print "
\n"; - - foreach(column_names($table) as $key => $type) { - if ($key == "id") { - $fancykey = $key; - } else { - $fancykey = ucwords(str_replace("_", " ", str_replace("_id", "", $key))); - } - if (is_array($row) && array_key_exists($key, $row)) { - $val = $row[$key]; - } else { - $val = ""; - } - - if (substr($val, 0, 4) == "http") { - $fancykey = "$fancykey"; - } - - print "
\n"; - if ($key == "id") { - if ($id == -1) { - $val = "new entry"; - } - print "
$fancykey
\n"; - print "
\n"; - } else if ($key == "created_at") { - if ($id == -1) { - $val = 'now'; - print "\n"; - } - print "
$fancykey
\n"; - print "
\n"; - } else if ($key == "updated_at") { - if ($id != -1) { - print "\n"; - } - print "
$fancykey
\n"; - print "
\n"; - } else if ($key == "site_id") { - print "
$fancykey
\n"; - print "
\n"; - print_sites_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "model_id") { - print "
$fancykey
\n"; - print "
\n"; - print_models_options("n_$key", $val, $readonly); - print "
\n"; - } else if (($key == "user_id") || ($key == "created_user_id") || ($key == "updated_user_id")) { - print "
$fancykey
\n"; - print "
\n"; - print_users_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "machine_id") { - print "
$fancykey
\n"; - print "
\n"; - print_machines_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "format_id") { - print "
$fancykey
\n"; - print "
\n"; - print_formats_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "citation_id") { - print "
$fancykey
\n"; - print "
\n"; - print_citations_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "specie_id") { - print "
$fancykey
\n"; - print "
\n"; - print_species_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "variable_id") { - print "
$fancykey
\n"; - print "
\n"; - print_variables_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "treatment_id") { - print "
$fancykey
\n"; - print "
\n"; - print_treatments_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "cultivar_id") { - print "
$fancykey
\n"; - print "
\n"; - print_cultivars_options("n_$key", $val, $readonly); - print "
\n"; - } else if ($key == "page_access_level") { - if (get_page_acccess_level() == 1) { - $sel_readonly=$readonly; - } else { - $sel_readonly=true; - } - print "
$fancykey
\n"; - print "
\n"; - print_select_array_options("n_$key", $val, $sel_readonly, array( - "1" => "Administrator", - "2" => "Manager", - "3" => "Creator", - "4" => "Viewer")); - print "
\n"; - } else if ($key == "access_level") { - if ((get_page_acccess_level() == 1) || ($val == "") || ($val == "-1")) { - $sel_readonly=$readonly; - } else { - $sel_readonly=true; - } - print "
$fancykey
\n"; - print "
\n"; - print_select_array_options("n_$key", $val, $sel_readonly, array( - "1" => "Restricted", - "2" => "Internal EBI & Collaborators", - "3" => "Creator", - "4" => "Viewer")); - print "
\n"; - } else if ($key == "salt") { - if ($id == -1) { - $val = uniqid("", true); - print "\n"; - } else { - print "\n"; - } - print "
$fancykey
\n"; - print "
\n"; - } else if ($key == "crypted_password") { - print "
$fancykey
\n"; - print "
\n"; - } else if (stristr($type, "text")) { - print "
$fancykey
\n"; - print "
\n"; - } else if (stristr($type, "tinyint")) { - print "
$fancykey
\n"; - print "
\n"; - } else { - print "
$fancykey
\n"; - print "
\n"; - } - print "
\n"; - - } - - if (!$readonly) { - print "
\n"; - print "
\n"; - print "
\n"; - print "
\n"; - } - print "
\n"; - if (!$readonly) { - print "
\n"; - } - - return $msg; -} - -function print_prev_next($id, $table, $edit=false) { - global $pdo; - - print "
\n"; - print "All"; - - $and = ""; - $where = ""; - if (in_array('access_level', column_names($table))) { - $and = " AND (access_level >= " . get_acccess_level() . " OR access_level IS NULL)"; - $where = " WHERE (access_level >= " . get_acccess_level() . " OR access_level IS NULL)"; - } - - $result = $pdo->query("SELECT id FROM {$table} WHERE id < ${id} ${and} ORDER BY id DESC LIMIT 1;"); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $row = $result->fetch(PDO::FETCH_NUM); - $prev = $row[0]; - $result->closeCursor(); - if ($prev == "") { - $result = $pdo->query("SELECT id FROM {$table} ${where} ORDER BY id DESC LIMIT 1;"); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $row = $result->fetch(PDO::FETCH_NUM); - $prev = $row[0]; - $result->closeCursor(); - } - print " Prev"; - - $result = $pdo->query("SELECT id FROM $table WHERE id > ${id} ${and} ORDER BY id ASC LIMIT 1;"); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $row = $result->fetch(PDO::FETCH_NUM); - $next = $row[0]; - $result->closeCursor(); - if ($next == "") { - $result = $pdo->query("SELECT id FROM $table ${where} ORDER BY id ASC LIMIT 1;"); - if (!$result) { - die('Invalid query : ' . error_database()); - } - $row = $result->fetch(PDO::FETCH_NUM); - $next = $row[0]; - $result->closeCursor(); - } - print " Next"; - - if ($edit) { - print " Edit\n"; - } else if (strpos($_SERVER['SCRIPT_NAME'], 'show.php') === false) { - print " Show\n"; - } - - print "

\n"; -} - -function print_users_options($name, $myid, $readonly=false) { - $query = "SELECT id, CONCAT(name, ' <', email, '>') AS name FROM users"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_machines_options($name, $myid, $readonly=false) { - $query = "SELECT id, hostname AS name FROM machines"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_formats_options($name, $myid, $readonly=false) { - $query = "SELECT id, name FROM formats"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_sites_options($name, $myid, $readonly=false) { - $query = "SELECT id, CONCAT(coalesce(sitename, ''), ', ', coalesce(city, ''), ', ', coalesce(state, ''), ', ', coalesce(country, '')) AS name FROM sites"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_models_options($name, $myid, $readonly=false) { - $query = "SELECT id, CONCAT(coalesce(model_name, ''), ' ', coalesce(revision, ')') AS name FROM models"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_citations_options($name, $myid, $readonly=false) { - $query = "SELECT id, CONCAT(coalesce(author, ''), ' \"', coalesce(title, ''), '\" ') AS name FROM citations"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_species_options($name, $myid, $readonly=false) { - $query = "SELECT id, scientificname AS name FROM species"; - if ($readonly) { - print_select_options($name, $myid, $readonly, $query); - } else { - if ($myid == -1) { - $values = array(); - } else { - $values = array($myid => "Current value " . $myid); - } - print_select_array_options($name, $myid, $readonly, $values); - } -} - -function print_variables_options($name, $myid, $readonly=false) { - $query = "SELECT id, name FROM variables"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_treatments_options($name, $myid, $readonly=false) { - $query = "SELECT id, name FROM treatments"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_cultivars_options($name, $myid, $readonly=false) { - $query = "SELECT id, name FROM cultivars"; - print_select_options($name, $myid, $readonly, $query); -} - -function print_select_options($name, $myid, $readonly, $query) { - global $pdo; - - if ($readonly) { - if ($myid == "") { - $query .= " WHERE id=-1"; - } else { - $query .= " WHERE id=${myid}"; - } - } - $result = $pdo->query($query . " ORDER BY name"); - if (!$result) { - die('Invalid query "' . $query . '" : [' . error_database() . ']' . error_database()); - } - - if ($readonly) { - print "\n"; - } - $html = ""; - $foundit = false; - while($row = @$result->fetch(PDO::FETCH_ASSOC)) { - $name = $row['name']; - if ($name == "") { - $name = "NO NAME {$row['id']}"; - } - if ($myid == $row['id']) { - $html .= "\n"; - $foundit = true; - } else if (!$readonly) { - $html .= "\n"; - } - } - if (! $foundit) { - if (($myid == "") || ($myid == "-1")) { - $html = "\n" . $html; - } else { - $html = "\n" . $html; - } - } - print $html; - print "\n"; - - $result->closeCursor(); -} - -function print_select_array_options($name, $myid, $readonly, $values) { - if ($readonly) { - print "\n"; - } - $html = ""; - $foundit = false; - foreach ($values as $key => $val) { - if ($myid == $key) { - $html .= "\n"; - $foundit = true; - } else if (!$readonly) { - $html .= "\n"; - } - } - if (! $foundit) { - if (($myid == "") || ($myid == "-1")) { - $html = "\n" . $html; - } else { - $html = "\n" . $html; - } - } - print $html; - print "\n"; -} - -# ---------------------------------------------------------------------- -# COMMON FUNCTIONS -# ---------------------------------------------------------------------- -function starts_with($haystack, $needle) { - return !strncmp($haystack, $needle, strlen($needle)); -} -?> diff --git a/web/db/edit.php b/web/db/edit.php deleted file mode 100644 index d7454b69f9c..00000000000 --- a/web/db/edit.php +++ /dev/null @@ -1,45 +0,0 @@ -{$tmp}"; - } -} - -# print footer of html -print_footer($msg); -?> diff --git a/web/db/index.php b/web/db/index.php deleted file mode 100644 index f23d3943332..00000000000 --- a/web/db/index.php +++ /dev/null @@ -1,21 +0,0 @@ - - -

Welcome

- -

Welcome to the EBI Biofuel Ecophysiological Traits and Yields Database, -BETY-DB. The emerging biofuel industry may aid in reducing greenhouse gas -emissions and decreasing dependence on foreign oil importation. How to -develop and implement biofuel crops in an ecologically and economically -sustainable way requires evaluating the growth and functionality of biofuel -crops from the local scale to the regional scale. BETY-DB has been -developed to support research, agriculture, and policy by synthesizing -available information on potential biofuel crops.

- - diff --git a/web/db/list.php b/web/db/list.php deleted file mode 100644 index d5c27d3635d..00000000000 --- a/web/db/list.php +++ /dev/null @@ -1,27 +0,0 @@ - $section['level']['show']) { - #header("Location: index.php"); - die("Not authorized."); -} - -# print top -print_header($table); -print_menu($section); - -# create query to show things -$msg = print_list($table, $sections[$table]['list']); - -# print footer of html -print_footer($msg); -?> diff --git a/web/db/login.php b/web/db/login.php deleted file mode 100644 index ee28b9b8a3c..00000000000 --- a/web/db/login.php +++ /dev/null @@ -1,37 +0,0 @@ - - -
-
-
-
Login
-
-
-
-
Password
-
-
-
-
-
-
-
-
- - diff --git a/web/db/logout.php b/web/db/logout.php deleted file mode 100644 index eb25e2823bf..00000000000 --- a/web/db/logout.php +++ /dev/null @@ -1,7 +0,0 @@ - diff --git a/web/db/show.php b/web/db/show.php deleted file mode 100644 index daed22f93fc..00000000000 --- a/web/db/show.php +++ /dev/null @@ -1,40 +0,0 @@ - diff --git a/web/js/browndog.js b/web/js/browndog.js index 1a1185a91fb..79958a07e25 100644 --- a/web/js/browndog.js +++ b/web/js/browndog.js @@ -1,50 +1,50 @@ //Brown Dog graph function browndog_add() { - var node = document.getElementById('browndog_img'); + var node = document.getElementById("browndog_img"); if (node) return; - - var graphic = $('') - .attr('src', 'images/browndog-small-transparent.gif') - .attr('width', '25') - .attr('id', 'browndog_img') - .css('position', 'absolute') - .css('left', '0px') - .css('bottom', '45px'); + + var graphic = $("") + .attr("src", "images/browndog-small-transparent.gif") + .attr("width", "25") + .attr("id", "browndog_img") + .css("position", "absolute") + .css("left", "0px") + .css("bottom", "45px"); $("body").append(graphic); setTimeout(browndog_run, 10); } function browndog_del() { - var node = document.getElementById('browndog_img'); + var node = document.getElementById("browndog_img"); node.parentNode.removeChild(node); - - node = document.getElementById('browndog_poweredby'); + + node = document.getElementById("browndog_poweredby"); node.parentNode.removeChild(node); } function browndog_run() { - var graphic = document.getElementById('browndog_img'); - graphic.style.left = parseInt(graphic.style.left) + 25 + 'px'; + var graphic = document.getElementById("browndog_img"); + graphic.style.left = parseInt(graphic.style.left) + 25 + "px"; - if(parseInt(graphic.style.left) < $(window).width() - 50) { + if (parseInt(graphic.style.left) < $(window).width() - 50) { setTimeout(browndog_run, 10); } else { //graphic.remove(); graphic.parentNode.removeChild(graphic); //Add powered by graphic - graphic = $('') - .attr('src', 'images/poweredby-transparent.gif') - .attr('id', 'browndog_img') - .attr('width', '100'); - - var link = $('') - .attr('href', 'http://browndog.ncsa.illinois.edu') - .attr('id', 'browndog_poweredby') - .css('position', 'fixed') - .css('right', '10px') - .css('bottom', '30px') + graphic = $("") + .attr("src", "images/poweredby-transparent.gif") + .attr("id", "browndog_img") + .attr("width", "100"); + + var link = $("") + .attr("href", "http://browndog.ncsa.illinois.edu") + .attr("id", "browndog_poweredby") + .css("position", "fixed") + .css("right", "10px") + .css("bottom", "30px") .append(graphic); $("body").append(link); diff --git a/web/plot.netcdf.R b/web/plot.netcdf.R index 8c56c291df0..6b0386d3eb4 100644 --- a/web/plot.netcdf.R +++ b/web/plot.netcdf.R @@ -31,5 +31,5 @@ filename <- args[7] # filename="plot.png" #error_reporting(E_ALL | E_STRICT); -PEcAn.visualization::plot.netcdf(datafile, yvar, xvar, width, height, filename, year); +PEcAn.visualization::plot_netcdf(datafile, yvar, xvar, width, height, filename, year); diff --git a/web/setups/page.template.php b/web/setups/page.template.php index ec25b9378c9..c2e3486c1c9 100644 --- a/web/setups/page.template.php +++ b/web/setups/page.template.php @@ -44,7 +44,6 @@ Database
Browndog
FIA Database
- Google MapKey
Change Password

@@ -54,9 +53,9 @@

Documentation
- Chat Room + Chat Room
- Bug Report + Bug Report

diff --git a/web/setups/serversyncscript.php b/web/setups/serversyncscript.php index e12df6a0719..eaee96afa37 100644 --- a/web/setups/serversyncscript.php +++ b/web/setups/serversyncscript.php @@ -64,12 +64,10 @@ $date = date("Y-m-d H:i:s"); $stmt = $pdo->prepare("INSERT - INTO machines (id, hostname, created_at, updated_at , sync_host_id, sync_url, sync_contact, sync_start, sync_end) - VALUES (:id, :hostname, :created_at, :updated_at , :sync_host_id, :sync_url, :sync_contact, :sync_start, :sync_end );"); + INTO machines (id, hostname, sync_host_id, sync_url, sync_contact, sync_start, sync_end) + VALUES (:id, :hostname, :sync_host_id, :sync_url, :sync_contact, :sync_start, :sync_end );"); $stmt->bindValue(':id', $id, PDO::PARAM_INT); $stmt->bindValue(':hostname', $fqdn, PDO::PARAM_STR); - $stmt->bindValue(':created_at', $date, PDO::PARAM_STR); - $stmt->bindValue(':updated_at', $date, PDO::PARAM_STR); $stmt->bindValue(':sync_host_id', $host_id, PDO::PARAM_INT); $stmt->bindValue(':sync_url', ' ', PDO::PARAM_STR); $stmt->bindValue(':sync_contact', ' ', PDO::PARAM_STR); diff --git a/web/setups/submitissues.php b/web/setups/submitissues.php deleted file mode 100644 index 39aaee5acc6..00000000000 --- a/web/setups/submitissues.php +++ /dev/null @@ -1,166 +0,0 @@ - Report the bug"; - -if (isset($title) && !empty($title) && - isset($description) && !empty($description) && - isset($username) && !empty($username) && - isset($password) && !empty($password)) { - - $service_url = "https://api.github.com/repos/PecanProject/pecan/issues"; - - $user_agent = "Pecan-application"; - $curl = curl_init($service_url); - - $curl_post_data = array ('title' => $title, - 'body' => $description, - 'lables' => 'Bug' ); - - $data_string = json_encode($curl_post_data); - - // setting curl to do a POST request - curl_setopt($curl, CURLOPT_USERPWD, $username.":".$password); // authentication - curl_setopt($curl, CURLOPT_USERAGENT, $user_agent); - curl_setopt($curl, CURLOPT_RETURNTRANSFER, true); - curl_setopt($curl, CURLOPT_POST, true); - curl_setopt($curl, CURLOPT_POSTFIELDS, $data_string); - curl_setopt($curl, CURLOPT_HTTPHEADER, array( - 'Content-Type: application/json', - 'Content-Length: ' . strlen($data_string)) - ); - - // execute the curl request - $curl_response = curl_exec($curl); - - $decode = json_decode($curl_response); - - //var_dump($decode); - if (curl_getinfo ($curl, CURLINFO_HTTP_CODE) == 201) - { -// Generate tha page to inform the user -?> - - - - - - - - - -
-

All fields are important

-
- -
- -
- - - Title Needed - - -
-
- -
- -
- - - Description Needed - - -
-
- -
- -
-
-
- -
- -
- If u don't have Github account you can create one here - - - Github Username / Email is must - - -
-
- -
- -
- - - Github password is must - - - -
-
-
- -
-
- -
-
- - diff --git a/web/sites.css b/web/sites.css index cf3ff3ff20b..29b789aa6b0 100644 --- a/web/sites.css +++ b/web/sites.css @@ -1,195 +1,206 @@ html { - height: 100%; + height: 100%; } body { - margin: 0; - padding: 0; - height: 100%; - width: 100%; + margin: 0; + padding: 0; + height: 100%; + width: 100%; } -p,h1,form,button { - border: 0; - margin: 0; - padding: 0; +p, +h1, +form, +button { + border: 0; + margin: 0; + padding: 0; } -th,td { - padding: 0px 5px 0px 5px; +th, +td { + padding: 0px 5px 0px 5px; } .spacer { - clear: both; - height: 1px; + clear: both; + height: 1px; } #wrap { - width: 100%; - height: 100%; - overflow: hidden; + width: 100%; + height: 100%; + overflow: hidden; } .myform { - margin: 0 auto; - width: 200px; - padding: 14px; + margin: 0 auto; + width: 200px; + padding: 14px; } #stylized { - border: solid 2px #b7ddf2; - background: #ebf4fb; - font-size: 14px; - width: 200px; - height: calc( 100% - 14px ); - float: left; - padding: 5px; - overflow: auto; + border: solid 2px #b7ddf2; + background: #ebf4fb; + font-size: 14px; + width: 200px; + height: calc(100% - 14px); + float: left; + padding: 5px; + overflow: auto; } #stylized h1 { - font-size: 18px; - font-weight: bold; - margin-bottom: 8px; + font-size: 18px; + font-weight: bold; + margin-bottom: 8px; } #stylized p { - font-size: 14px; - color: #666666; - margin-bottom: 20px; - border-bottom: solid 1px #b7ddf2; - padding-bottom: 10px; + font-size: 14px; + color: #666666; + margin-bottom: 20px; + border-bottom: solid 1px #b7ddf2; + padding-bottom: 10px; } #stylized label { - display: block; - font-weight: bold; - text-align: left; - width: 180px; - float: left; + display: block; + font-weight: bold; + text-align: left; + width: 180px; + float: left; } #stylized .small { - color: #666666; - display: block; - font-size: 14px; - font-weight: normal; - text-align: left; - width: 180px; + color: #666666; + display: block; + font-size: 14px; + font-weight: normal; + text-align: left; + width: 180px; } -#stylized select, input, textarea { - font-size: 12px; - border: solid 1px #aacfe4; - width: 190px; +#stylized select, +input, +textarea { + font-size: 12px; + border: solid 1px #aacfe4; + width: 190px; } -#stylized input[type=text], #stylized input[type=password], #stylized textarea { - text-overflow: ellipsis; - width: 184px; - padding: 4px 2px; +#stylized input[type="text"], +#stylized input[type="password"], +#stylized textarea { + text-overflow: ellipsis; + width: 184px; + padding: 4px 2px; } -#stylized input[type=checkbox] { - width: 180px; +#stylized input[type="checkbox"] { + width: 180px; } #stylized textarea { - resize: none; + resize: none; } #stylized button { - clear: both; - margin-left: 35px; - margin-right: 35px; - height: 31px; - background: #666666 url(img/button.png) no-repeat; - text-align: center; - line-height: 31px; - color: #FFFFFF; - font-size: 11px; - font-weight: bold; + clear: both; + margin-left: 35px; + margin-right: 35px; + height: 31px; + background: #666666 url(img/button.png) no-repeat; + text-align: center; + line-height: 31px; + color: #ffffff; + font-size: 11px; + font-weight: bold; } #prev { - width: 70px !important; - float: left; + width: 70px !important; + float: left; } #next { - width: 70px !important; - float: right; - margin-right: 10px; - position: relative; + width: 70px !important; + float: right; + margin-right: 10px; + position: relative; } #output { - overflow: auto; - padding: 5px; - margin-left: 200px; - height: calc( 100% - 50px ); + overflow: auto; + padding: 5px; + margin-left: 200px; + height: calc(100% - 50px); } #output p { - padding-top: 10px; + padding-top: 10px; } #output label { - display: block; - font-weight: bold; - text-align: left; - width: 300px; - float: left; + display: block; + font-weight: bold; + text-align: left; + width: 300px; + float: left; } -#output select, #output input, #output textarea { - font-size: 12px; - border: solid 1px #aacfe4; - width: 300px; +#output select, +#output input, +#output textarea { + font-size: 12px; + border: solid 1px #aacfe4; + width: 300px; } #editor { - -webkit-box-sizing: border-box; /* Safari/Chrome, other WebKit */ - -moz-box-sizing: border-box; /* Firefox, other Gecko */ - box-sizing: border-box; /* Opera/IE 8+ */ - width: 100%; - height: calc( 100% - 40px ); + -webkit-box-sizing: border-box; /* Safari/Chrome, other WebKit */ + -moz-box-sizing: border-box; /* Firefox, other Gecko */ + box-sizing: border-box; /* Opera/IE 8+ */ + width: 100%; + height: calc(100% - 40px); } .table { - display: table; + display: table; } .row { - display: table-row; + display: table-row; } -.cell, .header { - display: table-cell; - padding: 0px 5px 0px 5px; +.cell, +.header { + display: table-cell; + padding: 0px 5px 0px 5px; } .header { - font-weight: bold; + font-weight: bold; } .logfile { - margin-top: 8px; - border-top: 1px solid #D9D9D9; - border-bottom: 1px solid #D9D9D9; - padding: 7px 10px; - font: 11px "Courier New", monospace; - background-color: #F2F2F2; - color: black; + margin-top: 8px; + border-top: 1px solid #d9d9d9; + border-bottom: 1px solid #d9d9d9; + padding: 7px 10px; + font: 11px "Courier New", monospace; + background-color: #f2f2f2; + color: black; } #logout { - float: right; - margin-right: 10px; + float: right; + margin-right: 10px; } #footer { - font-size: 12px; - overflow: auto; - padding: 5px; + font-size: 12px; + overflow: auto; + padding: 5px; } diff --git a/web/sugarcane/config/file_locations.php b/web/sugarcane/config/file_locations.php deleted file mode 100644 index 2f402e3e144..00000000000 --- a/web/sugarcane/config/file_locations.php +++ /dev/null @@ -1,15 +0,0 @@ - diff --git a/web/sugarcane/config/graph_variables.php b/web/sugarcane/config/graph_variables.php deleted file mode 100755 index 12de285d95b..00000000000 --- a/web/sugarcane/config/graph_variables.php +++ /dev/null @@ -1,6 +0,0 @@ - diff --git a/web/sugarcane/config/xml_structure.txt b/web/sugarcane/config/xml_structure.txt deleted file mode 100644 index eeb0ce6d04a..00000000000 --- a/web/sugarcane/config/xml_structure.txt +++ /dev/null @@ -1,31 +0,0 @@ -# This file defines the structure of the XML file -# Rules: -# 1. Lines starting with a "#" are comments and will be ignored -# 2. Indentations are ignored -# 3. Tags (starting with "<" and ending with ">") will be kept the same -# 4. Section name and variables are defined as: name(w,x,y,z,...) -# For example, after entering the values for each variable on the web page, -# the following will be generated. ("..." is the submitted value.) -# -# ... -# ... -# ... -# ... -# -# - - - - simulationPeriod(dateofplanting,dateofharvest) - location(latitude,longitude) - - canopyParms(Sp,SpD,nlayers,kd,chi.l,heightFactor) - nitroParms(iLeafN,kLN,Vmax.b1,alpha.b1,kpLN,lnb0,lnb1,lnFun,minln,maxln,daymaxln) - photoParms(vmax,alpha,kparm,theta,beta,Rd,Catm,b0,b1,UPPERTEMP,LOWERTEMP) - soilParms(phi1,phi2,iWatCont,soilType,soilLayers,soilDepths,hydrDist,wsFun,scsf,transResp,leafPotTh,rfl,rsec,rsdf,optiontocalculaterootdepth,rootfrontvelocity) - seneParms(senLeaf,senStem,senRoot,senRhizome,leafremobilizafraction,rootturnover,leafturnover) -# For sugarcane phenoParms are not needed -# phenoParms(tp1,kLeaf1,kStem1,kRoot1,kRhizome1,tp2,kLeaf2,kStem2,kRoot2,kRhizome2,tp3,kLeaf3,kStem3,kRoot3,kRhizome3,tp4,kLeaf4,kStem4,kRoot4,kRhizome4,tp5,kLeaf5,kStem5,kRoot5,kRhizome5,tp6,kLeaf6,kStem6,kRoot6,kRhizome6) - SugarPhenoParms(TT0,TTseed,Tmaturity,Rd,Alm,Arm,Clstem,Ilstem,Cestem,Iestem,Clsuc,Ilsuc,Cesuc,Iesuc) - - diff --git a/web/sugarcane/data.xml b/web/sugarcane/data.xml deleted file mode 100644 index a1e69bcf411..00000000000 --- a/web/sugarcane/data.xml +++ /dev/null @@ -1,91 +0,0 @@ - - - - -01/25/2010 -01/25/2011 - - --23 --47 - - - -1.3 -0.001 -40 -0.0 -1.02 -5 - - -2.0 -0.5 -0.0 -0.0 -0.174 --5 -18 -0 -80 -80 -80 - - -39 -0.04 -0.7 -0.83 -0.93 -0.0 -380 -0.03 -6.1 -42 -15 - - -0.01 -0.83 -0.0 -6 -1 -1.0 -0 -0 -1.0 -5000000 --800 -1.7 -0.2 -0.44 -0 -0.5 - - -1400 -10000 -0 -10000 -0.0 -0.2 -1.38 - - -200 -800 -6000 -0.8 -0.32 -0.08 -0.05 -0.0 -0.02 -15 -0.01 -25 -0.02 -45 - - - diff --git a/web/sugarcane/default/default.xml b/web/sugarcane/default/default.xml deleted file mode 100755 index 36b85df1345..00000000000 --- a/web/sugarcane/default/default.xml +++ /dev/null @@ -1,130 +0,0 @@ - - - - - -23 - -47 - - - 01/25/2010 - 01/25/2011 - - - - - - 1.3 - 0.001 - 40 - 0.0 - 1.0 - 3.0 - - - - 2.0 - 0.5 - 0.0 - 0.0 - 0.174 - -5 - 18 - 0 - 80 - 80 - 80 - - - - 39 - 0.04 - 0.7 - 0.83 - 0.93 - 0.0 - 380 - 0.03 - 6.1 - 42 - 15 - - - - 0.01 - 0.83 - 0.0 - 6 - 1 - 1.0 - 0 - 0 - 1.0 - 5000000 - -800 - 1.7 - 0.2 - 0.44 - 0 - 0.5 - - - - 1400 - 10000 - 0 - 10000 - 0.0 - 0.2 - 1.38 - - - - 562 - 1312 - 2063 - 2676 - 3211 - 7000 - 0.33 - 0.37 - 0.3 - -0.008 - 0.14 - 0.85 - 0.01 - -0.0005 - 0.01 - 0.63 - 0.01 - 0.35 - 0.01 - 0.63 - 0.01 - 0.35 - 0.01 - 0.63 - 0.01 - 0.35 - 0.01 - 0.63 - 0.01 - 0.35 - - - 200 - 800 - 6000 - 0.8 - 0.32 - 0.08 - 0.05 - 0.0 - 0.02 - 15 - 0.01 - 25 - 0.02 - 45 - - - diff --git a/web/sugarcane/inc/model/functions.php b/web/sugarcane/inc/model/functions.php deleted file mode 100644 index 8054f2e835b..00000000000 --- a/web/sugarcane/inc/model/functions.php +++ /dev/null @@ -1,103 +0,0 @@ -\\"]/','',$a); -} -function strict_sanitize($a){ - return preg_replace('/[^a-zA-Z0-9\\-_\\.\\+\\=]/','',$a); -} -function line($line){ - return $line.PHP_EOL; -} -function explode_and_trim($separator,$string){ - $result = explode(",",$string); - foreach($result as $k=>$v){ - $result[$k] = trim($v); - } - return $result; -} -function read_xml_structure($path){ - $structure_txt = file_get_contents($path, true); - if($structure_txt==False) { - echo "Error: $path is not readable."; - exit(); - } - $lines=explode("\n",$structure_txt); - $i=0; - foreach($lines as $line){ - if($line!="" and $line!=" "and $line[0]!='#'){ - if(preg_match_all('#\<[^,]+\>#', $line, $arr, PREG_PATTERN_ORDER)){ - }else{ - if(preg_match_all('#([^() ,<>]+)\(([^()]+)\)#',$line, $arr, PREG_SET_ORDER)){ - $items[$i][0]=trim($arr[0][1]); - $items[$i][1]=explode_and_trim(',',$arr[0][2]); - $i++; - } - } - } - } - return $items; -} -function generate_xml($post,$path){ - $structure_txt = file_get_contents($path, true); - if($structure_txt==False) { - echo "$path is not readable. Try changing the permission of the destination folder and $path to 777 if it exists."; - exit(); - } - $lines=explode("\n",$structure_txt); - $i=0; - $return_value=""; - foreach($lines as $line){ - if($line!="" and $line!=" "and $line[0]!='#'){ - if(preg_match_all('#\<[^,]+\>#', $line, $arr, PREG_PATTERN_ORDER)){ - $return_value.=line(trim($arr[0][0])); - }else{ - if(preg_match_all('#([^(), <>]+)\(([^()]+)\)#',$line, $arr, PREG_SET_ORDER)){ - $tag=sanitize(trim($arr[0][1])); - $items=explode_and_trim(',',$arr[0][2]); - $i++; - $content=line("<$tag>"); - $show=false; - foreach ($items as $var) { - $var=sanitize($var); - $var_name=$tag."_".$var; - $var_name=preg_replace('/\./','_',$var_name); - if(isset($post[$var_name]) and $post[$var_name]!=""){ - $inside=sanitize($post[$var_name]); - $content.=line("<$var>$inside"); - $show=true; - } - } - $content .= line(""); - - if($show==true){ - $return_value.= $content; - } - - } - } - } - } - return $return_value; -} -function get_default($path){ - $default_xml_raw = file_get_contents($path, true); - $return=""; - if($default_xml_raw==False) { - echo "$path is not readable. Try changing the permission of the destination folder and $path to 777 if it exists."; - exit(); - } - if(preg_match_all('#<([^<>/]*)>[ \n\r]*([^< >\n\r]+)[ \n\r]*#', $default_xml_raw, $arr, PREG_PATTERN_ORDER)){ - foreach($arr[1] as $index=>$tag){ - $value=trim($arr[2][$index]); - #print($value . "
"); - if(preg_match('#<([^]+)>[ \r\n]*(?:<([^<>]+)>.*[ \r\n]*)*[ \r\n]*<'.$tag.'>[ \r\n]*'.$value.'#', $default_xml_raw, $arr2)){ - $parent_tag=trim($arr2[1]); - $var_name=$parent_tag.'_'.$tag; - $return.= "$('[name=\"$var_name\"]').val('$value'); "; - } - } - - } - return $return; -} -?> diff --git a/web/sugarcane/inc/view/main_view.php b/web/sugarcane/inc/view/main_view.php deleted file mode 100644 index e083f2576f7..00000000000 --- a/web/sugarcane/inc/view/main_view.php +++ /dev/null @@ -1,58 +0,0 @@ - - - - - Sugarcane - - - - - - - - - - -
-
-

Set BioCro Parameters

-
-
- -
    - $tab) { ?> - > - -
    - -
    -
    -
- -
- $tab) { ?> -
" id=""> -
-
- - nodeName; ?> -
- -
- -
-
- -
-
-
- -
- -
-
-
-
- - diff --git a/web/sugarcane/index.php b/web/sugarcane/index.php deleted file mode 100755 index c605e8f0e9a..00000000000 --- a/web/sugarcane/index.php +++ /dev/null @@ -1,132 +0,0 @@ -query($query); -if (!$result) { - die('Invalid query: ' . error_database()); -} -$workflow = $result->fetch(PDO::FETCH_ASSOC); -$folder = $workflow['folder']; - -$runFolder = $folder . DIRECTORY_SEPARATOR . "run"; -$runs = explode("\n", file_get_contents($runFolder . DIRECTORY_SEPARATOR . "runs.txt")); -// this is an advanced edit, so only one run is supported. use the last one in the file. -$lastRun = $runs[count($runs)-2]; - -#$dataXml="/home/pecan/pecan/web/sugarcane/default/default.xml"; -$dataXml=array_shift(glob($workflow["folder"] . "/run/" . $lastRun . "/config.xml")); - -$pdo = null; - -// END PEcAn additions - -if(isset($_POST["command"]) and strpos($_POST["command"],"continue")!==False){ - - // prepare the datafile to be saved - $dataOrigXml=str_replace("config.xml", "data_orig.xml", $dataXml); - - if (!copy($dataXml, $dataOrigXml)) { - die("Failed to copy parameters to new file, $dataOrigXml"); - } - - $doc = new DOMDocument(); - $doc->load($dataXml); - //$doc->preserveWhiteSpace = false; - $xpath = new DOMXPath($doc); - - // The name of most of the posted parameters will be an xpath to - // the same parameter in the config.xml file. Iterate through all the - // posted parameters and set the value of the parameter to the posted value. - foreach($_POST as $key=>$value) { - // All xpaths for this document will start with /config - if(strpos($key,"/config") !== false) { - $query = "/" . $key; - $nodeList = $xpath->query($query); - // The above query will only ever return 1 node - $node = $nodeList->item(0); - $node->nodeValue = $value; - } - } - - if(!$doc->save($dataXml,LIBXML_NOEMPTYTAG)) { - die("$dataXml could not be saved"); - } - - $dataDiff=str_replace("config.xml", "data.diff", $dataXml); - exec("diff $dataOrigXml $dataXml > $dataDiff"); - // TODO do something more intelligent with the diff, like save in the database - - // call R code to lauch stage 2 and redirect to running_stage2.php - chdir($folder); - pclose(popen('R_LIBS_USER="' . ${pecan_install} . '" R CMD BATCH workflow_stage2.R &', 'r')); - if ($offline) { - header( "Location: ../running_stage2.php?workflowid=$workflowid&offline=offline"); - } else { - header( "Location: ../running_stage2.php?workflowid=$workflowid"); - } - -} - -$doc = new DOMDocument(); -$doc->load($dataXml); -$rootNode=$doc->documentElement; - -$tabs = array(); - -foreach ($rootNode->childNodes as $tabNode) { - // filter out top level text nodes - if ($tabNode->nodeType != 3) { - if ($tabNode->nodeName != "pft") { - $tabName = $tabNode->nodeName; - $childNodes = $tabNode->childNodes; - $paramNodes=array(); - // filter out text nodes from children - foreach ($childNodes as $childNode) { - if ($childNode->nodeType != 3) { - $paramNodes[]=$childNode; - } - } - // add this tab and associated parameters to tabs array - $tabs[]=array($tabName,$paramNodes); - } else { // these are pft parameters, so we have to go down one level in the tree to create the rest of the tabs - foreach ($tabNode->childNodes as $pftTabNode) { - $nodeName = $pftTabNode->nodeName; - if ($pftTabNode->nodeType != 3 && $nodeName != "comment" && $nodeName != "num") { - $tabName = $pftTabNode->nodeName; - $childNodes = $pftTabNode->childNodes; - $paramNodes=array(); - // filter out text nodes and comments nodes from children - foreach ($childNodes as $childNode) { - if ($childNode->nodeType != 3 && $childNode->nodeName != "comment") { - $paramNodes[]=$childNode; - } - } - $tabs[] = array($tabName,$paramNodes); - } - } - } - } -} - -include_once("inc/view/main_view.php"); -?> diff --git a/web/sugarcane/ooutput b/web/sugarcane/ooutput deleted file mode 100644 index 30750e5fded..00000000000 --- a/web/sugarcane/ooutput +++ /dev/null @@ -1,368 +0,0 @@ -"DAP" "Leaf" "Stem" "Root" "Sugar" "LAI" "ThermalT" -"1" 0 0 0 0 0 0.01 0.5 -"2" 1 0 0 0 0 0.01 12.29 -"3" 2 0 0 0 0 0.01 25.61 -"4" 3 0 0 0 0 0.01 37.7 -"5" 4 0 0 0 0 0.01 50.46 -"6" 5 0 0.01 0 0 0.01 62.14 -"7" 6 0 0.01 0 0 0.01 74.08 -"8" 7 0 0.01 0 0 0.01 87.33 -"9" 8 0 0.01 0.01 0 0.01 102.9 -"10" 9 0 0.01 0.01 0 0.01 118.93 -"11" 10 0 0.01 0.01 0 0.01 134.95 -"12" 11 0 0.01 0.01 0 0.01 151.17 -"13" 12 0 0.01 0.01 0 0.01 167.71 -"14" 13 0 0.01 0.01 0 0.01 185.56 -"15" 14 0.01 0.01 0.01 0 0.01 202.46 -"16" 15 0.01 0.01 0.01 0 0.01 218.6 -"17" 16 0.01 0.02 0.01 0 0.01 233.88 -"18" 17 0.01 0.02 0.01 0 0.01 249.72 -"19" 18 0.01 0.02 0.01 0 0.02 263.03 -"20" 19 0.01 0.02 0.01 0 0.02 276.02 -"21" 20 0.02 0.02 0.01 0 0.02 290.38 -"22" 21 0.02 0.02 0.01 0 0.03 306.52 -"23" 22 0.03 0.02 0.01 0 0.04 325.63 -"24" 23 0.04 0.03 0.01 0.01 0.05 343.31 -"25" 24 0.05 0.03 0.01 0.01 0.06 360.8 -"26" 25 0.05 0.03 0.01 0.01 0.07 374.79 -"27" 26 0.06 0.04 0.01 0.01 0.08 386.42 -"28" 27 0.07 0.04 0.02 0.02 0.09 399.33 -"29" 28 0.08 0.05 0.02 0.02 0.1 412.66 -"30" 29 0.09 0.06 0.02 0.02 0.12 428.53 -"31" 30 0.11 0.07 0.02 0.03 0.14 445.9 -"32" 31 0.14 0.08 0.03 0.04 0.17 462.41 -"33" 32 0.16 0.1 0.03 0.04 0.2 477.36 -"34" 33 0.17 0.11 0.03 0.05 0.22 489.83 -"35" 34 0.19 0.12 0.03 0.06 0.24 499.22 -"36" 35 0.21 0.14 0.04 0.07 0.27 510.52 -"37" 36 0.23 0.16 0.04 0.08 0.29 521.73 -"38" 37 0.25 0.18 0.04 0.09 0.32 531.47 -"39" 38 0.27 0.2 0.05 0.1 0.35 541.82 -"40" 39 0.3 0.22 0.05 0.11 0.38 553.02 -"41" 40 0.33 0.25 0.06 0.13 0.42 565.1 -"42" 41 0.37 0.29 0.06 0.15 0.47 578.38 -"43" 42 0.41 0.33 0.07 0.17 0.52 590.92 -"44" 43 0.46 0.38 0.08 0.19 0.57 602.79 -"45" 44 0.5 0.43 0.09 0.22 0.63 615.03 -"46" 45 0.55 0.5 0.1 0.25 0.69 628.13 -"47" 46 0.61 0.56 0.11 0.28 0.76 641.55 -"48" 47 0.66 0.64 0.12 0.32 0.83 656.31 -"49" 48 0.72 0.73 0.13 0.36 0.9 671.09 -"50" 49 0.79 0.83 0.14 0.42 0.99 686.62 -"51" 50 0.85 0.93 0.16 0.47 1.07 701.75 -"52" 51 0.91 1.02 0.17 0.51 1.13 714.49 -"53" 52 0.97 1.13 0.18 0.56 1.2 727.03 -"54" 53 1.01 1.22 0.19 0.61 1.26 738.78 -"55" 54 1.06 1.32 0.21 0.66 1.32 750.11 -"56" 55 1.12 1.44 0.22 0.72 1.4 764.62 -"57" 56 1.18 1.59 0.24 0.79 1.47 780.36 -"58" 57 1.24 1.71 0.25 0.84 1.53 794.44 -"59" 58 1.3 1.85 0.27 0.92 1.61 809.44 -"60" 59 1.36 2 0.29 0.99 1.69 824.43 -"61" 60 1.43 2.15 0.3 1.06 1.77 838.59 -"62" 61 1.49 2.3 0.32 1.13 1.85 853.7 -"63" 62 1.55 2.43 0.33 1.19 1.91 867.34 -"64" 63 1.61 2.57 0.35 1.26 1.99 881.11 -"65" 64 1.66 2.71 0.37 1.32 2.05 895.12 -"66" 65 1.71 2.84 0.38 1.38 2.12 908.59 -"67" 66 1.77 2.99 0.4 1.45 2.19 921.84 -"68" 67 1.83 3.13 0.41 1.52 2.26 933.61 -"69" 68 1.89 3.27 0.43 1.58 2.33 945.47 -"70" 69 1.93 3.38 0.44 1.63 2.37 956.42 -"71" 70 1.96 3.47 0.45 1.68 2.41 967.41 -"72" 71 2.01 3.61 0.46 1.74 2.47 980.39 -"73" 72 2.07 3.74 0.48 1.8 2.54 991.29 -"74" 73 2.1 3.83 0.48 1.84 2.58 999.24 -"75" 74 2.15 3.95 0.5 1.89 2.63 1005.8 -"76" 75 2.19 4.06 0.51 1.95 2.68 1012.78 -"77" 76 2.24 4.18 0.52 2 2.74 1020.42 -"78" 77 2.28 4.3 0.53 2.05 2.79 1028.6 -"79" 78 2.34 4.44 0.55 2.12 2.86 1037.91 -"80" 79 2.4 4.59 0.56 2.18 2.93 1047.49 -"81" 80 2.46 4.74 0.58 2.25 2.99 1057.56 -"82" 81 2.52 4.89 0.6 2.32 3.07 1067.97 -"83" 82 2.56 5 0.61 2.37 3.11 1079.09 -"84" 83 2.63 5.19 0.63 2.45 3.19 1092.71 -"85" 84 2.7 5.37 0.64 2.53 3.28 1106.42 -"86" 85 2.77 5.54 0.66 2.61 3.36 1119.23 -"87" 86 2.84 5.73 0.68 2.69 3.44 1132.39 -"88" 87 2.91 5.93 0.7 2.77 3.53 1146.99 -"89" 88 2.99 6.12 0.72 2.86 3.61 1162.81 -"90" 89 3.06 6.31 0.74 2.94 3.7 1178.42 -"91" 90 3.1 6.46 0.75 3 3.75 1193.37 -"92" 91 3.15 6.61 0.77 3.07 3.81 1206.28 -"93" 92 3.21 6.77 0.78 3.14 3.87 1219.53 -"94" 93 3.28 6.96 0.8 3.22 3.95 1233.69 -"95" 94 3.34 7.13 0.82 3.29 4.02 1248.25 -"96" 95 3.39 7.29 0.83 3.36 4.08 1260.35 -"97" 96 3.41 7.36 0.84 3.39 4.1 1268.96 -"98" 97 3.46 7.51 0.85 3.45 4.15 1278.72 -"99" 98 3.52 7.68 0.87 3.52 4.22 1290.16 -"100" 99 3.57 7.84 0.88 3.59 4.29 1301.58 -"101" 100 3.63 8.01 0.9 3.66 4.35 1313.32 -"102" 101 3.68 8.17 0.91 3.72 4.41 1325.48 -"103" 102 3.73 8.33 0.92 3.79 4.47 1339.21 -"104" 103 3.79 8.5 0.94 3.86 4.53 1352.81 -"105" 104 3.84 8.66 0.95 3.92 4.59 1365.58 -"106" 105 3.88 8.79 0.96 3.97 4.63 1378.08 -"107" 106 3.9 8.88 0.97 4.01 4.65 1385.72 -"108" 107 3.92 8.97 0.98 4.05 4.67 1390.74 -"109" 108 3.94 9.07 0.98 4.09 4.7 1398.04 -"110" 109 3.92 9.17 0.99 4.13 4.66 1402.99 -"111" 110 3.9 9.28 1 4.18 4.64 1408.98 -"112" 111 3.89 9.43 1.01 4.23 4.62 1418.41 -"113" 112 3.89 9.58 1.03 4.29 4.61 1429.29 -"114" 113 3.88 9.73 1.04 4.35 4.6 1441.44 -"115" 114 3.87 9.87 1.05 4.4 4.59 1452.01 -"116" 115 3.85 9.98 1.06 4.45 4.56 1463.34 -"117" 116 3.82 10.09 1.07 4.49 4.53 1472.52 -"118" 117 3.81 10.2 1.07 4.54 4.5 1478.83 -"119" 118 3.8 10.33 1.08 4.59 4.48 1487.67 -"120" 119 3.79 10.46 1.09 4.64 4.47 1496.81 -"121" 120 3.78 10.6 1.11 4.69 4.46 1507.74 -"122" 121 3.77 10.74 1.12 4.74 4.45 1519.66 -"123" 122 3.75 10.86 1.12 4.79 4.42 1531.94 -"124" 123 3.75 11 1.13 4.84 4.41 1543.04 -"125" 124 3.73 11.11 1.14 4.89 4.39 1552.41 -"126" 125 3.72 11.23 1.15 4.93 4.36 1561.19 -"127" 126 3.7 11.34 1.16 4.97 4.34 1571.01 -"128" 127 3.69 11.47 1.17 5.02 4.33 1582.91 -"129" 128 3.68 11.59 1.18 5.06 4.31 1591.35 -"130" 129 3.66 11.69 1.18 5.1 4.28 1597.78 -"131" 130 3.64 11.79 1.19 5.14 4.26 1605.51 -"132" 131 3.62 11.9 1.2 5.18 4.23 1614.41 -"133" 132 3.59 11.97 1.2 5.21 4.19 1622.93 -"134" 133 3.56 12.06 1.2 5.24 4.16 1629.92 -"135" 134 3.54 12.15 1.21 5.27 4.13 1634.04 -"136" 135 3.53 12.25 1.22 5.31 4.11 1640.64 -"137" 136 3.52 12.35 1.22 5.35 4.09 1646.02 -"138" 137 3.5 12.44 1.23 5.38 4.06 1653.19 -"139" 138 3.46 12.5 1.23 5.41 4.02 1659.56 -"140" 139 3.45 12.6 1.24 5.44 4 1666.35 -"141" 140 3.43 12.7 1.24 5.48 3.98 1672.2 -"142" 141 3.42 12.79 1.25 5.51 3.96 1678.09 -"143" 142 3.41 12.9 1.25 5.55 3.95 1684.98 -"144" 143 3.4 13.01 1.26 5.59 3.94 1692.65 -"145" 144 3.4 13.13 1.27 5.63 3.93 1701.67 -"146" 145 3.4 13.24 1.28 5.67 3.92 1711.73 -"147" 146 3.39 13.36 1.29 5.71 3.91 1722.08 -"148" 147 3.39 13.49 1.29 5.76 3.91 1733.71 -"149" 148 3.39 13.61 1.3 5.8 3.9 1745.46 -"150" 149 3.37 13.71 1.31 5.83 3.88 1757.86 -"151" 150 3.35 13.77 1.31 5.86 3.85 1769.01 -"152" 151 3.34 13.88 1.31 5.9 3.84 1777.35 -"153" 152 3.34 14 1.32 5.94 3.83 1788.62 -"154" 153 3.34 14.13 1.33 5.98 3.83 1799.4 -"155" 154 3.34 14.24 1.34 6.02 3.82 1809.18 -"156" 155 3.34 14.35 1.34 6.05 3.82 1817.45 -"157" 156 3.34 14.47 1.35 6.09 3.81 1826.72 -"158" 157 3.33 14.58 1.36 6.12 3.81 1834.39 -"159" 158 3.33 14.69 1.36 6.16 3.8 1843.67 -"160" 159 3.33 14.8 1.37 6.2 3.8 1852.71 -"161" 160 3.33 14.92 1.38 6.23 3.79 1861.74 -"162" 161 3.33 15.03 1.39 6.27 3.79 1871.57 -"163" 162 3.33 15.14 1.39 6.3 3.78 1880.34 -"164" 163 3.33 15.26 1.4 6.34 3.78 1889.14 -"165" 164 3.33 15.38 1.41 6.38 3.78 1900.22 -"166" 165 3.33 15.5 1.42 6.41 3.78 1911.45 -"167" 166 3.33 15.62 1.42 6.45 3.78 1921.21 -"168" 167 3.34 15.74 1.43 6.49 3.78 1932.27 -"169" 168 3.33 15.84 1.43 6.52 3.77 1942.56 -"170" 169 3.33 15.96 1.44 6.55 3.77 1953.83 -"171" 170 3.33 16.07 1.45 6.59 3.76 1966.74 -"172" 171 3.3 16.12 1.45 6.61 3.73 1976.56 -"173" 172 3.26 16.15 1.44 6.62 3.68 1983.2 -"174" 173 3.22 16.19 1.44 6.64 3.63 1990.75 -"175" 174 3.21 16.27 1.44 6.66 3.61 1998.24 -"176" 175 3.2 16.35 1.45 6.68 3.59 2006.55 -"177" 176 3.19 16.45 1.45 6.71 3.59 2016.08 -"178" 177 3.19 16.55 1.46 6.74 3.58 2026.11 -"179" 178 3.18 16.63 1.46 6.77 3.56 2037.89 -"180" 179 3.18 16.74 1.47 6.8 3.57 2049.52 -"181" 180 3.19 16.87 1.47 6.83 3.57 2062.21 -"182" 181 3.2 16.98 1.48 6.86 3.58 2075.9 -"183" 182 3.2 17.09 1.49 6.89 3.58 2086.81 -"184" 183 3.21 17.2 1.49 6.92 3.58 2096.3 -"185" 184 3.22 17.32 1.5 6.95 3.59 2107.45 -"186" 185 3.22 17.42 1.51 6.97 3.58 2117.09 -"187" 186 3.22 17.53 1.51 7 3.58 2127.37 -"188" 187 3.2 17.6 1.51 7.02 3.56 2138.37 -"189" 188 3.21 17.71 1.52 7.05 3.56 2150.51 -"190" 189 3.22 17.83 1.53 7.08 3.57 2162.7 -"191" 190 3.22 17.93 1.53 7.1 3.57 2176.75 -"192" 191 3.21 18.01 1.53 7.12 3.56 2186.93 -"193" 192 3.19 18.08 1.53 7.14 3.54 2195.54 -"194" 193 3.18 18.15 1.54 7.16 3.52 2204.22 -"195" 194 3.18 18.25 1.54 7.18 3.52 2214.58 -"196" 195 3.18 18.35 1.55 7.2 3.52 2221.46 -"197" 196 3.19 18.46 1.55 7.22 3.52 2230.2 -"198" 197 3.21 18.6 1.56 7.25 3.54 2240.96 -"199" 198 3.23 18.73 1.57 7.28 3.56 2255 -"200" 199 3.23 18.83 1.58 7.3 3.56 2264.66 -"201" 200 3.23 18.93 1.58 7.32 3.56 2275.08 -"202" 201 3.25 19.05 1.59 7.34 3.57 2287.72 -"203" 202 3.26 19.16 1.6 7.36 3.57 2300.16 -"204" 203 3.26 19.27 1.6 7.38 3.58 2309.28 -"205" 204 3.26 19.36 1.61 7.4 3.57 2315.29 -"206" 205 3.26 19.44 1.61 7.42 3.56 2320.5 -"207" 206 3.26 19.55 1.62 7.44 3.56 2328.23 -"208" 207 3.27 19.66 1.63 7.46 3.57 2336.16 -"209" 208 3.28 19.76 1.63 7.49 3.57 2345.08 -"210" 209 3.29 19.88 1.64 7.51 3.58 2354.93 -"211" 210 3.3 20 1.65 7.54 3.59 2366.52 -"212" 211 3.33 20.14 1.66 7.57 3.61 2381.57 -"213" 212 3.34 20.26 1.66 7.6 3.63 2395.23 -"214" 213 3.35 20.36 1.67 7.62 3.63 2408.6 -"215" 214 3.36 20.48 1.67 7.65 3.64 2424.59 -"216" 215 3.36 20.58 1.68 7.68 3.65 2439.93 -"217" 216 3.37 20.67 1.68 7.71 3.65 2457.37 -"218" 217 3.37 20.77 1.68 7.74 3.65 2473.74 -"219" 218 3.37 20.85 1.68 7.77 3.65 2491.39 -"220" 219 3.36 20.92 1.68 7.8 3.63 2507.31 -"221" 220 3.33 20.95 1.68 7.82 3.6 2522.01 -"222" 221 3.28 20.95 1.67 7.83 3.56 2537.01 -"223" 222 3.24 20.95 1.67 7.83 3.5 2551.19 -"224" 223 3.19 20.95 1.67 7.83 3.45 2569.01 -"225" 224 3.15 20.95 1.66 7.83 3.4 2585.7 -"226" 225 3.11 20.95 1.66 7.83 3.35 2600.12 -"227" 226 3.06 20.95 1.66 7.83 3.3 2610.91 -"228" 227 3.02 20.96 1.65 7.84 3.26 2620.07 -"229" 228 3.03 21.05 1.66 7.87 3.25 2630.64 -"230" 229 3.05 21.15 1.66 7.9 3.26 2642.8 -"231" 230 3.05 21.24 1.67 7.93 3.26 2656.33 -"232" 231 3.05 21.3 1.67 7.96 3.26 2672.21 -"233" 232 3.03 21.33 1.66 7.99 3.24 2687.62 -"234" 233 2.99 21.33 1.66 7.99 3.2 2703.55 -"235" 234 2.95 21.33 1.66 7.99 3.15 2721.22 -"236" 235 2.91 21.33 1.65 7.99 3.11 2739.57 -"237" 236 2.87 21.33 1.65 7.99 3.06 2756.22 -"238" 237 2.83 21.33 1.65 7.99 3.02 2776.98 -"239" 238 2.79 21.33 1.64 7.99 2.97 2791.02 -"240" 239 2.75 21.33 1.64 7.99 2.93 2804.7 -"241" 240 2.71 21.33 1.64 7.99 2.88 2819.19 -"242" 241 2.67 21.33 1.63 7.99 2.84 2835.2 -"243" 242 2.64 21.33 1.63 7.99 2.8 2854.65 -"244" 243 2.6 21.33 1.63 7.99 2.76 2873.78 -"245" 244 2.56 21.33 1.62 7.99 2.72 2887.29 -"246" 245 2.57 21.39 1.63 8.02 2.71 2898.43 -"247" 246 2.58 21.46 1.63 8.05 2.72 2910.81 -"248" 247 2.6 21.54 1.63 8.09 2.73 2926.43 -"249" 248 2.59 21.56 1.63 8.11 2.72 2936.07 -"250" 249 2.6 21.65 1.63 8.15 2.73 2947.38 -"251" 250 2.64 21.75 1.64 8.2 2.76 2961.73 -"252" 251 2.64 21.8 1.64 8.23 2.76 2975.34 -"253" 252 2.66 21.89 1.64 8.27 2.78 2989.15 -"254" 253 2.64 21.92 1.64 8.29 2.76 2997.98 -"255" 254 2.64 21.97 1.64 8.32 2.76 3007.2 -"256" 255 2.69 22.11 1.65 8.38 2.81 3023.08 -"257" 256 2.75 22.25 1.66 8.44 2.86 3038.77 -"258" 257 2.76 22.33 1.66 8.49 2.88 3053.1 -"259" 258 2.8 22.46 1.67 8.54 2.92 3066.35 -"260" 259 2.84 22.58 1.68 8.59 2.95 3078.03 -"261" 260 2.86 22.69 1.69 8.64 2.98 3087.94 -"262" 261 2.9 22.81 1.7 8.69 3.01 3098.9 -"263" 262 2.93 22.92 1.71 8.74 3.03 3108.45 -"264" 263 2.97 23.06 1.72 8.8 3.08 3121.43 -"265" 264 3.01 23.18 1.73 8.86 3.11 3137.7 -"266" 265 3.02 23.27 1.73 8.91 3.12 3150.92 -"267" 266 3.06 23.39 1.74 8.97 3.16 3165.7 -"268" 267 3.1 23.53 1.75 9.04 3.2 3178.97 -"269" 268 3.11 23.62 1.76 9.08 3.21 3189.9 -"270" 269 3.16 23.77 1.77 9.15 3.25 3202.23 -"271" 270 3.2 23.91 1.78 9.22 3.29 3215.84 -"272" 271 3.26 24.08 1.8 9.3 3.35 3232.43 -"273" 272 3.32 24.24 1.81 9.38 3.41 3251.22 -"274" 273 3.34 24.34 1.81 9.44 3.42 3266.42 -"275" 274 3.37 24.47 1.82 9.51 3.45 3279.67 -"276" 275 3.42 24.63 1.84 9.59 3.5 3294.93 -"277" 276 3.45 24.75 1.85 9.65 3.52 3307.68 -"278" 277 3.49 24.9 1.86 9.73 3.56 3320.52 -"279" 278 3.54 25.08 1.87 9.81 3.62 3335.72 -"280" 279 3.61 25.26 1.89 9.92 3.68 3355.41 -"281" 280 3.63 25.36 1.89 9.99 3.7 3372.77 -"282" 281 3.64 25.46 1.9 10.05 3.7 3385.34 -"283" 282 3.67 25.6 1.91 10.12 3.73 3398.38 -"284" 283 3.72 25.76 1.92 10.21 3.77 3411.77 -"285" 284 3.76 25.92 1.94 10.29 3.82 3426.84 -"286" 285 3.81 26.08 1.95 10.38 3.86 3443.43 -"287" 286 3.84 26.21 1.96 10.47 3.88 3459.18 -"288" 287 3.83 26.29 1.96 10.52 3.87 3469.16 -"289" 288 3.87 26.45 1.98 10.61 3.91 3482.23 -"290" 289 3.92 26.63 1.99 10.71 3.96 3499.4 -"291" 290 3.98 26.8 2 10.82 4.02 3518.62 -"292" 291 4 26.92 2.01 10.89 4.03 3532.7 -"293" 292 3.99 27.01 2.02 10.95 4.02 3542.12 -"294" 293 4.01 27.14 2.03 11.03 4.04 3554.51 -"295" 294 4.01 27.23 2.03 11.09 4.03 3564.17 -"296" 295 4.02 27.33 2.04 11.16 4.03 3575.01 -"297" 296 4.04 27.47 2.05 11.24 4.05 3586.66 -"298" 297 4.03 27.54 2.05 11.3 4.04 3596.72 -"299" 298 4.07 27.7 2.06 11.4 4.07 3610.21 -"300" 299 4.12 27.87 2.08 11.5 4.12 3624.52 -"301" 300 4.19 28.07 2.09 11.63 4.18 3644.44 -"302" 301 4.24 28.24 2.11 11.76 4.23 3666 -"303" 302 4.27 28.37 2.12 11.86 4.26 3683.69 -"304" 303 4.28 28.48 2.12 11.95 4.26 3700.07 -"305" 304 4.29 28.59 2.13 12.03 4.27 3714.06 -"306" 305 4.32 28.74 2.14 12.14 4.3 3730.44 -"307" 306 4.35 28.88 2.15 12.25 4.32 3747.46 -"308" 307 4.4 29.06 2.16 12.37 4.37 3765.59 -"309" 308 4.45 29.24 2.18 12.5 4.41 3782.82 -"310" 309 4.51 29.42 2.19 12.63 4.46 3801.68 -"311" 310 4.54 29.57 2.2 12.75 4.49 3819.5 -"312" 311 4.55 29.69 2.21 12.85 4.5 3835.5 -"313" 312 4.56 29.8 2.22 12.94 4.5 3848.71 -"314" 313 4.58 29.93 2.22 13.05 4.51 3865.15 -"315" 314 4.62 30.09 2.24 13.18 4.55 3884.59 -"316" 315 4.65 30.24 2.25 13.3 4.57 3900.14 -"317" 316 4.66 30.35 2.25 13.4 4.58 3916.9 -"318" 317 4.65 30.45 2.26 13.49 4.57 3929.34 -"319" 318 4.67 30.58 2.27 13.6 4.58 3945.02 -"320" 319 4.64 30.61 2.26 13.67 4.54 3958.54 -"321" 320 4.67 30.76 2.27 13.79 4.57 3975.44 -"322" 321 4.7 30.92 2.28 13.92 4.6 3992.3 -"323" 322 4.73 31.06 2.29 14.06 4.62 4011.95 -"324" 323 4.77 31.21 2.3 14.21 4.66 4032.37 -"325" 324 4.79 31.35 2.31 14.33 4.67 4048.78 -"326" 325 4.76 31.39 2.31 14.4 4.64 4060.99 -"327" 326 4.73 31.43 2.31 14.46 4.6 4070.55 -"328" 327 4.68 31.46 2.3 14.53 4.55 4082.39 -"329" 328 4.66 31.51 2.3 14.61 4.52 4095.96 -"330" 329 4.65 31.59 2.31 14.69 4.51 4108.44 -"331" 330 4.65 31.7 2.31 14.8 4.51 4122.31 -"332" 331 4.68 31.82 2.32 14.92 4.53 4138.39 -"333" 332 4.71 31.96 2.33 15.07 4.56 4158.49 -"334" 333 4.72 32.07 2.34 15.19 4.56 4173.36 -"335" 334 4.72 32.15 2.34 15.28 4.55 4187.28 -"336" 335 4.7 32.23 2.34 15.37 4.53 4199.31 -"337" 336 4.72 32.35 2.35 15.5 4.55 4214.7 -"338" 337 4.72 32.44 2.35 15.61 4.54 4229.42 -"339" 338 4.72 32.53 2.36 15.7 4.53 4241.54 -"340" 339 4.73 32.66 2.37 15.82 4.54 4254.4 -"341" 340 4.76 32.8 2.38 15.95 4.57 4267.94 -"342" 341 4.79 32.95 2.39 16.09 4.59 4281.94 -"343" 342 4.82 33.09 2.4 16.22 4.61 4296.9 -"344" 343 4.82 33.19 2.41 16.34 4.61 4310.37 -"345" 344 4.81 33.27 2.41 16.43 4.59 4322.45 -"346" 345 4.78 33.31 2.41 16.51 4.56 4333.9 -"347" 346 4.77 33.39 2.41 16.61 4.54 4346.62 -"348" 347 4.77 33.49 2.42 16.73 4.54 4360.28 -"349" 348 4.76 33.56 2.42 16.83 4.53 4373.89 -"350" 349 4.75 33.62 2.42 16.93 4.51 4387.12 -"351" 350 4.73 33.68 2.42 17.03 4.49 4399.69 -"352" 351 4.72 33.75 2.42 17.13 4.47 4412.86 -"353" 352 4.71 33.82 2.42 17.23 4.46 4426.36 -"354" 353 4.72 33.92 2.43 17.36 4.46 4441.53 -"355" 354 4.73 34.01 2.43 17.48 4.47 4455.78 -"356" 355 4.72 34.09 2.43 17.59 4.46 4469.04 -"357" 356 4.72 34.17 2.44 17.7 4.45 4482.17 -"358" 357 4.74 34.29 2.45 17.84 4.46 4496.3 -"359" 358 4.75 34.4 2.45 17.97 4.47 4511.12 -"360" 359 4.73 34.45 2.45 18.07 4.45 4523.91 -"361" 360 4.71 34.49 2.45 18.16 4.42 4537.91 -"362" 361 4.69 34.53 2.45 18.26 4.4 4552.12 -"363" 362 4.68 34.6 2.45 18.37 4.39 4565.94 -"364" 363 4.69 34.68 2.45 18.5 4.39 4580.54 -"365" 364 4.71 34.8 2.46 18.64 4.41 4595.54 -"366" 365 4.74 34.91 2.47 18.81 4.43 4614.21 -"367" 366 4.76 35.03 2.48 18.96 4.45 4629.25 diff --git a/web/sugarcane/plot_data/output b/web/sugarcane/plot_data/output deleted file mode 100644 index 0d3c876ce8c..00000000000 --- a/web/sugarcane/plot_data/output +++ /dev/null @@ -1,368 +0,0 @@ -DAP Leaf Stem Root Sugar LAI ThermalT -1 0 0 0 0 0 0.01 0.5 -2 1 0 0 0 0 0.01 12.29 -3 2 0 0 0 0 0.01 25.61 -4 3 0 0 0 0 0.01 37.7 -5 4 0 0 0 0 0.01 50.46 -6 5 0 0.01 0 0 0.01 62.14 -7 6 0 0.01 0 0 0.01 74.08 -8 7 0 0.01 0 0 0.01 87.33 -9 8 0 0.01 0.01 0 0.01 102.9 -10 9 0 0.01 0.01 0 0.01 118.93 -11 10 0 0.01 0.01 0 0.01 134.95 -12 11 0 0.01 0.01 0 0.01 151.17 -13 12 0 0.01 0.01 0 0.01 167.71 -14 13 0 0.01 0.01 0 0.01 185.56 -15 14 0.01 0.01 0.01 0 0.01 202.46 -16 15 0.01 0.01 0.01 0 0.01 218.6 -17 16 0.01 0.02 0.01 0 0.01 233.88 -18 17 0.01 0.02 0.01 0 0.01 249.72 -19 18 0.01 0.02 0.01 0 0.02 263.03 -20 19 0.01 0.02 0.01 0 0.02 276.02 -21 20 0.02 0.02 0.01 0 0.02 290.38 -22 21 0.02 0.02 0.01 0 0.03 306.52 -23 22 0.03 0.02 0.01 0 0.04 325.63 -24 23 0.04 0.03 0.01 0.01 0.05 343.31 -25 24 0.05 0.03 0.01 0.01 0.06 360.8 -26 25 0.05 0.03 0.01 0.01 0.07 374.79 -27 26 0.06 0.04 0.01 0.01 0.08 386.42 -28 27 0.07 0.04 0.02 0.02 0.09 399.33 -29 28 0.08 0.05 0.02 0.02 0.1 412.66 -30 29 0.09 0.06 0.02 0.02 0.12 428.53 -31 30 0.11 0.07 0.02 0.03 0.14 445.9 -32 31 0.14 0.08 0.03 0.04 0.17 462.41 -33 32 0.16 0.1 0.03 0.04 0.2 477.36 -34 33 0.17 0.11 0.03 0.05 0.22 489.83 -35 34 0.19 0.12 0.03 0.06 0.24 499.22 -36 35 0.21 0.14 0.04 0.07 0.27 510.52 -37 36 0.23 0.16 0.04 0.08 0.29 521.73 -38 37 0.25 0.18 0.04 0.09 0.32 531.47 -39 38 0.27 0.2 0.05 0.1 0.35 541.82 -40 39 0.3 0.22 0.05 0.11 0.38 553.02 -41 40 0.33 0.25 0.06 0.13 0.42 565.1 -42 41 0.37 0.29 0.06 0.15 0.47 578.38 -43 42 0.41 0.33 0.07 0.17 0.52 590.92 -44 43 0.46 0.38 0.08 0.19 0.57 602.79 -45 44 0.5 0.43 0.09 0.22 0.63 615.03 -46 45 0.55 0.5 0.1 0.25 0.69 628.13 -47 46 0.61 0.56 0.11 0.28 0.76 641.55 -48 47 0.66 0.64 0.12 0.32 0.83 656.31 -49 48 0.72 0.73 0.13 0.36 0.9 671.09 -50 49 0.79 0.83 0.14 0.42 0.99 686.62 -51 50 0.85 0.93 0.16 0.47 1.07 701.75 -52 51 0.91 1.02 0.17 0.51 1.13 714.49 -53 52 0.97 1.13 0.18 0.56 1.2 727.03 -54 53 1.01 1.22 0.19 0.61 1.26 738.78 -55 54 1.06 1.32 0.21 0.66 1.32 750.11 -56 55 1.12 1.44 0.22 0.72 1.4 764.62 -57 56 1.18 1.59 0.24 0.79 1.47 780.36 -58 57 1.24 1.71 0.25 0.84 1.53 794.44 -59 58 1.3 1.85 0.27 0.92 1.61 809.44 -60 59 1.36 2 0.29 0.99 1.69 824.43 -61 60 1.43 2.15 0.3 1.06 1.77 838.59 -62 61 1.49 2.3 0.32 1.13 1.85 853.7 -63 62 1.55 2.43 0.33 1.19 1.91 867.34 -64 63 1.61 2.57 0.35 1.26 1.99 881.11 -65 64 1.66 2.71 0.37 1.32 2.05 895.12 -66 65 1.71 2.84 0.38 1.38 2.12 908.59 -67 66 1.77 2.99 0.4 1.45 2.19 921.84 -68 67 1.83 3.13 0.41 1.52 2.26 933.61 -69 68 1.89 3.27 0.43 1.58 2.33 945.47 -70 69 1.93 3.38 0.44 1.63 2.37 956.42 -71 70 1.96 3.47 0.45 1.68 2.41 967.41 -72 71 2.01 3.61 0.46 1.74 2.47 980.39 -73 72 2.07 3.74 0.48 1.8 2.54 991.29 -74 73 2.1 3.83 0.48 1.84 2.58 999.24 -75 74 2.15 3.95 0.5 1.89 2.63 1005.8 -76 75 2.19 4.06 0.51 1.95 2.68 1012.78 -77 76 2.24 4.18 0.52 2 2.74 1020.42 -78 77 2.28 4.3 0.53 2.05 2.79 1028.6 -79 78 2.34 4.44 0.55 2.12 2.86 1037.91 -80 79 2.4 4.59 0.56 2.18 2.93 1047.49 -81 80 2.46 4.74 0.58 2.25 2.99 1057.56 -82 81 2.52 4.89 0.6 2.32 3.07 1067.97 -83 82 2.56 5 0.61 2.37 3.11 1079.09 -84 83 2.63 5.19 0.63 2.45 3.19 1092.71 -85 84 2.7 5.37 0.64 2.53 3.28 1106.42 -86 85 2.77 5.54 0.66 2.61 3.36 1119.23 -87 86 2.84 5.73 0.68 2.69 3.44 1132.39 -88 87 2.91 5.93 0.7 2.77 3.53 1146.99 -89 88 2.99 6.12 0.72 2.86 3.61 1162.81 -90 89 3.06 6.31 0.74 2.94 3.7 1178.42 -91 90 3.1 6.46 0.75 3 3.75 1193.37 -92 91 3.15 6.61 0.77 3.07 3.81 1206.28 -93 92 3.21 6.77 0.78 3.14 3.87 1219.53 -94 93 3.28 6.96 0.8 3.22 3.95 1233.69 -95 94 3.34 7.13 0.82 3.29 4.02 1248.25 -96 95 3.39 7.29 0.83 3.36 4.08 1260.35 -97 96 3.41 7.36 0.84 3.39 4.1 1268.96 -98 97 3.46 7.51 0.85 3.45 4.15 1278.72 -99 98 3.52 7.68 0.87 3.52 4.22 1290.16 -100 99 3.57 7.84 0.88 3.59 4.29 1301.58 -101 100 3.63 8.01 0.9 3.66 4.35 1313.32 -102 101 3.68 8.17 0.91 3.72 4.41 1325.48 -103 102 3.73 8.33 0.92 3.79 4.47 1339.21 -104 103 3.79 8.5 0.94 3.86 4.53 1352.81 -105 104 3.84 8.66 0.95 3.92 4.59 1365.58 -106 105 3.88 8.79 0.96 3.97 4.63 1378.08 -107 106 3.9 8.88 0.97 4.01 4.65 1385.72 -108 107 3.92 8.97 0.98 4.05 4.67 1390.74 -109 108 3.94 9.07 0.98 4.09 4.7 1398.04 -110 109 3.92 9.17 0.99 4.13 4.66 1402.99 -111 110 3.9 9.28 1 4.18 4.64 1408.98 -112 111 3.89 9.43 1.01 4.23 4.62 1418.41 -113 112 3.89 9.58 1.03 4.29 4.61 1429.29 -114 113 3.88 9.73 1.04 4.35 4.6 1441.44 -115 114 3.87 9.87 1.05 4.4 4.59 1452.01 -116 115 3.85 9.98 1.06 4.45 4.56 1463.34 -117 116 3.82 10.09 1.07 4.49 4.53 1472.52 -118 117 3.81 10.2 1.07 4.54 4.5 1478.83 -119 118 3.8 10.33 1.08 4.59 4.48 1487.67 -120 119 3.79 10.46 1.09 4.64 4.47 1496.81 -121 120 3.78 10.6 1.11 4.69 4.46 1507.74 -122 121 3.77 10.74 1.12 4.74 4.45 1519.66 -123 122 3.75 10.86 1.12 4.79 4.42 1531.94 -124 123 3.75 11 1.13 4.84 4.41 1543.04 -125 124 3.73 11.11 1.14 4.89 4.39 1552.41 -126 125 3.72 11.23 1.15 4.93 4.36 1561.19 -127 126 3.7 11.34 1.16 4.97 4.34 1571.01 -128 127 3.69 11.47 1.17 5.02 4.33 1582.91 -129 128 3.68 11.59 1.18 5.06 4.31 1591.35 -130 129 3.66 11.69 1.18 5.1 4.28 1597.78 -131 130 3.64 11.79 1.19 5.14 4.26 1605.51 -132 131 3.62 11.9 1.2 5.18 4.23 1614.41 -133 132 3.59 11.97 1.2 5.21 4.19 1622.93 -134 133 3.56 12.06 1.2 5.24 4.16 1629.92 -135 134 3.54 12.15 1.21 5.27 4.13 1634.04 -136 135 3.53 12.25 1.22 5.31 4.11 1640.64 -137 136 3.52 12.35 1.22 5.35 4.09 1646.02 -138 137 3.5 12.44 1.23 5.38 4.06 1653.19 -139 138 3.46 12.5 1.23 5.41 4.02 1659.56 -140 139 3.45 12.6 1.24 5.44 4 1666.35 -141 140 3.43 12.7 1.24 5.48 3.98 1672.2 -142 141 3.42 12.79 1.25 5.51 3.96 1678.09 -143 142 3.41 12.9 1.25 5.55 3.95 1684.98 -144 143 3.4 13.01 1.26 5.59 3.94 1692.65 -145 144 3.4 13.13 1.27 5.63 3.93 1701.67 -146 145 3.4 13.24 1.28 5.67 3.92 1711.73 -147 146 3.39 13.36 1.29 5.71 3.91 1722.08 -148 147 3.39 13.49 1.29 5.76 3.91 1733.71 -149 148 3.39 13.61 1.3 5.8 3.9 1745.46 -150 149 3.37 13.71 1.31 5.83 3.88 1757.86 -151 150 3.35 13.77 1.31 5.86 3.85 1769.01 -152 151 3.34 13.88 1.31 5.9 3.84 1777.35 -153 152 3.34 14 1.32 5.94 3.83 1788.62 -154 153 3.34 14.13 1.33 5.98 3.83 1799.4 -155 154 3.34 14.24 1.34 6.02 3.82 1809.18 -156 155 3.34 14.35 1.34 6.05 3.82 1817.45 -157 156 3.34 14.47 1.35 6.09 3.81 1826.72 -158 157 3.33 14.58 1.36 6.12 3.81 1834.39 -159 158 3.33 14.69 1.36 6.16 3.8 1843.67 -160 159 3.33 14.8 1.37 6.2 3.8 1852.71 -161 160 3.33 14.92 1.38 6.23 3.79 1861.74 -162 161 3.33 15.03 1.39 6.27 3.79 1871.57 -163 162 3.33 15.14 1.39 6.3 3.78 1880.34 -164 163 3.33 15.26 1.4 6.34 3.78 1889.14 -165 164 3.33 15.38 1.41 6.38 3.78 1900.22 -166 165 3.33 15.5 1.42 6.41 3.78 1911.45 -167 166 3.33 15.62 1.42 6.45 3.78 1921.21 -168 167 3.34 15.74 1.43 6.49 3.78 1932.27 -169 168 3.33 15.84 1.43 6.52 3.77 1942.56 -170 169 3.33 15.96 1.44 6.55 3.77 1953.83 -171 170 3.33 16.07 1.45 6.59 3.76 1966.74 -172 171 3.3 16.12 1.45 6.61 3.73 1976.56 -173 172 3.26 16.15 1.44 6.62 3.68 1983.2 -174 173 3.22 16.19 1.44 6.64 3.63 1990.75 -175 174 3.21 16.27 1.44 6.66 3.61 1998.24 -176 175 3.2 16.35 1.45 6.68 3.59 2006.55 -177 176 3.19 16.45 1.45 6.71 3.59 2016.08 -178 177 3.19 16.55 1.46 6.74 3.58 2026.11 -179 178 3.18 16.63 1.46 6.77 3.56 2037.89 -180 179 3.18 16.74 1.47 6.8 3.57 2049.52 -181 180 3.19 16.87 1.47 6.83 3.57 2062.21 -182 181 3.2 16.98 1.48 6.86 3.58 2075.9 -183 182 3.2 17.09 1.49 6.89 3.58 2086.81 -184 183 3.21 17.2 1.49 6.92 3.58 2096.3 -185 184 3.22 17.32 1.5 6.95 3.59 2107.45 -186 185 3.22 17.42 1.51 6.97 3.58 2117.09 -187 186 3.22 17.53 1.51 7 3.58 2127.37 -188 187 3.2 17.6 1.51 7.02 3.56 2138.37 -189 188 3.21 17.71 1.52 7.05 3.56 2150.51 -190 189 3.22 17.83 1.53 7.08 3.57 2162.7 -191 190 3.22 17.93 1.53 7.1 3.57 2176.75 -192 191 3.21 18.01 1.53 7.12 3.56 2186.93 -193 192 3.19 18.08 1.53 7.14 3.54 2195.54 -194 193 3.18 18.15 1.54 7.16 3.52 2204.22 -195 194 3.18 18.25 1.54 7.18 3.52 2214.58 -196 195 3.18 18.35 1.55 7.2 3.52 2221.46 -197 196 3.19 18.46 1.55 7.22 3.52 2230.2 -198 197 3.21 18.6 1.56 7.25 3.54 2240.96 -199 198 3.23 18.73 1.57 7.28 3.56 2255 -200 199 3.23 18.83 1.58 7.3 3.56 2264.66 -201 200 3.23 18.93 1.58 7.32 3.56 2275.08 -202 201 3.25 19.05 1.59 7.34 3.57 2287.72 -203 202 3.26 19.16 1.6 7.36 3.57 2300.16 -204 203 3.26 19.27 1.6 7.38 3.58 2309.28 -205 204 3.26 19.36 1.61 7.4 3.57 2315.29 -206 205 3.26 19.44 1.61 7.42 3.56 2320.5 -207 206 3.26 19.55 1.62 7.44 3.56 2328.23 -208 207 3.27 19.66 1.63 7.46 3.57 2336.16 -209 208 3.28 19.76 1.63 7.49 3.57 2345.08 -210 209 3.29 19.88 1.64 7.51 3.58 2354.93 -211 210 3.3 20 1.65 7.54 3.59 2366.52 -212 211 3.33 20.14 1.66 7.57 3.61 2381.57 -213 212 3.34 20.26 1.66 7.6 3.63 2395.23 -214 213 3.35 20.36 1.67 7.62 3.63 2408.6 -215 214 3.36 20.48 1.67 7.65 3.64 2424.59 -216 215 3.36 20.58 1.68 7.68 3.65 2439.93 -217 216 3.37 20.67 1.68 7.71 3.65 2457.37 -218 217 3.37 20.77 1.68 7.74 3.65 2473.74 -219 218 3.37 20.85 1.68 7.77 3.65 2491.39 -220 219 3.36 20.92 1.68 7.8 3.63 2507.31 -221 220 3.33 20.95 1.68 7.82 3.6 2522.01 -222 221 3.28 20.95 1.67 7.83 3.56 2537.01 -223 222 3.24 20.95 1.67 7.83 3.5 2551.19 -224 223 3.19 20.95 1.67 7.83 3.45 2569.01 -225 224 3.15 20.95 1.66 7.83 3.4 2585.7 -226 225 3.11 20.95 1.66 7.83 3.35 2600.12 -227 226 3.06 20.95 1.66 7.83 3.3 2610.91 -228 227 3.02 20.96 1.65 7.84 3.26 2620.07 -229 228 3.03 21.05 1.66 7.87 3.25 2630.64 -230 229 3.05 21.15 1.66 7.9 3.26 2642.8 -231 230 3.05 21.24 1.67 7.93 3.26 2656.33 -232 231 3.05 21.3 1.67 7.96 3.26 2672.21 -233 232 3.03 21.33 1.66 7.99 3.24 2687.62 -234 233 2.99 21.33 1.66 7.99 3.2 2703.55 -235 234 2.95 21.33 1.66 7.99 3.15 2721.22 -236 235 2.91 21.33 1.65 7.99 3.11 2739.57 -237 236 2.87 21.33 1.65 7.99 3.06 2756.22 -238 237 2.83 21.33 1.65 7.99 3.02 2776.98 -239 238 2.79 21.33 1.64 7.99 2.97 2791.02 -240 239 2.75 21.33 1.64 7.99 2.93 2804.7 -241 240 2.71 21.33 1.64 7.99 2.88 2819.19 -242 241 2.67 21.33 1.63 7.99 2.84 2835.2 -243 242 2.64 21.33 1.63 7.99 2.8 2854.65 -244 243 2.6 21.33 1.63 7.99 2.76 2873.78 -245 244 2.56 21.33 1.62 7.99 2.72 2887.29 -246 245 2.57 21.39 1.63 8.02 2.71 2898.43 -247 246 2.58 21.46 1.63 8.05 2.72 2910.81 -248 247 2.6 21.54 1.63 8.09 2.73 2926.43 -249 248 2.59 21.56 1.63 8.11 2.72 2936.07 -250 249 2.6 21.65 1.63 8.15 2.73 2947.38 -251 250 2.64 21.75 1.64 8.2 2.76 2961.73 -252 251 2.64 21.8 1.64 8.23 2.76 2975.34 -253 252 2.66 21.89 1.64 8.27 2.78 2989.15 -254 253 2.64 21.92 1.64 8.29 2.76 2997.98 -255 254 2.64 21.97 1.64 8.32 2.76 3007.2 -256 255 2.69 22.11 1.65 8.38 2.81 3023.08 -257 256 2.75 22.25 1.66 8.44 2.86 3038.77 -258 257 2.76 22.33 1.66 8.49 2.88 3053.1 -259 258 2.8 22.46 1.67 8.54 2.92 3066.35 -260 259 2.84 22.58 1.68 8.59 2.95 3078.03 -261 260 2.86 22.69 1.69 8.64 2.98 3087.94 -262 261 2.9 22.81 1.7 8.69 3.01 3098.9 -263 262 2.93 22.92 1.71 8.74 3.03 3108.45 -264 263 2.97 23.06 1.72 8.8 3.08 3121.43 -265 264 3.01 23.18 1.73 8.86 3.11 3137.7 -266 265 3.02 23.27 1.73 8.91 3.12 3150.92 -267 266 3.06 23.39 1.74 8.97 3.16 3165.7 -268 267 3.1 23.53 1.75 9.04 3.2 3178.97 -269 268 3.11 23.62 1.76 9.08 3.21 3189.9 -270 269 3.16 23.77 1.77 9.15 3.25 3202.23 -271 270 3.2 23.91 1.78 9.22 3.29 3215.84 -272 271 3.26 24.08 1.8 9.3 3.35 3232.43 -273 272 3.32 24.24 1.81 9.38 3.41 3251.22 -274 273 3.34 24.34 1.81 9.44 3.42 3266.42 -275 274 3.37 24.47 1.82 9.51 3.45 3279.67 -276 275 3.42 24.63 1.84 9.59 3.5 3294.93 -277 276 3.45 24.75 1.85 9.65 3.52 3307.68 -278 277 3.49 24.9 1.86 9.73 3.56 3320.52 -279 278 3.54 25.08 1.87 9.81 3.62 3335.72 -280 279 3.61 25.26 1.89 9.92 3.68 3355.41 -281 280 3.63 25.36 1.89 9.99 3.7 3372.77 -282 281 3.64 25.46 1.9 10.05 3.7 3385.34 -283 282 3.67 25.6 1.91 10.12 3.73 3398.38 -284 283 3.72 25.76 1.92 10.21 3.77 3411.77 -285 284 3.76 25.92 1.94 10.29 3.82 3426.84 -286 285 3.81 26.08 1.95 10.38 3.86 3443.43 -287 286 3.84 26.21 1.96 10.47 3.88 3459.18 -288 287 3.83 26.29 1.96 10.52 3.87 3469.16 -289 288 3.87 26.45 1.98 10.61 3.91 3482.23 -290 289 3.92 26.63 1.99 10.71 3.96 3499.4 -291 290 3.98 26.8 2 10.82 4.02 3518.62 -292 291 4 26.92 2.01 10.89 4.03 3532.7 -293 292 3.99 27.01 2.02 10.95 4.02 3542.12 -294 293 4.01 27.14 2.03 11.03 4.04 3554.51 -295 294 4.01 27.23 2.03 11.09 4.03 3564.17 -296 295 4.02 27.33 2.04 11.16 4.03 3575.01 -297 296 4.04 27.47 2.05 11.24 4.05 3586.66 -298 297 4.03 27.54 2.05 11.3 4.04 3596.72 -299 298 4.07 27.7 2.06 11.4 4.07 3610.21 -300 299 4.12 27.87 2.08 11.5 4.12 3624.52 -301 300 4.19 28.07 2.09 11.63 4.18 3644.44 -302 301 4.24 28.24 2.11 11.76 4.23 3666 -303 302 4.27 28.37 2.12 11.86 4.26 3683.69 -304 303 4.28 28.48 2.12 11.95 4.26 3700.07 -305 304 4.29 28.59 2.13 12.03 4.27 3714.06 -306 305 4.32 28.74 2.14 12.14 4.3 3730.44 -307 306 4.35 28.88 2.15 12.25 4.32 3747.46 -308 307 4.4 29.06 2.16 12.37 4.37 3765.59 -309 308 4.45 29.24 2.18 12.5 4.41 3782.82 -310 309 4.51 29.42 2.19 12.63 4.46 3801.68 -311 310 4.54 29.57 2.2 12.75 4.49 3819.5 -312 311 4.55 29.69 2.21 12.85 4.5 3835.5 -313 312 4.56 29.8 2.22 12.94 4.5 3848.71 -314 313 4.58 29.93 2.22 13.05 4.51 3865.15 -315 314 4.62 30.09 2.24 13.18 4.55 3884.59 -316 315 4.65 30.24 2.25 13.3 4.57 3900.14 -317 316 4.66 30.35 2.25 13.4 4.58 3916.9 -318 317 4.65 30.45 2.26 13.49 4.57 3929.34 -319 318 4.67 30.58 2.27 13.6 4.58 3945.02 -320 319 4.64 30.61 2.26 13.67 4.54 3958.54 -321 320 4.67 30.76 2.27 13.79 4.57 3975.44 -322 321 4.7 30.92 2.28 13.92 4.6 3992.3 -323 322 4.73 31.06 2.29 14.06 4.62 4011.95 -324 323 4.77 31.21 2.3 14.21 4.66 4032.37 -325 324 4.79 31.35 2.31 14.33 4.67 4048.78 -326 325 4.76 31.39 2.31 14.4 4.64 4060.99 -327 326 4.73 31.43 2.31 14.46 4.6 4070.55 -328 327 4.68 31.46 2.3 14.53 4.55 4082.39 -329 328 4.66 31.51 2.3 14.61 4.52 4095.96 -330 329 4.65 31.59 2.31 14.69 4.51 4108.44 -331 330 4.65 31.7 2.31 14.8 4.51 4122.31 -332 331 4.68 31.82 2.32 14.92 4.53 4138.39 -333 332 4.71 31.96 2.33 15.07 4.56 4158.49 -334 333 4.72 32.07 2.34 15.19 4.56 4173.36 -335 334 4.72 32.15 2.34 15.28 4.55 4187.28 -336 335 4.7 32.23 2.34 15.37 4.53 4199.31 -337 336 4.72 32.35 2.35 15.5 4.55 4214.7 -338 337 4.72 32.44 2.35 15.61 4.54 4229.42 -339 338 4.72 32.53 2.36 15.7 4.53 4241.54 -340 339 4.73 32.66 2.37 15.82 4.54 4254.4 -341 340 4.76 32.8 2.38 15.95 4.57 4267.94 -342 341 4.79 32.95 2.39 16.09 4.59 4281.94 -343 342 4.82 33.09 2.4 16.22 4.61 4296.9 -344 343 4.82 33.19 2.41 16.34 4.61 4310.37 -345 344 4.81 33.27 2.41 16.43 4.59 4322.45 -346 345 4.78 33.31 2.41 16.51 4.56 4333.9 -347 346 4.77 33.39 2.41 16.61 4.54 4346.62 -348 347 4.77 33.49 2.42 16.73 4.54 4360.28 -349 348 4.76 33.56 2.42 16.83 4.53 4373.89 -350 349 4.75 33.62 2.42 16.93 4.51 4387.12 -351 350 4.73 33.68 2.42 17.03 4.49 4399.69 -352 351 4.72 33.75 2.42 17.13 4.47 4412.86 -353 352 4.71 33.82 2.42 17.23 4.46 4426.36 -354 353 4.72 33.92 2.43 17.36 4.46 4441.53 -355 354 4.73 34.01 2.43 17.48 4.47 4455.78 -356 355 4.72 34.09 2.43 17.59 4.46 4469.04 -357 356 4.72 34.17 2.44 17.7 4.45 4482.17 -358 357 4.74 34.29 2.45 17.84 4.46 4496.3 -359 358 4.75 34.4 2.45 17.97 4.47 4511.12 -360 359 4.73 34.45 2.45 18.07 4.45 4523.91 -361 360 4.71 34.49 2.45 18.16 4.42 4537.91 -362 361 4.69 34.53 2.45 18.26 4.4 4552.12 -363 362 4.68 34.6 2.45 18.37 4.39 4565.94 -364 363 4.69 34.68 2.45 18.5 4.39 4580.54 -365 364 4.71 34.8 2.46 18.64 4.41 4595.54 -366 365 4.74 34.91 2.47 18.81 4.43 4614.21 -367 366 4.76 35.03 2.48 18.96 4.45 4629.25 diff --git a/web/sugarcane/python/plot.py b/web/sugarcane/python/plot.py deleted file mode 100755 index 5b3c430a59a..00000000000 --- a/web/sugarcane/python/plot.py +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/python -import os,time -import re,sys,tempfile -dir=os.path.dirname(sys.argv[0]) -os.environ['MPLCONFIGDIR'] = tempfile.mkdtemp() -import matplotlib -matplotlib.use('agg') -import matplotlib.pyplot as plt - -f=open(dir+"/../plot_data/output","r") -rows=filter(None, f.readlines()) -#keys=[rows[i] for i in range(len(rows)) if i%2==0] -#values=[filter(None, rows[i].split()) for i in range(len(rows)) if i%2==1] -numbers=[] -for index,row in enumerate(rows): - if index==0: - variables=re.findall(r'[^ \t\r\n]+', row) - else: - numbers.append(re.findall(r'[0-9\-\.]+', row)) - -if (len(sys.argv) > 2): - data=[] - for index,x in enumerate(sys.argv): - if index>0: # first argument is the file name/path. ignore it - i=variables.index(x)+1 # it is necessary to add 1 because the first row always has one less item because of the row numbers - column=[] - for number_row in numbers: - column.append(float(number_row[i])) # converting rows to columns - data.append(column) - #print data - -fig = plt.figure(figsize=(5, 4), dpi=80) -ax1 = fig.add_subplot(1,1,1) -ax1.set_xlabel(sys.argv[1]); -ax1.set_ylabel(sys.argv[2]); -#ax1.plot(range(len(data[0])),data[0],range(len(data[1])),data[1]) -plt.plot(data[0],data[1]) - -#ax2 = fig.add_subplot(2,1,2) -#ax2.plot(range(len(data[1])),data[1]) - -path=dir+'/png/'+os.urandom(6).encode('hex')+'.png' - -fig.savefig(path) -print path diff --git a/web/sugarcane/python/png/5afafac753c4.png b/web/sugarcane/python/png/5afafac753c4.png deleted file mode 100644 index 896b611e7a1..00000000000 Binary files a/web/sugarcane/python/png/5afafac753c4.png and /dev/null differ diff --git a/web/sugarcane/python/png/delete_old.sh b/web/sugarcane/python/png/delete_old.sh deleted file mode 100755 index 0a14485976e..00000000000 --- a/web/sugarcane/python/png/delete_old.sh +++ /dev/null @@ -1,11 +0,0 @@ -#!/bin/bash -DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" -now=$(date +%s) - -for file in "$DIR/"*".png" -do - if ((($(stat "$file" -c '%Z') + ((60*20))) < $now)) - then - rm "$file" - fi -done diff --git a/web/sugarcane/run.sh b/web/sugarcane/run.sh deleted file mode 100755 index a068e62e4b6..00000000000 --- a/web/sugarcane/run.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh - -R CMD BATCH ./sugarcane.R -# rm ./sugarcane.Rout -sed s/\"//g ./ooutput > ./plot_data/output -# rm ./ooutput -echo "done" diff --git a/web/sugarcane/static/ajax-loader.gif b/web/sugarcane/static/ajax-loader.gif deleted file mode 100644 index 08622f8c227..00000000000 Binary files a/web/sugarcane/static/ajax-loader.gif and /dev/null differ diff --git a/web/sugarcane/static/bootstrap-button.js b/web/sugarcane/static/bootstrap-button.js deleted file mode 100644 index 7f187be6206..00000000000 --- a/web/sugarcane/static/bootstrap-button.js +++ /dev/null @@ -1,96 +0,0 @@ -/* ============================================================ - * bootstrap-button.js v2.0.4 - * http://twitter.github.com/bootstrap/javascript.html#buttons - * ============================================================ - * Copyright 2012 Twitter, Inc. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * ============================================================ */ - - -!function ($) { - - "use strict"; // jshint ;_; - - - /* BUTTON PUBLIC CLASS DEFINITION - * ============================== */ - - var Button = function (element, options) { - this.$element = $(element) - this.options = $.extend({}, $.fn.button.defaults, options) - } - - Button.prototype.setState = function (state) { - var d = 'disabled' - , $el = this.$element - , data = $el.data() - , val = $el.is('input') ? 'val' : 'html' - - state = state + 'Text' - data.resetText || $el.data('resetText', $el[val]()) - - $el[val](data[state] || this.options[state]) - - // push to event loop to allow forms to submit - setTimeout(function () { - state == 'loadingText' ? - $el.addClass(d).attr(d, d) : - $el.removeClass(d).removeAttr(d) - }, 0) - } - - Button.prototype.toggle = function () { - var $parent = this.$element.parent('[data-toggle="buttons-radio"]') - - $parent && $parent - .find('.active') - .removeClass('active') - - this.$element.toggleClass('active') - } - - - /* BUTTON PLUGIN DEFINITION - * ======================== */ - - $.fn.button = function (option) { - return this.each(function () { - var $this = $(this) - , data = $this.data('button') - , options = typeof option == 'object' && option - if (!data) $this.data('button', (data = new Button(this, options))) - if (option == 'toggle') data.toggle() - else if (option) data.setState(option) - }) - } - - $.fn.button.defaults = { - loadingText: 'loading...' - } - - $.fn.button.Constructor = Button - - - /* BUTTON DATA-API - * =============== */ - - $(function () { - $('body').on('click.button.data-api', '[data-toggle^=button]', function ( e ) { - var $btn = $(e.target) - if (!$btn.hasClass('btn')) $btn = $btn.closest('.btn') - $btn.button('toggle') - }) - }) - -}(window.jQuery); \ No newline at end of file diff --git a/web/sugarcane/static/bootstrap-responsive.min.css b/web/sugarcane/static/bootstrap-responsive.min.css deleted file mode 100644 index dd134a1bd2c..00000000000 --- a/web/sugarcane/static/bootstrap-responsive.min.css +++ /dev/null @@ -1,9 +0,0 @@ -/*! - * Bootstrap Responsive v2.0.3 - * - * Copyright 2012 Twitter, Inc - * Licensed under the Apache License v2.0 - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Designed and built with all the love in the world @twitter by @mdo and @fat. - */.clearfix{*zoom:1}.clearfix:before,.clearfix:after{display:table;content:""}.clearfix:after{clear:both}.hide-text{font:0/0 a;color:transparent;text-shadow:none;background-color:transparent;border:0}.input-block-level{display:block;width:100%;min-height:28px;-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box}.hidden{display:none;visibility:hidden}.visible-phone{display:none!important}.visible-tablet{display:none!important}.hidden-desktop{display:none!important}@media(max-width:767px){.visible-phone{display:inherit!important}.hidden-phone{display:none!important}.hidden-desktop{display:inherit!important}.visible-desktop{display:none!important}}@media(min-width:768px) and (max-width:979px){.visible-tablet{display:inherit!important}.hidden-tablet{display:none!important}.hidden-desktop{display:inherit!important}.visible-desktop{display:none!important}}@media(max-width:480px){.nav-collapse{-webkit-transform:translate3d(0,0,0)}.page-header h1 small{display:block;line-height:18px}input[type="checkbox"],input[type="radio"]{border:1px solid #ccc}.form-horizontal .control-group>label{float:none;width:auto;padding-top:0;text-align:left}.form-horizontal .controls{margin-left:0}.form-horizontal .control-list{padding-top:0}.form-horizontal .form-actions{padding-right:10px;padding-left:10px}.modal{position:absolute;top:10px;right:10px;left:10px;width:auto;margin:0}.modal.fade.in{top:auto}.modal-header .close{padding:10px;margin:-10px}.carousel-caption{position:static}}@media(max-width:767px){body{padding-right:20px;padding-left:20px}.navbar-fixed-top,.navbar-fixed-bottom{margin-right:-20px;margin-left:-20px}.container-fluid{padding:0}.dl-horizontal dt{float:none;width:auto;clear:none;text-align:left}.dl-horizontal dd{margin-left:0}.container{width:auto}.row-fluid{width:100%}.row,.thumbnails{margin-left:0}[class*="span"],.row-fluid [class*="span"]{display:block;float:none;width:auto;margin-left:0}.input-large,.input-xlarge,.input-xxlarge,input[class*="span"],select[class*="span"],textarea[class*="span"],.uneditable-input{display:block;width:100%;min-height:28px;-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box}.input-prepend input,.input-append input,.input-prepend input[class*="span"],.input-append input[class*="span"]{display:inline-block;width:auto}}@media(min-width:768px) and (max-width:979px){.row{margin-left:-20px;*zoom:1}.row:before,.row:after{display:table;content:""}.row:after{clear:both}[class*="span"]{float:left;margin-left:20px}.container,.navbar-fixed-top .container,.navbar-fixed-bottom .container{width:724px}.span12{width:724px}.span11{width:662px}.span10{width:600px}.span9{width:538px}.span8{width:476px}.span7{width:414px}.span6{width:352px}.span5{width:290px}.span4{width:228px}.span3{width:166px}.span2{width:104px}.span1{width:42px}.offset12{margin-left:764px}.offset11{margin-left:702px}.offset10{margin-left:640px}.offset9{margin-left:578px}.offset8{margin-left:516px}.offset7{margin-left:454px}.offset6{margin-left:392px}.offset5{margin-left:330px}.offset4{margin-left:268px}.offset3{margin-left:206px}.offset2{margin-left:144px}.offset1{margin-left:82px}.row-fluid{width:100%;*zoom:1}.row-fluid:before,.row-fluid:after{display:table;content:""}.row-fluid:after{clear:both}.row-fluid [class*="span"]{display:block;float:left;width:100%;min-height:28px;margin-left:2.762430939%;*margin-left:2.709239449638298%;-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box}.row-fluid [class*="span"]:first-child{margin-left:0}.row-fluid .span12{width:99.999999993%;*width:99.9468085036383%}.row-fluid .span11{width:91.436464082%;*width:91.38327259263829%}.row-fluid .span10{width:82.87292817100001%;*width:82.8197366816383%}.row-fluid .span9{width:74.30939226%;*width:74.25620077063829%}.row-fluid .span8{width:65.74585634900001%;*width:65.6926648596383%}.row-fluid .span7{width:57.182320438000005%;*width:57.129128948638304%}.row-fluid .span6{width:48.618784527%;*width:48.5655930376383%}.row-fluid .span5{width:40.055248616%;*width:40.0020571266383%}.row-fluid .span4{width:31.491712705%;*width:31.4385212156383%}.row-fluid .span3{width:22.928176794%;*width:22.874985304638297%}.row-fluid .span2{width:14.364640883%;*width:14.311449393638298%}.row-fluid .span1{width:5.801104972%;*width:5.747913482638298%}input,textarea,.uneditable-input{margin-left:0}input.span12,textarea.span12,.uneditable-input.span12{width:714px}input.span11,textarea.span11,.uneditable-input.span11{width:652px}input.span10,textarea.span10,.uneditable-input.span10{width:590px}input.span9,textarea.span9,.uneditable-input.span9{width:528px}input.span8,textarea.span8,.uneditable-input.span8{width:466px}input.span7,textarea.span7,.uneditable-input.span7{width:404px}input.span6,textarea.span6,.uneditable-input.span6{width:342px}input.span5,textarea.span5,.uneditable-input.span5{width:280px}input.span4,textarea.span4,.uneditable-input.span4{width:218px}input.span3,textarea.span3,.uneditable-input.span3{width:156px}input.span2,textarea.span2,.uneditable-input.span2{width:94px}input.span1,textarea.span1,.uneditable-input.span1{width:32px}}@media(min-width:1200px){.row{margin-left:-30px;*zoom:1}.row:before,.row:after{display:table;content:""}.row:after{clear:both}[class*="span"]{float:left;margin-left:30px}.container,.navbar-fixed-top .container,.navbar-fixed-bottom .container{width:1170px}.span12{width:1170px}.span11{width:1070px}.span10{width:970px}.span9{width:870px}.span8{width:770px}.span7{width:670px}.span6{width:570px}.span5{width:470px}.span4{width:370px}.span3{width:270px}.span2{width:170px}.span1{width:70px}.offset12{margin-left:1230px}.offset11{margin-left:1130px}.offset10{margin-left:1030px}.offset9{margin-left:930px}.offset8{margin-left:830px}.offset7{margin-left:730px}.offset6{margin-left:630px}.offset5{margin-left:530px}.offset4{margin-left:430px}.offset3{margin-left:330px}.offset2{margin-left:230px}.offset1{margin-left:130px}.row-fluid{width:100%;*zoom:1}.row-fluid:before,.row-fluid:after{display:table;content:""}.row-fluid:after{clear:both}.row-fluid [class*="span"]{display:block;float:left;width:100%;min-height:28px;margin-left:2.564102564%;*margin-left:2.510911074638298%;-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box}.row-fluid [class*="span"]:first-child{margin-left:0}.row-fluid .span12{width:100%;*width:99.94680851063829%}.row-fluid .span11{width:91.45299145300001%;*width:91.3997999636383%}.row-fluid .span10{width:82.905982906%;*width:82.8527914166383%}.row-fluid .span9{width:74.358974359%;*width:74.30578286963829%}.row-fluid .span8{width:65.81196581200001%;*width:65.7587743226383%}.row-fluid .span7{width:57.264957265%;*width:57.2117657756383%}.row-fluid .span6{width:48.717948718%;*width:48.6647572286383%}.row-fluid .span5{width:40.170940171000005%;*width:40.117748681638304%}.row-fluid .span4{width:31.623931624%;*width:31.5707401346383%}.row-fluid .span3{width:23.076923077%;*width:23.0237315876383%}.row-fluid .span2{width:14.529914530000001%;*width:14.4767230406383%}.row-fluid .span1{width:5.982905983%;*width:5.929714493638298%}input,textarea,.uneditable-input{margin-left:0}input.span12,textarea.span12,.uneditable-input.span12{width:1160px}input.span11,textarea.span11,.uneditable-input.span11{width:1060px}input.span10,textarea.span10,.uneditable-input.span10{width:960px}input.span9,textarea.span9,.uneditable-input.span9{width:860px}input.span8,textarea.span8,.uneditable-input.span8{width:760px}input.span7,textarea.span7,.uneditable-input.span7{width:660px}input.span6,textarea.span6,.uneditable-input.span6{width:560px}input.span5,textarea.span5,.uneditable-input.span5{width:460px}input.span4,textarea.span4,.uneditable-input.span4{width:360px}input.span3,textarea.span3,.uneditable-input.span3{width:260px}input.span2,textarea.span2,.uneditable-input.span2{width:160px}input.span1,textarea.span1,.uneditable-input.span1{width:60px}.thumbnails{margin-left:-30px}.thumbnails>li{margin-left:30px}.row-fluid .thumbnails{margin-left:0}}@media(max-width:979px){body{padding-top:0}.navbar-fixed-top{position:static;margin-bottom:18px}.navbar-fixed-top .navbar-inner{padding:5px}.navbar .container{width:auto;padding:0}.navbar .brand{padding-right:10px;padding-left:10px;margin:0 0 0 -5px}.nav-collapse{clear:both}.nav-collapse .nav{float:none;margin:0 0 9px}.nav-collapse .nav>li{float:none}.nav-collapse .nav>li>a{margin-bottom:2px}.nav-collapse .nav>.divider-vertical{display:none}.nav-collapse .nav .nav-header{color:#999;text-shadow:none}.nav-collapse .nav>li>a,.nav-collapse .dropdown-menu a{padding:6px 15px;font-weight:bold;color:#999;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px}.nav-collapse .btn{padding:4px 10px 4px;font-weight:normal;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}.nav-collapse .dropdown-menu li+li a{margin-bottom:2px}.nav-collapse .nav>li>a:hover,.nav-collapse .dropdown-menu a:hover{background-color:#222}.nav-collapse.in .btn-group{padding:0;margin-top:5px}.nav-collapse .dropdown-menu{position:static;top:auto;left:auto;display:block;float:none;max-width:none;padding:0;margin:0 15px;background-color:transparent;border:0;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0;-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none}.nav-collapse .dropdown-menu:before,.nav-collapse .dropdown-menu:after{display:none}.nav-collapse .dropdown-menu .divider{display:none}.nav-collapse .navbar-form,.nav-collapse .navbar-search{float:none;padding:9px 15px;margin:9px 0;border-top:1px solid #222;border-bottom:1px solid #222;-webkit-box-shadow:inset 0 1px 0 rgba(255,255,255,0.1),0 1px 0 rgba(255,255,255,0.1);-moz-box-shadow:inset 0 1px 0 rgba(255,255,255,0.1),0 1px 0 rgba(255,255,255,0.1);box-shadow:inset 0 1px 0 rgba(255,255,255,0.1),0 1px 0 rgba(255,255,255,0.1)}.navbar .nav-collapse .nav.pull-right{float:none;margin-left:0}.nav-collapse,.nav-collapse.collapse{height:0;overflow:hidden}.navbar .btn-navbar{display:block}.navbar-static .navbar-inner{padding-right:10px;padding-left:10px}}@media(min-width:980px){.nav-collapse.collapse{height:auto!important;overflow:visible!important}} diff --git a/web/sugarcane/static/bootstrap-tab.js b/web/sugarcane/static/bootstrap-tab.js deleted file mode 100644 index 88641de864c..00000000000 --- a/web/sugarcane/static/bootstrap-tab.js +++ /dev/null @@ -1,135 +0,0 @@ -/* ======================================================== - * bootstrap-tab.js v2.0.3 - * http://twitter.github.com/bootstrap/javascript.html#tabs - * ======================================================== - * Copyright 2012 Twitter, Inc. - * - * Licensed under the Apache License, Version 2.0 (the "License"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an "AS IS" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * ======================================================== */ - - -!function ($) { - - "use strict"; // jshint ;_; - - - /* TAB CLASS DEFINITION - * ==================== */ - - var Tab = function ( element ) { - this.element = $(element) - } - - Tab.prototype = { - - constructor: Tab - - , show: function () { - var $this = this.element - , $ul = $this.closest('ul:not(.dropdown-menu)') - , selector = $this.attr('data-target') - , previous - , $target - , e - - if (!selector) { - selector = $this.attr('href') - selector = selector && selector.replace(/.*(?=#[^\s]*$)/, '') //strip for ie7 - } - - if ( $this.parent('li').hasClass('active') ) return - - previous = $ul.find('.active a').last()[0] - - e = $.Event('show', { - relatedTarget: previous - }) - - $this.trigger(e) - - if (e.isDefaultPrevented()) return - - $target = $(selector) - - this.activate($this.parent('li'), $ul) - this.activate($target, $target.parent(), function () { - $this.trigger({ - type: 'shown' - , relatedTarget: previous - }) - }) - } - - , activate: function ( element, container, callback) { - var $active = container.find('> .active') - , transition = callback - && $.support.transition - && $active.hasClass('fade') - - function next() { - $active - .removeClass('active') - .find('> .dropdown-menu > .active') - .removeClass('active') - - element.addClass('active') - - if (transition) { - element[0].offsetWidth // reflow for transition - element.addClass('in') - } else { - element.removeClass('fade') - } - - if ( element.parent('.dropdown-menu') ) { - element.closest('li.dropdown').addClass('active') - } - - callback && callback() - } - - transition ? - $active.one($.support.transition.end, next) : - next() - - $active.removeClass('in') - } - } - - - /* TAB PLUGIN DEFINITION - * ===================== */ - - $.fn.tab = function ( option ) { - return this.each(function () { - var $this = $(this) - , data = $this.data('tab') - if (!data) $this.data('tab', (data = new Tab(this))) - if (typeof option == 'string') data[option]() - }) - } - - $.fn.tab.Constructor = Tab - - - /* TAB DATA-API - * ============ */ - - $(function () { - $('body').on('click.tab.data-api', '[data-toggle="tab"], [data-toggle="pill"]', function (e) { - e.preventDefault() - $(this).tab('show') - }) - }) - -}(window.jQuery); \ No newline at end of file diff --git a/web/sugarcane/static/bootstrap.min.css b/web/sugarcane/static/bootstrap.min.css deleted file mode 100644 index 1c75d0c07a4..00000000000 --- a/web/sugarcane/static/bootstrap.min.css +++ /dev/null @@ -1,9 +0,0 @@ -/*! - * Bootstrap v2.0.3 - * - * Copyright 2012 Twitter, Inc - * Licensed under the Apache License v2.0 - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Designed and built with all the love in the world @twitter by @mdo and @fat. - */article,aside,details,figcaption,figure,footer,header,hgroup,nav,section{display:block}audio,canvas,video{display:inline-block;*display:inline;*zoom:1}audio:not([controls]){display:none}html{font-size:100%;-webkit-text-size-adjust:100%;-ms-text-size-adjust:100%}a:focus{outline:thin dotted #333;outline:5px auto -webkit-focus-ring-color;outline-offset:-2px}a:hover,a:active{outline:0}sub,sup{position:relative;font-size:75%;line-height:0;vertical-align:baseline}sup{top:-0.5em}sub{bottom:-0.25em}img{max-width:100%;vertical-align:middle;border:0;-ms-interpolation-mode:bicubic}button,input,select,textarea{margin:0;font-size:100%;vertical-align:middle}button,input{*overflow:visible;line-height:normal}button::-moz-focus-inner,input::-moz-focus-inner{padding:0;border:0}button,input[type="button"],input[type="reset"],input[type="submit"]{cursor:pointer;-webkit-appearance:button}input[type="search"]{-webkit-box-sizing:content-box;-moz-box-sizing:content-box;box-sizing:content-box;-webkit-appearance:textfield}input[type="search"]::-webkit-search-decoration,input[type="search"]::-webkit-search-cancel-button{-webkit-appearance:none}textarea{overflow:auto;vertical-align:top}.clearfix{*zoom:1}.clearfix:before,.clearfix:after{display:table;content:""}.clearfix:after{clear:both}.hide-text{font:0/0 a;color:transparent;text-shadow:none;background-color:transparent;border:0}.input-block-level{display:block;width:100%;min-height:28px;-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box}body{margin:0;font-family:"Helvetica Neue",Helvetica,Arial,sans-serif;font-size:13px;line-height:18px;color:#333;background-color:#fff}a{color:#08c;text-decoration:none}a:hover{color:#005580;text-decoration:underline}.row{margin-left:-20px;*zoom:1}.row:before,.row:after{display:table;content:""}.row:after{clear:both}[class*="span"]{float:left;margin-left:20px}.container,.navbar-fixed-top .container,.navbar-fixed-bottom .container{width:940px}.span12{width:940px}.span11{width:860px}.span10{width:780px}.span9{width:700px}.span8{width:620px}.span7{width:540px}.span6{width:460px}.span5{width:380px}.span4{width:300px}.span3{width:220px}.span2{width:140px}.span1{width:60px}.offset12{margin-left:980px}.offset11{margin-left:900px}.offset10{margin-left:820px}.offset9{margin-left:740px}.offset8{margin-left:660px}.offset7{margin-left:580px}.offset6{margin-left:500px}.offset5{margin-left:420px}.offset4{margin-left:340px}.offset3{margin-left:260px}.offset2{margin-left:180px}.offset1{margin-left:100px}.row-fluid{width:100%;*zoom:1}.row-fluid:before,.row-fluid:after{display:table;content:""}.row-fluid:after{clear:both}.row-fluid [class*="span"]{display:block;float:left;width:100%;min-height:28px;margin-left:2.127659574%;*margin-left:2.0744680846382977%;-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box}.row-fluid [class*="span"]:first-child{margin-left:0}.row-fluid .span12{width:99.99999998999999%;*width:99.94680850063828%}.row-fluid .span11{width:91.489361693%;*width:91.4361702036383%}.row-fluid .span10{width:82.97872339599999%;*width:82.92553190663828%}.row-fluid .span9{width:74.468085099%;*width:74.4148936096383%}.row-fluid .span8{width:65.95744680199999%;*width:65.90425531263828%}.row-fluid .span7{width:57.446808505%;*width:57.3936170156383%}.row-fluid .span6{width:48.93617020799999%;*width:48.88297871863829%}.row-fluid .span5{width:40.425531911%;*width:40.3723404216383%}.row-fluid .span4{width:31.914893614%;*width:31.8617021246383%}.row-fluid .span3{width:23.404255317%;*width:23.3510638276383%}.row-fluid .span2{width:14.89361702%;*width:14.8404255306383%}.row-fluid .span1{width:6.382978723%;*width:6.329787233638298%}.container{margin-right:auto;margin-left:auto;*zoom:1}.container:before,.container:after{display:table;content:""}.container:after{clear:both}.container-fluid{padding-right:20px;padding-left:20px;*zoom:1}.container-fluid:before,.container-fluid:after{display:table;content:""}.container-fluid:after{clear:both}p{margin:0 0 9px;font-family:"Helvetica Neue",Helvetica,Arial,sans-serif;font-size:13px;line-height:18px}p small{font-size:11px;color:#999}.lead{margin-bottom:18px;font-size:20px;font-weight:200;line-height:27px}h1,h2,h3,h4,h5,h6{margin:0;font-family:inherit;font-weight:bold;color:inherit;text-rendering:optimizelegibility}h1 small,h2 small,h3 small,h4 small,h5 small,h6 small{font-weight:normal;color:#999}h1{font-size:30px;line-height:36px}h1 small{font-size:18px}h2{font-size:24px;line-height:36px}h2 small{font-size:18px}h3{font-size:18px;line-height:27px}h3 small{font-size:14px}h4,h5,h6{line-height:18px}h4{font-size:14px}h4 small{font-size:12px}h5{font-size:12px}h6{font-size:11px;color:#999;text-transform:uppercase}.page-header{padding-bottom:17px;margin:18px 0;border-bottom:1px solid #eee}.page-header h1{line-height:1}ul,ol{padding:0;margin:0 0 9px 25px}ul ul,ul ol,ol ol,ol ul{margin-bottom:0}ul{list-style:disc}ol{list-style:decimal}li{line-height:18px}ul.unstyled,ol.unstyled{margin-left:0;list-style:none}dl{margin-bottom:18px}dt,dd{line-height:18px}dt{font-weight:bold;line-height:17px}dd{margin-left:9px}.dl-horizontal dt{float:left;width:120px;overflow:hidden;clear:left;text-align:right;text-overflow:ellipsis;white-space:nowrap}.dl-horizontal dd{margin-left:130px}hr{margin:18px 0;border:0;border-top:1px solid #eee;border-bottom:1px solid #fff}strong{font-weight:bold}em{font-style:italic}.muted{color:#999}abbr[title]{cursor:help;border-bottom:1px dotted #ddd}abbr.initialism{font-size:90%;text-transform:uppercase}blockquote{padding:0 0 0 15px;margin:0 0 18px;border-left:5px solid #eee}blockquote p{margin-bottom:0;font-size:16px;font-weight:300;line-height:22.5px}blockquote small{display:block;line-height:18px;color:#999}blockquote small:before{content:'\2014 \00A0'}blockquote.pull-right{float:right;padding-right:15px;padding-left:0;border-right:5px solid #eee;border-left:0}blockquote.pull-right p,blockquote.pull-right small{text-align:right}q:before,q:after,blockquote:before,blockquote:after{content:""}address{display:block;margin-bottom:18px;font-style:normal;line-height:18px}small{font-size:100%}cite{font-style:normal}code,pre{padding:0 3px 2px;font-family:Menlo,Monaco,Consolas,"Courier New",monospace;font-size:12px;color:#333;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px}code{padding:2px 4px;color:#d14;background-color:#f7f7f9;border:1px solid #e1e1e8}pre{display:block;padding:8.5px;margin:0 0 9px;font-size:12.025px;line-height:18px;word-break:break-all;word-wrap:break-word;white-space:pre;white-space:pre-wrap;background-color:#f5f5f5;border:1px solid #ccc;border:1px solid rgba(0,0,0,0.15);-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}pre.prettyprint{margin-bottom:18px}pre code{padding:0;color:inherit;background-color:transparent;border:0}.pre-scrollable{max-height:340px;overflow-y:scroll}form{margin:0 0 18px}fieldset{padding:0;margin:0;border:0}legend{display:block;width:100%;padding:0;margin-bottom:27px;font-size:19.5px;line-height:36px;color:#333;border:0;border-bottom:1px solid #eee}legend small{font-size:13.5px;color:#999}label,input,button,select,textarea{font-size:13px;font-weight:normal;line-height:18px}input,button,select,textarea{font-family:"Helvetica Neue",Helvetica,Arial,sans-serif}label{display:block;margin-bottom:5px;color:#333}input,textarea,select,.uneditable-input{display:inline-block;width:210px;height:18px;padding:4px;margin-bottom:9px;font-size:13px;line-height:18px;color:#555;background-color:#fff;border:1px solid #ccc;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px}.uneditable-textarea{width:auto;height:auto}label input,label textarea,label select{display:block}input[type="image"],input[type="checkbox"],input[type="radio"]{width:auto;height:auto;padding:0;margin:3px 0;*margin-top:0;line-height:normal;cursor:pointer;background-color:transparent;border:0 \9;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0}input[type="image"]{border:0}input[type="file"]{width:auto;padding:initial;line-height:initial;background-color:#fff;background-color:initial;border:initial;-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none}input[type="button"],input[type="reset"],input[type="submit"]{width:auto;height:auto}select,input[type="file"]{height:28px;*margin-top:4px;line-height:28px}input[type="file"]{line-height:18px \9}select{width:220px;background-color:#fff}select[multiple],select[size]{height:auto}input[type="image"]{-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none}textarea{height:auto}input[type="hidden"]{display:none}.radio,.checkbox{min-height:18px;padding-left:18px}.radio input[type="radio"],.checkbox input[type="checkbox"]{float:left;margin-left:-18px}.controls>.radio:first-child,.controls>.checkbox:first-child{padding-top:5px}.radio.inline,.checkbox.inline{display:inline-block;padding-top:5px;margin-bottom:0;vertical-align:middle}.radio.inline+.radio.inline,.checkbox.inline+.checkbox.inline{margin-left:10px}input,textarea{-webkit-box-shadow:inset 0 1px 1px rgba(0,0,0,0.075);-moz-box-shadow:inset 0 1px 1px rgba(0,0,0,0.075);box-shadow:inset 0 1px 1px rgba(0,0,0,0.075);-webkit-transition:border linear .2s,box-shadow linear .2s;-moz-transition:border linear .2s,box-shadow linear .2s;-ms-transition:border linear .2s,box-shadow linear .2s;-o-transition:border linear .2s,box-shadow linear .2s;transition:border linear .2s,box-shadow linear .2s}input:focus,textarea:focus{border-color:rgba(82,168,236,0.8);outline:0;outline:thin dotted \9;-webkit-box-shadow:inset 0 1px 1px rgba(0,0,0,0.075),0 0 8px rgba(82,168,236,0.6);-moz-box-shadow:inset 0 1px 1px rgba(0,0,0,0.075),0 0 8px rgba(82,168,236,0.6);box-shadow:inset 0 1px 1px rgba(0,0,0,0.075),0 0 8px rgba(82,168,236,0.6)}input[type="file"]:focus,input[type="radio"]:focus,input[type="checkbox"]:focus,select:focus{outline:thin dotted #333;outline:5px auto -webkit-focus-ring-color;outline-offset:-2px;-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none}.input-mini{width:60px}.input-small{width:90px}.input-medium{width:150px}.input-large{width:210px}.input-xlarge{width:270px}.input-xxlarge{width:530px}input[class*="span"],select[class*="span"],textarea[class*="span"],.uneditable-input[class*="span"],.row-fluid input[class*="span"],.row-fluid select[class*="span"],.row-fluid textarea[class*="span"],.row-fluid .uneditable-input[class*="span"]{float:none;margin-left:0}input,textarea,.uneditable-input{margin-left:0}input.span12,textarea.span12,.uneditable-input.span12{width:930px}input.span11,textarea.span11,.uneditable-input.span11{width:850px}input.span10,textarea.span10,.uneditable-input.span10{width:770px}input.span9,textarea.span9,.uneditable-input.span9{width:690px}input.span8,textarea.span8,.uneditable-input.span8{width:610px}input.span7,textarea.span7,.uneditable-input.span7{width:530px}input.span6,textarea.span6,.uneditable-input.span6{width:450px}input.span5,textarea.span5,.uneditable-input.span5{width:370px}input.span4,textarea.span4,.uneditable-input.span4{width:290px}input.span3,textarea.span3,.uneditable-input.span3{width:210px}input.span2,textarea.span2,.uneditable-input.span2{width:130px}input.span1,textarea.span1,.uneditable-input.span1{width:50px}input[disabled],select[disabled],textarea[disabled],input[readonly],select[readonly],textarea[readonly]{cursor:not-allowed;background-color:#eee;border-color:#ddd}input[type="radio"][disabled],input[type="checkbox"][disabled],input[type="radio"][readonly],input[type="checkbox"][readonly]{background-color:transparent}.control-group.warning>label,.control-group.warning .help-block,.control-group.warning .help-inline{color:#c09853}.control-group.warning input,.control-group.warning select,.control-group.warning textarea{color:#c09853;border-color:#c09853}.control-group.warning input:focus,.control-group.warning select:focus,.control-group.warning textarea:focus{border-color:#a47e3c;-webkit-box-shadow:0 0 6px #dbc59e;-moz-box-shadow:0 0 6px #dbc59e;box-shadow:0 0 6px #dbc59e}.control-group.warning .input-prepend .add-on,.control-group.warning .input-append .add-on{color:#c09853;background-color:#fcf8e3;border-color:#c09853}.control-group.error>label,.control-group.error .help-block,.control-group.error .help-inline{color:#b94a48}.control-group.error input,.control-group.error select,.control-group.error textarea{color:#b94a48;border-color:#b94a48}.control-group.error input:focus,.control-group.error select:focus,.control-group.error textarea:focus{border-color:#953b39;-webkit-box-shadow:0 0 6px #d59392;-moz-box-shadow:0 0 6px #d59392;box-shadow:0 0 6px #d59392}.control-group.error .input-prepend .add-on,.control-group.error .input-append .add-on{color:#b94a48;background-color:#f2dede;border-color:#b94a48}.control-group.success>label,.control-group.success .help-block,.control-group.success .help-inline{color:#468847}.control-group.success input,.control-group.success select,.control-group.success textarea{color:#468847;border-color:#468847}.control-group.success input:focus,.control-group.success select:focus,.control-group.success textarea:focus{border-color:#356635;-webkit-box-shadow:0 0 6px #7aba7b;-moz-box-shadow:0 0 6px #7aba7b;box-shadow:0 0 6px #7aba7b}.control-group.success .input-prepend .add-on,.control-group.success .input-append .add-on{color:#468847;background-color:#dff0d8;border-color:#468847}input:focus:required:invalid,textarea:focus:required:invalid,select:focus:required:invalid{color:#b94a48;border-color:#ee5f5b}input:focus:required:invalid:focus,textarea:focus:required:invalid:focus,select:focus:required:invalid:focus{border-color:#e9322d;-webkit-box-shadow:0 0 6px #f8b9b7;-moz-box-shadow:0 0 6px #f8b9b7;box-shadow:0 0 6px #f8b9b7}.form-actions{padding:17px 20px 18px;margin-top:18px;margin-bottom:18px;background-color:#f5f5f5;border-top:1px solid #ddd;*zoom:1}.form-actions:before,.form-actions:after{display:table;content:""}.form-actions:after{clear:both}.uneditable-input{overflow:hidden;white-space:nowrap;cursor:not-allowed;background-color:#fff;border-color:#eee;-webkit-box-shadow:inset 0 1px 2px rgba(0,0,0,0.025);-moz-box-shadow:inset 0 1px 2px rgba(0,0,0,0.025);box-shadow:inset 0 1px 2px rgba(0,0,0,0.025)}:-moz-placeholder{color:#999}::-webkit-input-placeholder{color:#999}.help-block,.help-inline{color:#555}.help-block{display:block;margin-bottom:9px}.help-inline{display:inline-block;*display:inline;padding-left:5px;vertical-align:middle;*zoom:1}.input-prepend,.input-append{margin-bottom:5px}.input-prepend input,.input-append input,.input-prepend select,.input-append select,.input-prepend .uneditable-input,.input-append .uneditable-input{position:relative;margin-bottom:0;*margin-left:0;vertical-align:middle;-webkit-border-radius:0 3px 3px 0;-moz-border-radius:0 3px 3px 0;border-radius:0 3px 3px 0}.input-prepend input:focus,.input-append input:focus,.input-prepend select:focus,.input-append select:focus,.input-prepend .uneditable-input:focus,.input-append .uneditable-input:focus{z-index:2}.input-prepend .uneditable-input,.input-append .uneditable-input{border-left-color:#ccc}.input-prepend .add-on,.input-append .add-on{display:inline-block;width:auto;height:18px;min-width:16px;padding:4px 5px;font-weight:normal;line-height:18px;text-align:center;text-shadow:0 1px 0 #fff;vertical-align:middle;background-color:#eee;border:1px solid #ccc}.input-prepend .add-on,.input-append .add-on,.input-prepend .btn,.input-append .btn{margin-left:-1px;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0}.input-prepend .active,.input-append .active{background-color:#a9dba9;border-color:#46a546}.input-prepend .add-on,.input-prepend .btn{margin-right:-1px}.input-prepend .add-on:first-child,.input-prepend .btn:first-child{-webkit-border-radius:3px 0 0 3px;-moz-border-radius:3px 0 0 3px;border-radius:3px 0 0 3px}.input-append input,.input-append select,.input-append .uneditable-input{-webkit-border-radius:3px 0 0 3px;-moz-border-radius:3px 0 0 3px;border-radius:3px 0 0 3px}.input-append .uneditable-input{border-right-color:#ccc;border-left-color:#eee}.input-append .add-on:last-child,.input-append .btn:last-child{-webkit-border-radius:0 3px 3px 0;-moz-border-radius:0 3px 3px 0;border-radius:0 3px 3px 0}.input-prepend.input-append input,.input-prepend.input-append select,.input-prepend.input-append .uneditable-input{-webkit-border-radius:0;-moz-border-radius:0;border-radius:0}.input-prepend.input-append .add-on:first-child,.input-prepend.input-append .btn:first-child{margin-right:-1px;-webkit-border-radius:3px 0 0 3px;-moz-border-radius:3px 0 0 3px;border-radius:3px 0 0 3px}.input-prepend.input-append .add-on:last-child,.input-prepend.input-append .btn:last-child{margin-left:-1px;-webkit-border-radius:0 3px 3px 0;-moz-border-radius:0 3px 3px 0;border-radius:0 3px 3px 0}.search-query{padding-right:14px;padding-right:4px \9;padding-left:14px;padding-left:4px \9;margin-bottom:0;-webkit-border-radius:14px;-moz-border-radius:14px;border-radius:14px}.form-search input,.form-inline input,.form-horizontal input,.form-search textarea,.form-inline textarea,.form-horizontal textarea,.form-search select,.form-inline select,.form-horizontal select,.form-search .help-inline,.form-inline .help-inline,.form-horizontal .help-inline,.form-search .uneditable-input,.form-inline .uneditable-input,.form-horizontal .uneditable-input,.form-search .input-prepend,.form-inline .input-prepend,.form-horizontal .input-prepend,.form-search .input-append,.form-inline .input-append,.form-horizontal .input-append{display:inline-block;*display:inline;margin-bottom:0;*zoom:1}.form-search .hide,.form-inline .hide,.form-horizontal .hide{display:none}.form-search label,.form-inline label{display:inline-block}.form-search .input-append,.form-inline .input-append,.form-search .input-prepend,.form-inline .input-prepend{margin-bottom:0}.form-search .radio,.form-search .checkbox,.form-inline .radio,.form-inline .checkbox{padding-left:0;margin-bottom:0;vertical-align:middle}.form-search .radio input[type="radio"],.form-search .checkbox input[type="checkbox"],.form-inline .radio input[type="radio"],.form-inline .checkbox input[type="checkbox"]{float:left;margin-right:3px;margin-left:0}.control-group{margin-bottom:9px}legend+.control-group{margin-top:18px;-webkit-margin-top-collapse:separate}.form-horizontal .control-group{margin-bottom:18px;*zoom:1}.form-horizontal .control-group:before,.form-horizontal .control-group:after{display:table;content:""}.form-horizontal .control-group:after{clear:both}.form-horizontal .control-label{float:left;width:140px;padding-top:5px;text-align:right}.form-horizontal .controls{*display:inline-block;*padding-left:20px;margin-left:160px;*margin-left:0}.form-horizontal .controls:first-child{*padding-left:160px}.form-horizontal .help-block{margin-top:9px;margin-bottom:0}.form-horizontal .form-actions{padding-left:160px}table{max-width:100%;background-color:transparent;border-collapse:collapse;border-spacing:0}.table{width:100%;margin-bottom:18px}.table th,.table td{padding:8px;line-height:18px;text-align:left;vertical-align:top;border-top:1px solid #ddd}.table th{font-weight:bold}.table thead th{vertical-align:bottom}.table caption+thead tr:first-child th,.table caption+thead tr:first-child td,.table colgroup+thead tr:first-child th,.table colgroup+thead tr:first-child td,.table thead:first-child tr:first-child th,.table thead:first-child tr:first-child td{border-top:0}.table tbody+tbody{border-top:2px solid #ddd}.table-condensed th,.table-condensed td{padding:4px 5px}.table-bordered{border:1px solid #ddd;border-collapse:separate;*border-collapse:collapsed;border-left:0;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}.table-bordered th,.table-bordered td{border-left:1px solid #ddd}.table-bordered caption+thead tr:first-child th,.table-bordered caption+tbody tr:first-child th,.table-bordered caption+tbody tr:first-child td,.table-bordered colgroup+thead tr:first-child th,.table-bordered colgroup+tbody tr:first-child th,.table-bordered colgroup+tbody tr:first-child td,.table-bordered thead:first-child tr:first-child th,.table-bordered tbody:first-child tr:first-child th,.table-bordered tbody:first-child tr:first-child td{border-top:0}.table-bordered thead:first-child tr:first-child th:first-child,.table-bordered tbody:first-child tr:first-child td:first-child{-webkit-border-top-left-radius:4px;border-top-left-radius:4px;-moz-border-radius-topleft:4px}.table-bordered thead:first-child tr:first-child th:last-child,.table-bordered tbody:first-child tr:first-child td:last-child{-webkit-border-top-right-radius:4px;border-top-right-radius:4px;-moz-border-radius-topright:4px}.table-bordered thead:last-child tr:last-child th:first-child,.table-bordered tbody:last-child tr:last-child td:first-child{-webkit-border-radius:0 0 0 4px;-moz-border-radius:0 0 0 4px;border-radius:0 0 0 4px;-webkit-border-bottom-left-radius:4px;border-bottom-left-radius:4px;-moz-border-radius-bottomleft:4px}.table-bordered thead:last-child tr:last-child th:last-child,.table-bordered tbody:last-child tr:last-child td:last-child{-webkit-border-bottom-right-radius:4px;border-bottom-right-radius:4px;-moz-border-radius-bottomright:4px}.table-striped tbody tr:nth-child(odd) td,.table-striped tbody tr:nth-child(odd) th{background-color:#f9f9f9}.table tbody tr:hover td,.table tbody tr:hover th{background-color:#f5f5f5}table .span1{float:none;width:44px;margin-left:0}table .span2{float:none;width:124px;margin-left:0}table .span3{float:none;width:204px;margin-left:0}table .span4{float:none;width:284px;margin-left:0}table .span5{float:none;width:364px;margin-left:0}table .span6{float:none;width:444px;margin-left:0}table .span7{float:none;width:524px;margin-left:0}table .span8{float:none;width:604px;margin-left:0}table .span9{float:none;width:684px;margin-left:0}table .span10{float:none;width:764px;margin-left:0}table .span11{float:none;width:844px;margin-left:0}table .span12{float:none;width:924px;margin-left:0}table .span13{float:none;width:1004px;margin-left:0}table .span14{float:none;width:1084px;margin-left:0}table .span15{float:none;width:1164px;margin-left:0}table .span16{float:none;width:1244px;margin-left:0}table .span17{float:none;width:1324px;margin-left:0}table .span18{float:none;width:1404px;margin-left:0}table .span19{float:none;width:1484px;margin-left:0}table .span20{float:none;width:1564px;margin-left:0}table .span21{float:none;width:1644px;margin-left:0}table .span22{float:none;width:1724px;margin-left:0}table .span23{float:none;width:1804px;margin-left:0}table .span24{float:none;width:1884px;margin-left:0}[class^="icon-"],[class*=" icon-"]{display:inline-block;width:14px;height:14px;*margin-right:.3em;line-height:14px;vertical-align:text-top;background-image:url("../img/glyphicons-halflings.png");background-position:14px 14px;background-repeat:no-repeat}[class^="icon-"]:last-child,[class*=" icon-"]:last-child{*margin-left:0}.icon-white{background-image:url("../img/glyphicons-halflings-white.png")}.icon-glass{background-position:0 0}.icon-music{background-position:-24px 0}.icon-search{background-position:-48px 0}.icon-envelope{background-position:-72px 0}.icon-heart{background-position:-96px 0}.icon-star{background-position:-120px 0}.icon-star-empty{background-position:-144px 0}.icon-user{background-position:-168px 0}.icon-film{background-position:-192px 0}.icon-th-large{background-position:-216px 0}.icon-th{background-position:-240px 0}.icon-th-list{background-position:-264px 0}.icon-ok{background-position:-288px 0}.icon-remove{background-position:-312px 0}.icon-zoom-in{background-position:-336px 0}.icon-zoom-out{background-position:-360px 0}.icon-off{background-position:-384px 0}.icon-signal{background-position:-408px 0}.icon-cog{background-position:-432px 0}.icon-trash{background-position:-456px 0}.icon-home{background-position:0 -24px}.icon-file{background-position:-24px -24px}.icon-time{background-position:-48px -24px}.icon-road{background-position:-72px -24px}.icon-download-alt{background-position:-96px -24px}.icon-download{background-position:-120px -24px}.icon-upload{background-position:-144px -24px}.icon-inbox{background-position:-168px -24px}.icon-play-circle{background-position:-192px -24px}.icon-repeat{background-position:-216px -24px}.icon-refresh{background-position:-240px -24px}.icon-list-alt{background-position:-264px -24px}.icon-lock{background-position:-287px -24px}.icon-flag{background-position:-312px -24px}.icon-headphones{background-position:-336px -24px}.icon-volume-off{background-position:-360px -24px}.icon-volume-down{background-position:-384px -24px}.icon-volume-up{background-position:-408px -24px}.icon-qrcode{background-position:-432px -24px}.icon-barcode{background-position:-456px -24px}.icon-tag{background-position:0 -48px}.icon-tags{background-position:-25px -48px}.icon-book{background-position:-48px -48px}.icon-bookmark{background-position:-72px -48px}.icon-print{background-position:-96px -48px}.icon-camera{background-position:-120px -48px}.icon-font{background-position:-144px -48px}.icon-bold{background-position:-167px -48px}.icon-italic{background-position:-192px -48px}.icon-text-height{background-position:-216px -48px}.icon-text-width{background-position:-240px -48px}.icon-align-left{background-position:-264px -48px}.icon-align-center{background-position:-288px -48px}.icon-align-right{background-position:-312px -48px}.icon-align-justify{background-position:-336px -48px}.icon-list{background-position:-360px -48px}.icon-indent-left{background-position:-384px -48px}.icon-indent-right{background-position:-408px -48px}.icon-facetime-video{background-position:-432px -48px}.icon-picture{background-position:-456px -48px}.icon-pencil{background-position:0 -72px}.icon-map-marker{background-position:-24px -72px}.icon-adjust{background-position:-48px -72px}.icon-tint{background-position:-72px -72px}.icon-edit{background-position:-96px -72px}.icon-share{background-position:-120px -72px}.icon-check{background-position:-144px -72px}.icon-move{background-position:-168px -72px}.icon-step-backward{background-position:-192px -72px}.icon-fast-backward{background-position:-216px -72px}.icon-backward{background-position:-240px -72px}.icon-play{background-position:-264px -72px}.icon-pause{background-position:-288px -72px}.icon-stop{background-position:-312px -72px}.icon-forward{background-position:-336px -72px}.icon-fast-forward{background-position:-360px -72px}.icon-step-forward{background-position:-384px -72px}.icon-eject{background-position:-408px -72px}.icon-chevron-left{background-position:-432px -72px}.icon-chevron-right{background-position:-456px -72px}.icon-plus-sign{background-position:0 -96px}.icon-minus-sign{background-position:-24px -96px}.icon-remove-sign{background-position:-48px -96px}.icon-ok-sign{background-position:-72px -96px}.icon-question-sign{background-position:-96px -96px}.icon-info-sign{background-position:-120px -96px}.icon-screenshot{background-position:-144px -96px}.icon-remove-circle{background-position:-168px -96px}.icon-ok-circle{background-position:-192px -96px}.icon-ban-circle{background-position:-216px -96px}.icon-arrow-left{background-position:-240px -96px}.icon-arrow-right{background-position:-264px -96px}.icon-arrow-up{background-position:-289px -96px}.icon-arrow-down{background-position:-312px -96px}.icon-share-alt{background-position:-336px -96px}.icon-resize-full{background-position:-360px -96px}.icon-resize-small{background-position:-384px -96px}.icon-plus{background-position:-408px -96px}.icon-minus{background-position:-433px -96px}.icon-asterisk{background-position:-456px -96px}.icon-exclamation-sign{background-position:0 -120px}.icon-gift{background-position:-24px -120px}.icon-leaf{background-position:-48px -120px}.icon-fire{background-position:-72px -120px}.icon-eye-open{background-position:-96px -120px}.icon-eye-close{background-position:-120px -120px}.icon-warning-sign{background-position:-144px -120px}.icon-plane{background-position:-168px -120px}.icon-calendar{background-position:-192px -120px}.icon-random{background-position:-216px -120px}.icon-comment{background-position:-240px -120px}.icon-magnet{background-position:-264px -120px}.icon-chevron-up{background-position:-288px -120px}.icon-chevron-down{background-position:-313px -119px}.icon-retweet{background-position:-336px -120px}.icon-shopping-cart{background-position:-360px -120px}.icon-folder-close{background-position:-384px -120px}.icon-folder-open{background-position:-408px -120px}.icon-resize-vertical{background-position:-432px -119px}.icon-resize-horizontal{background-position:-456px -118px}.icon-hdd{background-position:0 -144px}.icon-bullhorn{background-position:-24px -144px}.icon-bell{background-position:-48px -144px}.icon-certificate{background-position:-72px -144px}.icon-thumbs-up{background-position:-96px -144px}.icon-thumbs-down{background-position:-120px -144px}.icon-hand-right{background-position:-144px -144px}.icon-hand-left{background-position:-168px -144px}.icon-hand-up{background-position:-192px -144px}.icon-hand-down{background-position:-216px -144px}.icon-circle-arrow-right{background-position:-240px -144px}.icon-circle-arrow-left{background-position:-264px -144px}.icon-circle-arrow-up{background-position:-288px -144px}.icon-circle-arrow-down{background-position:-312px -144px}.icon-globe{background-position:-336px -144px}.icon-wrench{background-position:-360px -144px}.icon-tasks{background-position:-384px -144px}.icon-filter{background-position:-408px -144px}.icon-briefcase{background-position:-432px -144px}.icon-fullscreen{background-position:-456px -144px}.dropup,.dropdown{position:relative}.dropdown-toggle{*margin-bottom:-3px}.dropdown-toggle:active,.open .dropdown-toggle{outline:0}.caret{display:inline-block;width:0;height:0;vertical-align:top;border-top:4px solid #000;border-right:4px solid transparent;border-left:4px solid transparent;content:"";opacity:.3;filter:alpha(opacity=30)}.dropdown .caret{margin-top:8px;margin-left:2px}.dropdown:hover .caret,.open .caret{opacity:1;filter:alpha(opacity=100)}.dropdown-menu{position:absolute;top:100%;left:0;z-index:1000;display:none;float:left;min-width:160px;padding:4px 0;margin:1px 0 0;list-style:none;background-color:#fff;border:1px solid #ccc;border:1px solid rgba(0,0,0,0.2);*border-right-width:2px;*border-bottom-width:2px;-webkit-border-radius:5px;-moz-border-radius:5px;border-radius:5px;-webkit-box-shadow:0 5px 10px rgba(0,0,0,0.2);-moz-box-shadow:0 5px 10px rgba(0,0,0,0.2);box-shadow:0 5px 10px rgba(0,0,0,0.2);-webkit-background-clip:padding-box;-moz-background-clip:padding;background-clip:padding-box}.dropdown-menu.pull-right{right:0;left:auto}.dropdown-menu .divider{*width:100%;height:1px;margin:8px 1px;*margin:-5px 0 5px;overflow:hidden;background-color:#e5e5e5;border-bottom:1px solid #fff}.dropdown-menu a{display:block;padding:3px 15px;clear:both;font-weight:normal;line-height:18px;color:#333;white-space:nowrap}.dropdown-menu li>a:hover,.dropdown-menu .active>a,.dropdown-menu .active>a:hover{color:#fff;text-decoration:none;background-color:#08c}.open{*z-index:1000}.open .dropdown-menu{display:block}.pull-right .dropdown-menu{right:0;left:auto}.dropup .caret,.navbar-fixed-bottom .dropdown .caret{border-top:0;border-bottom:4px solid #000;content:"\2191"}.dropup .dropdown-menu,.navbar-fixed-bottom .dropdown .dropdown-menu{top:auto;bottom:100%;margin-bottom:1px}.typeahead{margin-top:2px;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}.well{min-height:20px;padding:19px;margin-bottom:20px;background-color:#f5f5f5;border:1px solid #eee;border:1px solid rgba(0,0,0,0.05);-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;-webkit-box-shadow:inset 0 1px 1px rgba(0,0,0,0.05);-moz-box-shadow:inset 0 1px 1px rgba(0,0,0,0.05);box-shadow:inset 0 1px 1px rgba(0,0,0,0.05)}.well blockquote{border-color:#ddd;border-color:rgba(0,0,0,0.15)}.well-large{padding:24px;-webkit-border-radius:6px;-moz-border-radius:6px;border-radius:6px}.well-small{padding:9px;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px}.fade{opacity:0;filter:alpha(opacity=0);-webkit-transition:opacity .15s linear;-moz-transition:opacity .15s linear;-ms-transition:opacity .15s linear;-o-transition:opacity .15s linear;transition:opacity .15s linear}.fade.in{opacity:1;filter:alpha(opacity=100)}.collapse{position:relative;height:0;overflow:hidden;-webkit-transition:height .35s ease;-moz-transition:height .35s ease;-ms-transition:height .35s ease;-o-transition:height .35s ease;transition:height .35s ease}.collapse.in{height:auto}.close{float:right;font-size:20px;font-weight:bold;line-height:18px;color:#000;text-shadow:0 1px 0 #fff;opacity:.2;filter:alpha(opacity=20)}.close:hover{color:#000;text-decoration:none;cursor:pointer;opacity:.4;filter:alpha(opacity=40)}button.close{padding:0;cursor:pointer;background:transparent;border:0;-webkit-appearance:none}.btn{display:inline-block;*display:inline;padding:4px 10px 4px;margin-bottom:0;*margin-left:.3em;font-size:13px;line-height:18px;*line-height:20px;color:#333;text-align:center;text-shadow:0 1px 1px rgba(255,255,255,0.75);vertical-align:middle;cursor:pointer;background-color:#f5f5f5;*background-color:#e6e6e6;background-image:-ms-linear-gradient(top,#fff,#e6e6e6);background-image:-webkit-gradient(linear,0 0,0 100%,from(#fff),to(#e6e6e6));background-image:-webkit-linear-gradient(top,#fff,#e6e6e6);background-image:-o-linear-gradient(top,#fff,#e6e6e6);background-image:linear-gradient(top,#fff,#e6e6e6);background-image:-moz-linear-gradient(top,#fff,#e6e6e6);background-repeat:repeat-x;border:1px solid #ccc;*border:0;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);border-color:#e6e6e6 #e6e6e6 #bfbfbf;border-bottom-color:#b3b3b3;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#ffffff',endColorstr='#e6e6e6',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false);*zoom:1;-webkit-box-shadow:inset 0 1px 0 rgba(255,255,255,0.2),0 1px 2px rgba(0,0,0,0.05);-moz-box-shadow:inset 0 1px 0 rgba(255,255,255,0.2),0 1px 2px rgba(0,0,0,0.05);box-shadow:inset 0 1px 0 rgba(255,255,255,0.2),0 1px 2px rgba(0,0,0,0.05)}.btn:hover,.btn:active,.btn.active,.btn.disabled,.btn[disabled]{background-color:#e6e6e6;*background-color:#d9d9d9}.btn:active,.btn.active{background-color:#ccc \9}.btn:first-child{*margin-left:0}.btn:hover{color:#333;text-decoration:none;background-color:#e6e6e6;*background-color:#d9d9d9;background-position:0 -15px;-webkit-transition:background-position .1s linear;-moz-transition:background-position .1s linear;-ms-transition:background-position .1s linear;-o-transition:background-position .1s linear;transition:background-position .1s linear}.btn:focus{outline:thin dotted #333;outline:5px auto -webkit-focus-ring-color;outline-offset:-2px}.btn.active,.btn:active{background-color:#e6e6e6;background-color:#d9d9d9 \9;background-image:none;outline:0;-webkit-box-shadow:inset 0 2px 4px rgba(0,0,0,0.15),0 1px 2px rgba(0,0,0,0.05);-moz-box-shadow:inset 0 2px 4px rgba(0,0,0,0.15),0 1px 2px rgba(0,0,0,0.05);box-shadow:inset 0 2px 4px rgba(0,0,0,0.15),0 1px 2px rgba(0,0,0,0.05)}.btn.disabled,.btn[disabled]{cursor:default;background-color:#e6e6e6;background-image:none;opacity:.65;filter:alpha(opacity=65);-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none}.btn-large{padding:9px 14px;font-size:15px;line-height:normal;-webkit-border-radius:5px;-moz-border-radius:5px;border-radius:5px}.btn-large [class^="icon-"]{margin-top:1px}.btn-small{padding:5px 9px;font-size:11px;line-height:16px}.btn-small [class^="icon-"]{margin-top:-1px}.btn-mini{padding:2px 6px;font-size:11px;line-height:14px}.btn-primary,.btn-primary:hover,.btn-warning,.btn-warning:hover,.btn-danger,.btn-danger:hover,.btn-success,.btn-success:hover,.btn-info,.btn-info:hover,.btn-inverse,.btn-inverse:hover{color:#fff;text-shadow:0 -1px 0 rgba(0,0,0,0.25)}.btn-primary.active,.btn-warning.active,.btn-danger.active,.btn-success.active,.btn-info.active,.btn-inverse.active{color:rgba(255,255,255,0.75)}.btn{border-color:#ccc;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25)}.btn-primary{background-color:#0074cc;*background-color:#05c;background-image:-ms-linear-gradient(top,#08c,#05c);background-image:-webkit-gradient(linear,0 0,0 100%,from(#08c),to(#05c));background-image:-webkit-linear-gradient(top,#08c,#05c);background-image:-o-linear-gradient(top,#08c,#05c);background-image:-moz-linear-gradient(top,#08c,#05c);background-image:linear-gradient(top,#08c,#05c);background-repeat:repeat-x;border-color:#05c #05c #003580;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);filter:progid:dximagetransform.microsoft.gradient(startColorstr='#0088cc',endColorstr='#0055cc',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false)}.btn-primary:hover,.btn-primary:active,.btn-primary.active,.btn-primary.disabled,.btn-primary[disabled]{background-color:#05c;*background-color:#004ab3}.btn-primary:active,.btn-primary.active{background-color:#004099 \9}.btn-warning{background-color:#faa732;*background-color:#f89406;background-image:-ms-linear-gradient(top,#fbb450,#f89406);background-image:-webkit-gradient(linear,0 0,0 100%,from(#fbb450),to(#f89406));background-image:-webkit-linear-gradient(top,#fbb450,#f89406);background-image:-o-linear-gradient(top,#fbb450,#f89406);background-image:-moz-linear-gradient(top,#fbb450,#f89406);background-image:linear-gradient(top,#fbb450,#f89406);background-repeat:repeat-x;border-color:#f89406 #f89406 #ad6704;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);filter:progid:dximagetransform.microsoft.gradient(startColorstr='#fbb450',endColorstr='#f89406',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false)}.btn-warning:hover,.btn-warning:active,.btn-warning.active,.btn-warning.disabled,.btn-warning[disabled]{background-color:#f89406;*background-color:#df8505}.btn-warning:active,.btn-warning.active{background-color:#c67605 \9}.btn-danger{background-color:#da4f49;*background-color:#bd362f;background-image:-ms-linear-gradient(top,#ee5f5b,#bd362f);background-image:-webkit-gradient(linear,0 0,0 100%,from(#ee5f5b),to(#bd362f));background-image:-webkit-linear-gradient(top,#ee5f5b,#bd362f);background-image:-o-linear-gradient(top,#ee5f5b,#bd362f);background-image:-moz-linear-gradient(top,#ee5f5b,#bd362f);background-image:linear-gradient(top,#ee5f5b,#bd362f);background-repeat:repeat-x;border-color:#bd362f #bd362f #802420;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);filter:progid:dximagetransform.microsoft.gradient(startColorstr='#ee5f5b',endColorstr='#bd362f',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false)}.btn-danger:hover,.btn-danger:active,.btn-danger.active,.btn-danger.disabled,.btn-danger[disabled]{background-color:#bd362f;*background-color:#a9302a}.btn-danger:active,.btn-danger.active{background-color:#942a25 \9}.btn-success{background-color:#5bb75b;*background-color:#51a351;background-image:-ms-linear-gradient(top,#62c462,#51a351);background-image:-webkit-gradient(linear,0 0,0 100%,from(#62c462),to(#51a351));background-image:-webkit-linear-gradient(top,#62c462,#51a351);background-image:-o-linear-gradient(top,#62c462,#51a351);background-image:-moz-linear-gradient(top,#62c462,#51a351);background-image:linear-gradient(top,#62c462,#51a351);background-repeat:repeat-x;border-color:#51a351 #51a351 #387038;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);filter:progid:dximagetransform.microsoft.gradient(startColorstr='#62c462',endColorstr='#51a351',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false)}.btn-success:hover,.btn-success:active,.btn-success.active,.btn-success.disabled,.btn-success[disabled]{background-color:#51a351;*background-color:#499249}.btn-success:active,.btn-success.active{background-color:#408140 \9}.btn-info{background-color:#49afcd;*background-color:#2f96b4;background-image:-ms-linear-gradient(top,#5bc0de,#2f96b4);background-image:-webkit-gradient(linear,0 0,0 100%,from(#5bc0de),to(#2f96b4));background-image:-webkit-linear-gradient(top,#5bc0de,#2f96b4);background-image:-o-linear-gradient(top,#5bc0de,#2f96b4);background-image:-moz-linear-gradient(top,#5bc0de,#2f96b4);background-image:linear-gradient(top,#5bc0de,#2f96b4);background-repeat:repeat-x;border-color:#2f96b4 #2f96b4 #1f6377;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);filter:progid:dximagetransform.microsoft.gradient(startColorstr='#5bc0de',endColorstr='#2f96b4',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false)}.btn-info:hover,.btn-info:active,.btn-info.active,.btn-info.disabled,.btn-info[disabled]{background-color:#2f96b4;*background-color:#2a85a0}.btn-info:active,.btn-info.active{background-color:#24748c \9}.btn-inverse{background-color:#414141;*background-color:#222;background-image:-ms-linear-gradient(top,#555,#222);background-image:-webkit-gradient(linear,0 0,0 100%,from(#555),to(#222));background-image:-webkit-linear-gradient(top,#555,#222);background-image:-o-linear-gradient(top,#555,#222);background-image:-moz-linear-gradient(top,#555,#222);background-image:linear-gradient(top,#555,#222);background-repeat:repeat-x;border-color:#222 #222 #000;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);filter:progid:dximagetransform.microsoft.gradient(startColorstr='#555555',endColorstr='#222222',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false)}.btn-inverse:hover,.btn-inverse:active,.btn-inverse.active,.btn-inverse.disabled,.btn-inverse[disabled]{background-color:#222;*background-color:#151515}.btn-inverse:active,.btn-inverse.active{background-color:#080808 \9}button.btn,input[type="submit"].btn{*padding-top:2px;*padding-bottom:2px}button.btn::-moz-focus-inner,input[type="submit"].btn::-moz-focus-inner{padding:0;border:0}button.btn.btn-large,input[type="submit"].btn.btn-large{*padding-top:7px;*padding-bottom:7px}button.btn.btn-small,input[type="submit"].btn.btn-small{*padding-top:3px;*padding-bottom:3px}button.btn.btn-mini,input[type="submit"].btn.btn-mini{*padding-top:1px;*padding-bottom:1px}.btn-group{position:relative;*margin-left:.3em;*zoom:1}.btn-group:before,.btn-group:after{display:table;content:""}.btn-group:after{clear:both}.btn-group:first-child{*margin-left:0}.btn-group+.btn-group{margin-left:5px}.btn-toolbar{margin-top:9px;margin-bottom:9px}.btn-toolbar .btn-group{display:inline-block;*display:inline;*zoom:1}.btn-group>.btn{position:relative;float:left;margin-left:-1px;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0}.btn-group>.btn:first-child{margin-left:0;-webkit-border-bottom-left-radius:4px;border-bottom-left-radius:4px;-webkit-border-top-left-radius:4px;border-top-left-radius:4px;-moz-border-radius-bottomleft:4px;-moz-border-radius-topleft:4px}.btn-group>.btn:last-child,.btn-group>.dropdown-toggle{-webkit-border-top-right-radius:4px;border-top-right-radius:4px;-webkit-border-bottom-right-radius:4px;border-bottom-right-radius:4px;-moz-border-radius-topright:4px;-moz-border-radius-bottomright:4px}.btn-group>.btn.large:first-child{margin-left:0;-webkit-border-bottom-left-radius:6px;border-bottom-left-radius:6px;-webkit-border-top-left-radius:6px;border-top-left-radius:6px;-moz-border-radius-bottomleft:6px;-moz-border-radius-topleft:6px}.btn-group>.btn.large:last-child,.btn-group>.large.dropdown-toggle{-webkit-border-top-right-radius:6px;border-top-right-radius:6px;-webkit-border-bottom-right-radius:6px;border-bottom-right-radius:6px;-moz-border-radius-topright:6px;-moz-border-radius-bottomright:6px}.btn-group>.btn:hover,.btn-group>.btn:focus,.btn-group>.btn:active,.btn-group>.btn.active{z-index:2}.btn-group .dropdown-toggle:active,.btn-group.open .dropdown-toggle{outline:0}.btn-group>.dropdown-toggle{*padding-top:4px;padding-right:8px;*padding-bottom:4px;padding-left:8px;-webkit-box-shadow:inset 1px 0 0 rgba(255,255,255,0.125),inset 0 1px 0 rgba(255,255,255,0.2),0 1px 2px rgba(0,0,0,0.05);-moz-box-shadow:inset 1px 0 0 rgba(255,255,255,0.125),inset 0 1px 0 rgba(255,255,255,0.2),0 1px 2px rgba(0,0,0,0.05);box-shadow:inset 1px 0 0 rgba(255,255,255,0.125),inset 0 1px 0 rgba(255,255,255,0.2),0 1px 2px rgba(0,0,0,0.05)}.btn-group>.btn-mini.dropdown-toggle{padding-right:5px;padding-left:5px}.btn-group>.btn-small.dropdown-toggle{*padding-top:4px;*padding-bottom:4px}.btn-group>.btn-large.dropdown-toggle{padding-right:12px;padding-left:12px}.btn-group.open .dropdown-toggle{background-image:none;-webkit-box-shadow:inset 0 2px 4px rgba(0,0,0,0.15),0 1px 2px rgba(0,0,0,0.05);-moz-box-shadow:inset 0 2px 4px rgba(0,0,0,0.15),0 1px 2px rgba(0,0,0,0.05);box-shadow:inset 0 2px 4px rgba(0,0,0,0.15),0 1px 2px rgba(0,0,0,0.05)}.btn-group.open .btn.dropdown-toggle{background-color:#e6e6e6}.btn-group.open .btn-primary.dropdown-toggle{background-color:#05c}.btn-group.open .btn-warning.dropdown-toggle{background-color:#f89406}.btn-group.open .btn-danger.dropdown-toggle{background-color:#bd362f}.btn-group.open .btn-success.dropdown-toggle{background-color:#51a351}.btn-group.open .btn-info.dropdown-toggle{background-color:#2f96b4}.btn-group.open .btn-inverse.dropdown-toggle{background-color:#222}.btn .caret{margin-top:7px;margin-left:0}.btn:hover .caret,.open.btn-group .caret{opacity:1;filter:alpha(opacity=100)}.btn-mini .caret{margin-top:5px}.btn-small .caret{margin-top:6px}.btn-large .caret{margin-top:6px;border-top-width:5px;border-right-width:5px;border-left-width:5px}.dropup .btn-large .caret{border-top:0;border-bottom:5px solid #000}.btn-primary .caret,.btn-warning .caret,.btn-danger .caret,.btn-info .caret,.btn-success .caret,.btn-inverse .caret{border-top-color:#fff;border-bottom-color:#fff;opacity:.75;filter:alpha(opacity=75)}.alert{padding:8px 35px 8px 14px;margin-bottom:18px;color:#c09853;text-shadow:0 1px 0 rgba(255,255,255,0.5);background-color:#fcf8e3;border:1px solid #fbeed5;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}.alert-heading{color:inherit}.alert .close{position:relative;top:-2px;right:-21px;line-height:18px}.alert-success{color:#468847;background-color:#dff0d8;border-color:#d6e9c6}.alert-danger,.alert-error{color:#b94a48;background-color:#f2dede;border-color:#eed3d7}.alert-info{color:#3a87ad;background-color:#d9edf7;border-color:#bce8f1}.alert-block{padding-top:14px;padding-bottom:14px}.alert-block>p,.alert-block>ul{margin-bottom:0}.alert-block p+p{margin-top:5px}.nav{margin-bottom:18px;margin-left:0;list-style:none}.nav>li>a{display:block}.nav>li>a:hover{text-decoration:none;background-color:#eee}.nav>.pull-right{float:right}.nav .nav-header{display:block;padding:3px 15px;font-size:11px;font-weight:bold;line-height:18px;color:#999;text-shadow:0 1px 0 rgba(255,255,255,0.5);text-transform:uppercase}.nav li+.nav-header{margin-top:9px}.nav-list{padding-right:15px;padding-left:15px;margin-bottom:0}.nav-list>li>a,.nav-list .nav-header{margin-right:-15px;margin-left:-15px;text-shadow:0 1px 0 rgba(255,255,255,0.5)}.nav-list>li>a{padding:3px 15px}.nav-list>.active>a,.nav-list>.active>a:hover{color:#fff;text-shadow:0 -1px 0 rgba(0,0,0,0.2);background-color:#08c}.nav-list [class^="icon-"]{margin-right:2px}.nav-list .divider{*width:100%;height:1px;margin:8px 1px;*margin:-5px 0 5px;overflow:hidden;background-color:#e5e5e5;border-bottom:1px solid #fff}.nav-tabs,.nav-pills{*zoom:1}.nav-tabs:before,.nav-pills:before,.nav-tabs:after,.nav-pills:after{display:table;content:""}.nav-tabs:after,.nav-pills:after{clear:both}.nav-tabs>li,.nav-pills>li{float:left}.nav-tabs>li>a,.nav-pills>li>a{padding-right:12px;padding-left:12px;margin-right:2px;line-height:14px}.nav-tabs{border-bottom:1px solid #ddd}.nav-tabs>li{margin-bottom:-1px}.nav-tabs>li>a{padding-top:8px;padding-bottom:8px;line-height:18px;border:1px solid transparent;-webkit-border-radius:4px 4px 0 0;-moz-border-radius:4px 4px 0 0;border-radius:4px 4px 0 0}.nav-tabs>li>a:hover{border-color:#eee #eee #ddd}.nav-tabs>.active>a,.nav-tabs>.active>a:hover{color:#555;cursor:default;background-color:#fff;border:1px solid #ddd;border-bottom-color:transparent}.nav-pills>li>a{padding-top:8px;padding-bottom:8px;margin-top:2px;margin-bottom:2px;-webkit-border-radius:5px;-moz-border-radius:5px;border-radius:5px}.nav-pills>.active>a,.nav-pills>.active>a:hover{color:#fff;background-color:#08c}.nav-stacked>li{float:none}.nav-stacked>li>a{margin-right:0}.nav-tabs.nav-stacked{border-bottom:0}.nav-tabs.nav-stacked>li>a{border:1px solid #ddd;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0}.nav-tabs.nav-stacked>li:first-child>a{-webkit-border-radius:4px 4px 0 0;-moz-border-radius:4px 4px 0 0;border-radius:4px 4px 0 0}.nav-tabs.nav-stacked>li:last-child>a{-webkit-border-radius:0 0 4px 4px;-moz-border-radius:0 0 4px 4px;border-radius:0 0 4px 4px}.nav-tabs.nav-stacked>li>a:hover{z-index:2;border-color:#ddd}.nav-pills.nav-stacked>li>a{margin-bottom:3px}.nav-pills.nav-stacked>li:last-child>a{margin-bottom:1px}.nav-tabs .dropdown-menu{-webkit-border-radius:0 0 5px 5px;-moz-border-radius:0 0 5px 5px;border-radius:0 0 5px 5px}.nav-pills .dropdown-menu{-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}.nav-tabs .dropdown-toggle .caret,.nav-pills .dropdown-toggle .caret{margin-top:6px;border-top-color:#08c;border-bottom-color:#08c}.nav-tabs .dropdown-toggle:hover .caret,.nav-pills .dropdown-toggle:hover .caret{border-top-color:#005580;border-bottom-color:#005580}.nav-tabs .active .dropdown-toggle .caret,.nav-pills .active .dropdown-toggle .caret{border-top-color:#333;border-bottom-color:#333}.nav>.dropdown.active>a:hover{color:#000;cursor:pointer}.nav-tabs .open .dropdown-toggle,.nav-pills .open .dropdown-toggle,.nav>li.dropdown.open.active>a:hover{color:#fff;background-color:#999;border-color:#999}.nav li.dropdown.open .caret,.nav li.dropdown.open.active .caret,.nav li.dropdown.open a:hover .caret{border-top-color:#fff;border-bottom-color:#fff;opacity:1;filter:alpha(opacity=100)}.tabs-stacked .open>a:hover{border-color:#999}.tabbable{*zoom:1}.tabbable:before,.tabbable:after{display:table;content:""}.tabbable:after{clear:both}.tab-content{overflow:auto}.tabs-below>.nav-tabs,.tabs-right>.nav-tabs,.tabs-left>.nav-tabs{border-bottom:0}.tab-content>.tab-pane,.pill-content>.pill-pane{display:none}.tab-content>.active,.pill-content>.active{display:block}.tabs-below>.nav-tabs{border-top:1px solid #ddd}.tabs-below>.nav-tabs>li{margin-top:-1px;margin-bottom:0}.tabs-below>.nav-tabs>li>a{-webkit-border-radius:0 0 4px 4px;-moz-border-radius:0 0 4px 4px;border-radius:0 0 4px 4px}.tabs-below>.nav-tabs>li>a:hover{border-top-color:#ddd;border-bottom-color:transparent}.tabs-below>.nav-tabs>.active>a,.tabs-below>.nav-tabs>.active>a:hover{border-color:transparent #ddd #ddd #ddd}.tabs-left>.nav-tabs>li,.tabs-right>.nav-tabs>li{float:none}.tabs-left>.nav-tabs>li>a,.tabs-right>.nav-tabs>li>a{min-width:74px;margin-right:0;margin-bottom:3px}.tabs-left>.nav-tabs{float:left;margin-right:19px;border-right:1px solid #ddd}.tabs-left>.nav-tabs>li>a{margin-right:-1px;-webkit-border-radius:4px 0 0 4px;-moz-border-radius:4px 0 0 4px;border-radius:4px 0 0 4px}.tabs-left>.nav-tabs>li>a:hover{border-color:#eee #ddd #eee #eee}.tabs-left>.nav-tabs .active>a,.tabs-left>.nav-tabs .active>a:hover{border-color:#ddd transparent #ddd #ddd;*border-right-color:#fff}.tabs-right>.nav-tabs{float:right;margin-left:19px;border-left:1px solid #ddd}.tabs-right>.nav-tabs>li>a{margin-left:-1px;-webkit-border-radius:0 4px 4px 0;-moz-border-radius:0 4px 4px 0;border-radius:0 4px 4px 0}.tabs-right>.nav-tabs>li>a:hover{border-color:#eee #eee #eee #ddd}.tabs-right>.nav-tabs .active>a,.tabs-right>.nav-tabs .active>a:hover{border-color:#ddd #ddd #ddd transparent;*border-left-color:#fff}.navbar{*position:relative;*z-index:2;margin-bottom:18px;overflow:visible}.navbar-inner{min-height:40px;padding-right:20px;padding-left:20px;background-color:#2c2c2c;background-image:-moz-linear-gradient(top,#333,#222);background-image:-ms-linear-gradient(top,#333,#222);background-image:-webkit-gradient(linear,0 0,0 100%,from(#333),to(#222));background-image:-webkit-linear-gradient(top,#333,#222);background-image:-o-linear-gradient(top,#333,#222);background-image:linear-gradient(top,#333,#222);background-repeat:repeat-x;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#333333',endColorstr='#222222',GradientType=0);-webkit-box-shadow:0 1px 3px rgba(0,0,0,0.25),inset 0 -1px 0 rgba(0,0,0,0.1);-moz-box-shadow:0 1px 3px rgba(0,0,0,0.25),inset 0 -1px 0 rgba(0,0,0,0.1);box-shadow:0 1px 3px rgba(0,0,0,0.25),inset 0 -1px 0 rgba(0,0,0,0.1)}.navbar .container{width:auto}.nav-collapse.collapse{height:auto}.navbar{color:#999}.navbar .brand:hover{text-decoration:none}.navbar .brand{display:block;float:left;padding:8px 20px 12px;margin-left:-20px;font-size:20px;font-weight:200;line-height:1;color:#999}.navbar .navbar-text{margin-bottom:0;line-height:40px}.navbar .navbar-link{color:#999}.navbar .navbar-link:hover{color:#fff}.navbar .btn,.navbar .btn-group{margin-top:5px}.navbar .btn-group .btn{margin:0}.navbar-form{margin-bottom:0;*zoom:1}.navbar-form:before,.navbar-form:after{display:table;content:""}.navbar-form:after{clear:both}.navbar-form input,.navbar-form select,.navbar-form .radio,.navbar-form .checkbox{margin-top:5px}.navbar-form input,.navbar-form select{display:inline-block;margin-bottom:0}.navbar-form input[type="image"],.navbar-form input[type="checkbox"],.navbar-form input[type="radio"]{margin-top:3px}.navbar-form .input-append,.navbar-form .input-prepend{margin-top:6px;white-space:nowrap}.navbar-form .input-append input,.navbar-form .input-prepend input{margin-top:0}.navbar-search{position:relative;float:left;margin-top:6px;margin-bottom:0}.navbar-search .search-query{padding:4px 9px;font-family:"Helvetica Neue",Helvetica,Arial,sans-serif;font-size:13px;font-weight:normal;line-height:1;color:#fff;background-color:#626262;border:1px solid #151515;-webkit-box-shadow:inset 0 1px 2px rgba(0,0,0,0.1),0 1px 0 rgba(255,255,255,0.15);-moz-box-shadow:inset 0 1px 2px rgba(0,0,0,0.1),0 1px 0 rgba(255,255,255,0.15);box-shadow:inset 0 1px 2px rgba(0,0,0,0.1),0 1px 0 rgba(255,255,255,0.15);-webkit-transition:none;-moz-transition:none;-ms-transition:none;-o-transition:none;transition:none}.navbar-search .search-query:-moz-placeholder{color:#ccc}.navbar-search .search-query::-webkit-input-placeholder{color:#ccc}.navbar-search .search-query:focus,.navbar-search .search-query.focused{padding:5px 10px;color:#333;text-shadow:0 1px 0 #fff;background-color:#fff;border:0;outline:0;-webkit-box-shadow:0 0 3px rgba(0,0,0,0.15);-moz-box-shadow:0 0 3px rgba(0,0,0,0.15);box-shadow:0 0 3px rgba(0,0,0,0.15)}.navbar-fixed-top,.navbar-fixed-bottom{position:fixed;right:0;left:0;z-index:1030;margin-bottom:0}.navbar-fixed-top .navbar-inner,.navbar-fixed-bottom .navbar-inner{padding-right:0;padding-left:0;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0}.navbar-fixed-top .container,.navbar-fixed-bottom .container{width:940px}.navbar-fixed-top{top:0}.navbar-fixed-bottom{bottom:0}.navbar .nav{position:relative;left:0;display:block;float:left;margin:0 10px 0 0}.navbar .nav.pull-right{float:right}.navbar .nav>li{display:block;float:left}.navbar .nav>li>a{float:none;padding:9px 10px 11px;line-height:19px;color:#999;text-decoration:none;text-shadow:0 -1px 0 rgba(0,0,0,0.25)}.navbar .btn{display:inline-block;padding:4px 10px 4px;margin:5px 5px 6px;line-height:18px}.navbar .btn-group{padding:5px 5px 6px;margin:0}.navbar .nav>li>a:hover{color:#fff;text-decoration:none;background-color:transparent}.navbar .nav .active>a,.navbar .nav .active>a:hover{color:#fff;text-decoration:none;background-color:#222}.navbar .divider-vertical{width:1px;height:40px;margin:0 9px;overflow:hidden;background-color:#222;border-right:1px solid #333}.navbar .nav.pull-right{margin-right:0;margin-left:10px}.navbar .btn-navbar{display:none;float:right;padding:7px 10px;margin-right:5px;margin-left:5px;background-color:#2c2c2c;*background-color:#222;background-image:-ms-linear-gradient(top,#333,#222);background-image:-webkit-gradient(linear,0 0,0 100%,from(#333),to(#222));background-image:-webkit-linear-gradient(top,#333,#222);background-image:-o-linear-gradient(top,#333,#222);background-image:linear-gradient(top,#333,#222);background-image:-moz-linear-gradient(top,#333,#222);background-repeat:repeat-x;border-color:#222 #222 #000;border-color:rgba(0,0,0,0.1) rgba(0,0,0,0.1) rgba(0,0,0,0.25);filter:progid:dximagetransform.microsoft.gradient(startColorstr='#333333',endColorstr='#222222',GradientType=0);filter:progid:dximagetransform.microsoft.gradient(enabled=false);-webkit-box-shadow:inset 0 1px 0 rgba(255,255,255,0.1),0 1px 0 rgba(255,255,255,0.075);-moz-box-shadow:inset 0 1px 0 rgba(255,255,255,0.1),0 1px 0 rgba(255,255,255,0.075);box-shadow:inset 0 1px 0 rgba(255,255,255,0.1),0 1px 0 rgba(255,255,255,0.075)}.navbar .btn-navbar:hover,.navbar .btn-navbar:active,.navbar .btn-navbar.active,.navbar .btn-navbar.disabled,.navbar .btn-navbar[disabled]{background-color:#222;*background-color:#151515}.navbar .btn-navbar:active,.navbar .btn-navbar.active{background-color:#080808 \9}.navbar .btn-navbar .icon-bar{display:block;width:18px;height:2px;background-color:#f5f5f5;-webkit-border-radius:1px;-moz-border-radius:1px;border-radius:1px;-webkit-box-shadow:0 1px 0 rgba(0,0,0,0.25);-moz-box-shadow:0 1px 0 rgba(0,0,0,0.25);box-shadow:0 1px 0 rgba(0,0,0,0.25)}.btn-navbar .icon-bar+.icon-bar{margin-top:3px}.navbar .dropdown-menu:before{position:absolute;top:-7px;left:9px;display:inline-block;border-right:7px solid transparent;border-bottom:7px solid #ccc;border-left:7px solid transparent;border-bottom-color:rgba(0,0,0,0.2);content:''}.navbar .dropdown-menu:after{position:absolute;top:-6px;left:10px;display:inline-block;border-right:6px solid transparent;border-bottom:6px solid #fff;border-left:6px solid transparent;content:''}.navbar-fixed-bottom .dropdown-menu:before{top:auto;bottom:-7px;border-top:7px solid #ccc;border-bottom:0;border-top-color:rgba(0,0,0,0.2)}.navbar-fixed-bottom .dropdown-menu:after{top:auto;bottom:-6px;border-top:6px solid #fff;border-bottom:0}.navbar .nav li.dropdown .dropdown-toggle .caret,.navbar .nav li.dropdown.open .caret{border-top-color:#fff;border-bottom-color:#fff}.navbar .nav li.dropdown.active .caret{opacity:1;filter:alpha(opacity=100)}.navbar .nav li.dropdown.open>.dropdown-toggle,.navbar .nav li.dropdown.active>.dropdown-toggle,.navbar .nav li.dropdown.open.active>.dropdown-toggle{background-color:transparent}.navbar .nav li.dropdown.active>.dropdown-toggle:hover{color:#fff}.navbar .pull-right .dropdown-menu,.navbar .dropdown-menu.pull-right{right:0;left:auto}.navbar .pull-right .dropdown-menu:before,.navbar .dropdown-menu.pull-right:before{right:12px;left:auto}.navbar .pull-right .dropdown-menu:after,.navbar .dropdown-menu.pull-right:after{right:13px;left:auto}.breadcrumb{padding:7px 14px;margin:0 0 18px;list-style:none;background-color:#fbfbfb;background-image:-moz-linear-gradient(top,#fff,#f5f5f5);background-image:-ms-linear-gradient(top,#fff,#f5f5f5);background-image:-webkit-gradient(linear,0 0,0 100%,from(#fff),to(#f5f5f5));background-image:-webkit-linear-gradient(top,#fff,#f5f5f5);background-image:-o-linear-gradient(top,#fff,#f5f5f5);background-image:linear-gradient(top,#fff,#f5f5f5);background-repeat:repeat-x;border:1px solid #ddd;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#ffffff',endColorstr='#f5f5f5',GradientType=0);-webkit-box-shadow:inset 0 1px 0 #fff;-moz-box-shadow:inset 0 1px 0 #fff;box-shadow:inset 0 1px 0 #fff}.breadcrumb li{display:inline-block;*display:inline;text-shadow:0 1px 0 #fff;*zoom:1}.breadcrumb .divider{padding:0 5px;color:#999}.breadcrumb .active a{color:#333}.pagination{height:36px;margin:18px 0}.pagination ul{display:inline-block;*display:inline;margin-bottom:0;margin-left:0;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;*zoom:1;-webkit-box-shadow:0 1px 2px rgba(0,0,0,0.05);-moz-box-shadow:0 1px 2px rgba(0,0,0,0.05);box-shadow:0 1px 2px rgba(0,0,0,0.05)}.pagination li{display:inline}.pagination a{float:left;padding:0 14px;line-height:34px;text-decoration:none;border:1px solid #ddd;border-left-width:0}.pagination a:hover,.pagination .active a{background-color:#f5f5f5}.pagination .active a{color:#999;cursor:default}.pagination .disabled span,.pagination .disabled a,.pagination .disabled a:hover{color:#999;cursor:default;background-color:transparent}.pagination li:first-child a{border-left-width:1px;-webkit-border-radius:3px 0 0 3px;-moz-border-radius:3px 0 0 3px;border-radius:3px 0 0 3px}.pagination li:last-child a{-webkit-border-radius:0 3px 3px 0;-moz-border-radius:0 3px 3px 0;border-radius:0 3px 3px 0}.pagination-centered{text-align:center}.pagination-right{text-align:right}.pager{margin-bottom:18px;margin-left:0;text-align:center;list-style:none;*zoom:1}.pager:before,.pager:after{display:table;content:""}.pager:after{clear:both}.pager li{display:inline}.pager a{display:inline-block;padding:5px 14px;background-color:#fff;border:1px solid #ddd;-webkit-border-radius:15px;-moz-border-radius:15px;border-radius:15px}.pager a:hover{text-decoration:none;background-color:#f5f5f5}.pager .next a{float:right}.pager .previous a{float:left}.pager .disabled a,.pager .disabled a:hover{color:#999;cursor:default;background-color:#fff}.modal-open .dropdown-menu{z-index:2050}.modal-open .dropdown.open{*z-index:2050}.modal-open .popover{z-index:2060}.modal-open .tooltip{z-index:2070}.modal-backdrop{position:fixed;top:0;right:0;bottom:0;left:0;z-index:1040;background-color:#000}.modal-backdrop.fade{opacity:0}.modal-backdrop,.modal-backdrop.fade.in{opacity:.8;filter:alpha(opacity=80)}.modal{position:fixed;top:50%;left:50%;z-index:1050;width:560px;margin:-250px 0 0 -280px;overflow:auto;background-color:#fff;border:1px solid #999;border:1px solid rgba(0,0,0,0.3);*border:1px solid #999;-webkit-border-radius:6px;-moz-border-radius:6px;border-radius:6px;-webkit-box-shadow:0 3px 7px rgba(0,0,0,0.3);-moz-box-shadow:0 3px 7px rgba(0,0,0,0.3);box-shadow:0 3px 7px rgba(0,0,0,0.3);-webkit-background-clip:padding-box;-moz-background-clip:padding-box;background-clip:padding-box}.modal.fade{top:-25%;-webkit-transition:opacity .3s linear,top .3s ease-out;-moz-transition:opacity .3s linear,top .3s ease-out;-ms-transition:opacity .3s linear,top .3s ease-out;-o-transition:opacity .3s linear,top .3s ease-out;transition:opacity .3s linear,top .3s ease-out}.modal.fade.in{top:50%}.modal-header{padding:9px 15px;border-bottom:1px solid #eee}.modal-header .close{margin-top:2px}.modal-body{max-height:400px;padding:15px;overflow-y:auto}.modal-form{margin-bottom:0}.modal-footer{padding:14px 15px 15px;margin-bottom:0;text-align:right;background-color:#f5f5f5;border-top:1px solid #ddd;-webkit-border-radius:0 0 6px 6px;-moz-border-radius:0 0 6px 6px;border-radius:0 0 6px 6px;*zoom:1;-webkit-box-shadow:inset 0 1px 0 #fff;-moz-box-shadow:inset 0 1px 0 #fff;box-shadow:inset 0 1px 0 #fff}.modal-footer:before,.modal-footer:after{display:table;content:""}.modal-footer:after{clear:both}.modal-footer .btn+.btn{margin-bottom:0;margin-left:5px}.modal-footer .btn-group .btn+.btn{margin-left:-1px}.tooltip{position:absolute;z-index:1020;display:block;padding:5px;font-size:11px;opacity:0;filter:alpha(opacity=0);visibility:visible}.tooltip.in{opacity:.8;filter:alpha(opacity=80)}.tooltip.top{margin-top:-2px}.tooltip.right{margin-left:2px}.tooltip.bottom{margin-top:2px}.tooltip.left{margin-left:-2px}.tooltip.top .tooltip-arrow{bottom:0;left:50%;margin-left:-5px;border-top:5px solid #000;border-right:5px solid transparent;border-left:5px solid transparent}.tooltip.left .tooltip-arrow{top:50%;right:0;margin-top:-5px;border-top:5px solid transparent;border-bottom:5px solid transparent;border-left:5px solid #000}.tooltip.bottom .tooltip-arrow{top:0;left:50%;margin-left:-5px;border-right:5px solid transparent;border-bottom:5px solid #000;border-left:5px solid transparent}.tooltip.right .tooltip-arrow{top:50%;left:0;margin-top:-5px;border-top:5px solid transparent;border-right:5px solid #000;border-bottom:5px solid transparent}.tooltip-inner{max-width:200px;padding:3px 8px;color:#fff;text-align:center;text-decoration:none;background-color:#000;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}.tooltip-arrow{position:absolute;width:0;height:0}.popover{position:absolute;top:0;left:0;z-index:1010;display:none;padding:5px}.popover.top{margin-top:-5px}.popover.right{margin-left:5px}.popover.bottom{margin-top:5px}.popover.left{margin-left:-5px}.popover.top .arrow{bottom:0;left:50%;margin-left:-5px;border-top:5px solid #000;border-right:5px solid transparent;border-left:5px solid transparent}.popover.right .arrow{top:50%;left:0;margin-top:-5px;border-top:5px solid transparent;border-right:5px solid #000;border-bottom:5px solid transparent}.popover.bottom .arrow{top:0;left:50%;margin-left:-5px;border-right:5px solid transparent;border-bottom:5px solid #000;border-left:5px solid transparent}.popover.left .arrow{top:50%;right:0;margin-top:-5px;border-top:5px solid transparent;border-bottom:5px solid transparent;border-left:5px solid #000}.popover .arrow{position:absolute;width:0;height:0}.popover-inner{width:280px;padding:3px;overflow:hidden;background:#000;background:rgba(0,0,0,0.8);-webkit-border-radius:6px;-moz-border-radius:6px;border-radius:6px;-webkit-box-shadow:0 3px 7px rgba(0,0,0,0.3);-moz-box-shadow:0 3px 7px rgba(0,0,0,0.3);box-shadow:0 3px 7px rgba(0,0,0,0.3)}.popover-title{padding:9px 15px;line-height:1;background-color:#f5f5f5;border-bottom:1px solid #eee;-webkit-border-radius:3px 3px 0 0;-moz-border-radius:3px 3px 0 0;border-radius:3px 3px 0 0}.popover-content{padding:14px;background-color:#fff;-webkit-border-radius:0 0 3px 3px;-moz-border-radius:0 0 3px 3px;border-radius:0 0 3px 3px;-webkit-background-clip:padding-box;-moz-background-clip:padding-box;background-clip:padding-box}.popover-content p,.popover-content ul,.popover-content ol{margin-bottom:0}.thumbnails{margin-left:-20px;list-style:none;*zoom:1}.thumbnails:before,.thumbnails:after{display:table;content:""}.thumbnails:after{clear:both}.row-fluid .thumbnails{margin-left:0}.thumbnails>li{float:left;margin-bottom:18px;margin-left:20px}.thumbnail{display:block;padding:4px;line-height:1;border:1px solid #ddd;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;-webkit-box-shadow:0 1px 1px rgba(0,0,0,0.075);-moz-box-shadow:0 1px 1px rgba(0,0,0,0.075);box-shadow:0 1px 1px rgba(0,0,0,0.075)}a.thumbnail:hover{border-color:#08c;-webkit-box-shadow:0 1px 4px rgba(0,105,214,0.25);-moz-box-shadow:0 1px 4px rgba(0,105,214,0.25);box-shadow:0 1px 4px rgba(0,105,214,0.25)}.thumbnail>img{display:block;max-width:100%;margin-right:auto;margin-left:auto}.thumbnail .caption{padding:9px}.label,.badge{font-size:10.998px;font-weight:bold;line-height:14px;color:#fff;text-shadow:0 -1px 0 rgba(0,0,0,0.25);white-space:nowrap;vertical-align:baseline;background-color:#999}.label{padding:1px 4px 2px;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px}.badge{padding:1px 9px 2px;-webkit-border-radius:9px;-moz-border-radius:9px;border-radius:9px}a.label:hover,a.badge:hover{color:#fff;text-decoration:none;cursor:pointer}.label-important,.badge-important{background-color:#b94a48}.label-important[href],.badge-important[href]{background-color:#953b39}.label-warning,.badge-warning{background-color:#f89406}.label-warning[href],.badge-warning[href]{background-color:#c67605}.label-success,.badge-success{background-color:#468847}.label-success[href],.badge-success[href]{background-color:#356635}.label-info,.badge-info{background-color:#3a87ad}.label-info[href],.badge-info[href]{background-color:#2d6987}.label-inverse,.badge-inverse{background-color:#333}.label-inverse[href],.badge-inverse[href]{background-color:#1a1a1a}@-webkit-keyframes progress-bar-stripes{from{background-position:40px 0}to{background-position:0 0}}@-moz-keyframes progress-bar-stripes{from{background-position:40px 0}to{background-position:0 0}}@-ms-keyframes progress-bar-stripes{from{background-position:40px 0}to{background-position:0 0}}@-o-keyframes progress-bar-stripes{from{background-position:0 0}to{background-position:40px 0}}@keyframes progress-bar-stripes{from{background-position:40px 0}to{background-position:0 0}}.progress{height:18px;margin-bottom:18px;overflow:hidden;background-color:#f7f7f7;background-image:-moz-linear-gradient(top,#f5f5f5,#f9f9f9);background-image:-ms-linear-gradient(top,#f5f5f5,#f9f9f9);background-image:-webkit-gradient(linear,0 0,0 100%,from(#f5f5f5),to(#f9f9f9));background-image:-webkit-linear-gradient(top,#f5f5f5,#f9f9f9);background-image:-o-linear-gradient(top,#f5f5f5,#f9f9f9);background-image:linear-gradient(top,#f5f5f5,#f9f9f9);background-repeat:repeat-x;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#f5f5f5',endColorstr='#f9f9f9',GradientType=0);-webkit-box-shadow:inset 0 1px 2px rgba(0,0,0,0.1);-moz-box-shadow:inset 0 1px 2px rgba(0,0,0,0.1);box-shadow:inset 0 1px 2px rgba(0,0,0,0.1)}.progress .bar{width:0;height:18px;font-size:12px;color:#fff;text-align:center;text-shadow:0 -1px 0 rgba(0,0,0,0.25);background-color:#0e90d2;background-image:-moz-linear-gradient(top,#149bdf,#0480be);background-image:-webkit-gradient(linear,0 0,0 100%,from(#149bdf),to(#0480be));background-image:-webkit-linear-gradient(top,#149bdf,#0480be);background-image:-o-linear-gradient(top,#149bdf,#0480be);background-image:linear-gradient(top,#149bdf,#0480be);background-image:-ms-linear-gradient(top,#149bdf,#0480be);background-repeat:repeat-x;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#149bdf',endColorstr='#0480be',GradientType=0);-webkit-box-shadow:inset 0 -1px 0 rgba(0,0,0,0.15);-moz-box-shadow:inset 0 -1px 0 rgba(0,0,0,0.15);box-shadow:inset 0 -1px 0 rgba(0,0,0,0.15);-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box;-webkit-transition:width .6s ease;-moz-transition:width .6s ease;-ms-transition:width .6s ease;-o-transition:width .6s ease;transition:width .6s ease}.progress-striped .bar{background-color:#149bdf;background-image:-o-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-webkit-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-moz-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-ms-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-webkit-gradient(linear,0 100%,100% 0,color-stop(0.25,rgba(255,255,255,0.15)),color-stop(0.25,transparent),color-stop(0.5,transparent),color-stop(0.5,rgba(255,255,255,0.15)),color-stop(0.75,rgba(255,255,255,0.15)),color-stop(0.75,transparent),to(transparent));background-image:linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);-webkit-background-size:40px 40px;-moz-background-size:40px 40px;-o-background-size:40px 40px;background-size:40px 40px}.progress.active .bar{-webkit-animation:progress-bar-stripes 2s linear infinite;-moz-animation:progress-bar-stripes 2s linear infinite;-ms-animation:progress-bar-stripes 2s linear infinite;-o-animation:progress-bar-stripes 2s linear infinite;animation:progress-bar-stripes 2s linear infinite}.progress-danger .bar{background-color:#dd514c;background-image:-moz-linear-gradient(top,#ee5f5b,#c43c35);background-image:-ms-linear-gradient(top,#ee5f5b,#c43c35);background-image:-webkit-gradient(linear,0 0,0 100%,from(#ee5f5b),to(#c43c35));background-image:-webkit-linear-gradient(top,#ee5f5b,#c43c35);background-image:-o-linear-gradient(top,#ee5f5b,#c43c35);background-image:linear-gradient(top,#ee5f5b,#c43c35);background-repeat:repeat-x;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#ee5f5b',endColorstr='#c43c35',GradientType=0)}.progress-danger.progress-striped .bar{background-color:#ee5f5b;background-image:-webkit-gradient(linear,0 100%,100% 0,color-stop(0.25,rgba(255,255,255,0.15)),color-stop(0.25,transparent),color-stop(0.5,transparent),color-stop(0.5,rgba(255,255,255,0.15)),color-stop(0.75,rgba(255,255,255,0.15)),color-stop(0.75,transparent),to(transparent));background-image:-webkit-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-moz-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-ms-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-o-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent)}.progress-success .bar{background-color:#5eb95e;background-image:-moz-linear-gradient(top,#62c462,#57a957);background-image:-ms-linear-gradient(top,#62c462,#57a957);background-image:-webkit-gradient(linear,0 0,0 100%,from(#62c462),to(#57a957));background-image:-webkit-linear-gradient(top,#62c462,#57a957);background-image:-o-linear-gradient(top,#62c462,#57a957);background-image:linear-gradient(top,#62c462,#57a957);background-repeat:repeat-x;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#62c462',endColorstr='#57a957',GradientType=0)}.progress-success.progress-striped .bar{background-color:#62c462;background-image:-webkit-gradient(linear,0 100%,100% 0,color-stop(0.25,rgba(255,255,255,0.15)),color-stop(0.25,transparent),color-stop(0.5,transparent),color-stop(0.5,rgba(255,255,255,0.15)),color-stop(0.75,rgba(255,255,255,0.15)),color-stop(0.75,transparent),to(transparent));background-image:-webkit-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-moz-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-ms-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-o-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent)}.progress-info .bar{background-color:#4bb1cf;background-image:-moz-linear-gradient(top,#5bc0de,#339bb9);background-image:-ms-linear-gradient(top,#5bc0de,#339bb9);background-image:-webkit-gradient(linear,0 0,0 100%,from(#5bc0de),to(#339bb9));background-image:-webkit-linear-gradient(top,#5bc0de,#339bb9);background-image:-o-linear-gradient(top,#5bc0de,#339bb9);background-image:linear-gradient(top,#5bc0de,#339bb9);background-repeat:repeat-x;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#5bc0de',endColorstr='#339bb9',GradientType=0)}.progress-info.progress-striped .bar{background-color:#5bc0de;background-image:-webkit-gradient(linear,0 100%,100% 0,color-stop(0.25,rgba(255,255,255,0.15)),color-stop(0.25,transparent),color-stop(0.5,transparent),color-stop(0.5,rgba(255,255,255,0.15)),color-stop(0.75,rgba(255,255,255,0.15)),color-stop(0.75,transparent),to(transparent));background-image:-webkit-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-moz-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-ms-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-o-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent)}.progress-warning .bar{background-color:#faa732;background-image:-moz-linear-gradient(top,#fbb450,#f89406);background-image:-ms-linear-gradient(top,#fbb450,#f89406);background-image:-webkit-gradient(linear,0 0,0 100%,from(#fbb450),to(#f89406));background-image:-webkit-linear-gradient(top,#fbb450,#f89406);background-image:-o-linear-gradient(top,#fbb450,#f89406);background-image:linear-gradient(top,#fbb450,#f89406);background-repeat:repeat-x;filter:progid:dximagetransform.microsoft.gradient(startColorstr='#fbb450',endColorstr='#f89406',GradientType=0)}.progress-warning.progress-striped .bar{background-color:#fbb450;background-image:-webkit-gradient(linear,0 100%,100% 0,color-stop(0.25,rgba(255,255,255,0.15)),color-stop(0.25,transparent),color-stop(0.5,transparent),color-stop(0.5,rgba(255,255,255,0.15)),color-stop(0.75,rgba(255,255,255,0.15)),color-stop(0.75,transparent),to(transparent));background-image:-webkit-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-moz-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-ms-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:-o-linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent);background-image:linear-gradient(-45deg,rgba(255,255,255,0.15) 25%,transparent 25%,transparent 50%,rgba(255,255,255,0.15) 50%,rgba(255,255,255,0.15) 75%,transparent 75%,transparent)}.accordion{margin-bottom:18px}.accordion-group{margin-bottom:2px;border:1px solid #e5e5e5;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px}.accordion-heading{border-bottom:0}.accordion-heading .accordion-toggle{display:block;padding:8px 15px}.accordion-toggle{cursor:pointer}.accordion-inner{padding:9px 15px;border-top:1px solid #e5e5e5}.carousel{position:relative;margin-bottom:18px;line-height:1}.carousel-inner{position:relative;width:100%;overflow:hidden}.carousel .item{position:relative;display:none;-webkit-transition:.6s ease-in-out left;-moz-transition:.6s ease-in-out left;-ms-transition:.6s ease-in-out left;-o-transition:.6s ease-in-out left;transition:.6s ease-in-out left}.carousel .item>img{display:block;line-height:1}.carousel .active,.carousel .next,.carousel .prev{display:block}.carousel .active{left:0}.carousel .next,.carousel .prev{position:absolute;top:0;width:100%}.carousel .next{left:100%}.carousel .prev{left:-100%}.carousel .next.left,.carousel .prev.right{left:0}.carousel .active.left{left:-100%}.carousel .active.right{left:100%}.carousel-control{position:absolute;top:40%;left:15px;width:40px;height:40px;margin-top:-20px;font-size:60px;font-weight:100;line-height:30px;color:#fff;text-align:center;background:#222;border:3px solid #fff;-webkit-border-radius:23px;-moz-border-radius:23px;border-radius:23px;opacity:.5;filter:alpha(opacity=50)}.carousel-control.right{right:15px;left:auto}.carousel-control:hover{color:#fff;text-decoration:none;opacity:.9;filter:alpha(opacity=90)}.carousel-caption{position:absolute;right:0;bottom:0;left:0;padding:10px 15px 5px;background:#333;background:rgba(0,0,0,0.75)}.carousel-caption h4,.carousel-caption p{color:#fff}.hero-unit{padding:60px;margin-bottom:30px;background-color:#eee;-webkit-border-radius:6px;-moz-border-radius:6px;border-radius:6px}.hero-unit h1{margin-bottom:0;font-size:60px;line-height:1;letter-spacing:-1px;color:inherit}.hero-unit p{font-size:18px;font-weight:200;line-height:27px;color:inherit}.pull-right{float:right}.pull-left{float:left}.hide{display:none}.show{display:block}.invisible{visibility:hidden} diff --git a/web/sugarcane/static/bootstrap.min.js b/web/sugarcane/static/bootstrap.min.js deleted file mode 100644 index 1f87730a3ae..00000000000 --- a/web/sugarcane/static/bootstrap.min.js +++ /dev/null @@ -1,6 +0,0 @@ -/*! -* Bootstrap.js by @fat & @mdo -* Copyright 2012 Twitter, Inc. -* http://www.apache.org/licenses/LICENSE-2.0.txt -*/ -!function(a){a(function(){"use strict",a.support.transition=function(){var a=function(){var a=document.createElement("bootstrap"),b={WebkitTransition:"webkitTransitionEnd",MozTransition:"transitionend",OTransition:"oTransitionEnd",msTransition:"MSTransitionEnd",transition:"transitionend"},c;for(c in b)if(a.style[c]!==undefined)return b[c]}();return a&&{end:a}}()})}(window.jQuery),!function(a){"use strict";var b='[data-dismiss="alert"]',c=function(c){a(c).on("click",b,this.close)};c.prototype.close=function(b){function f(){e.trigger("closed").remove()}var c=a(this),d=c.attr("data-target"),e;d||(d=c.attr("href"),d=d&&d.replace(/.*(?=#[^\s]*$)/,"")),e=a(d),b&&b.preventDefault(),e.length||(e=c.hasClass("alert")?c:c.parent()),e.trigger(b=a.Event("close"));if(b.isDefaultPrevented())return;e.removeClass("in"),a.support.transition&&e.hasClass("fade")?e.on(a.support.transition.end,f):f()},a.fn.alert=function(b){return this.each(function(){var d=a(this),e=d.data("alert");e||d.data("alert",e=new c(this)),typeof b=="string"&&e[b].call(d)})},a.fn.alert.Constructor=c,a(function(){a("body").on("click.alert.data-api",b,c.prototype.close)})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=a.extend({},a.fn.button.defaults,c)};b.prototype.setState=function(a){var b="disabled",c=this.$element,d=c.data(),e=c.is("input")?"val":"html";a+="Text",d.resetText||c.data("resetText",c[e]()),c[e](d[a]||this.options[a]),setTimeout(function(){a=="loadingText"?c.addClass(b).attr(b,b):c.removeClass(b).removeAttr(b)},0)},b.prototype.toggle=function(){var a=this.$element.parent('[data-toggle="buttons-radio"]');a&&a.find(".active").removeClass("active"),this.$element.toggleClass("active")},a.fn.button=function(c){return this.each(function(){var d=a(this),e=d.data("button"),f=typeof c=="object"&&c;e||d.data("button",e=new b(this,f)),c=="toggle"?e.toggle():c&&e.setState(c)})},a.fn.button.defaults={loadingText:"loading..."},a.fn.button.Constructor=b,a(function(){a("body").on("click.button.data-api","[data-toggle^=button]",function(b){var c=a(b.target);c.hasClass("btn")||(c=c.closest(".btn")),c.button("toggle")})})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=c,this.options.slide&&this.slide(this.options.slide),this.options.pause=="hover"&&this.$element.on("mouseenter",a.proxy(this.pause,this)).on("mouseleave",a.proxy(this.cycle,this))};b.prototype={cycle:function(b){return b||(this.paused=!1),this.options.interval&&!this.paused&&(this.interval=setInterval(a.proxy(this.next,this),this.options.interval)),this},to:function(b){var c=this.$element.find(".active"),d=c.parent().children(),e=d.index(c),f=this;if(b>d.length-1||b<0)return;return this.sliding?this.$element.one("slid",function(){f.to(b)}):e==b?this.pause().cycle():this.slide(b>e?"next":"prev",a(d[b]))},pause:function(a){return a||(this.paused=!0),clearInterval(this.interval),this.interval=null,this},next:function(){if(this.sliding)return;return this.slide("next")},prev:function(){if(this.sliding)return;return this.slide("prev")},slide:function(b,c){var d=this.$element.find(".active"),e=c||d[b](),f=this.interval,g=b=="next"?"left":"right",h=b=="next"?"first":"last",i=this,j=a.Event("slide");this.sliding=!0,f&&this.pause(),e=e.length?e:this.$element.find(".item")[h]();if(e.hasClass("active"))return;if(a.support.transition&&this.$element.hasClass("slide")){this.$element.trigger(j);if(j.isDefaultPrevented())return;e.addClass(b),e[0].offsetWidth,d.addClass(g),e.addClass(g),this.$element.one(a.support.transition.end,function(){e.removeClass([b,g].join(" ")).addClass("active"),d.removeClass(["active",g].join(" ")),i.sliding=!1,setTimeout(function(){i.$element.trigger("slid")},0)})}else{this.$element.trigger(j);if(j.isDefaultPrevented())return;d.removeClass("active"),e.addClass("active"),this.sliding=!1,this.$element.trigger("slid")}return f&&this.cycle(),this}},a.fn.carousel=function(c){return this.each(function(){var d=a(this),e=d.data("carousel"),f=a.extend({},a.fn.carousel.defaults,typeof c=="object"&&c);e||d.data("carousel",e=new b(this,f)),typeof c=="number"?e.to(c):typeof c=="string"||(c=f.slide)?e[c]():f.interval&&e.cycle()})},a.fn.carousel.defaults={interval:5e3,pause:"hover"},a.fn.carousel.Constructor=b,a(function(){a("body").on("click.carousel.data-api","[data-slide]",function(b){var c=a(this),d,e=a(c.attr("data-target")||(d=c.attr("href"))&&d.replace(/.*(?=#[^\s]+$)/,"")),f=!e.data("modal")&&a.extend({},e.data(),c.data());e.carousel(f),b.preventDefault()})})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=a.extend({},a.fn.collapse.defaults,c),this.options.parent&&(this.$parent=a(this.options.parent)),this.options.toggle&&this.toggle()};b.prototype={constructor:b,dimension:function(){var a=this.$element.hasClass("width");return a?"width":"height"},show:function(){var b,c,d,e;if(this.transitioning)return;b=this.dimension(),c=a.camelCase(["scroll",b].join("-")),d=this.$parent&&this.$parent.find("> .accordion-group > .in");if(d&&d.length){e=d.data("collapse");if(e&&e.transitioning)return;d.collapse("hide"),e||d.data("collapse",null)}this.$element[b](0),this.transition("addClass",a.Event("show"),"shown"),this.$element[b](this.$element[0][c])},hide:function(){var b;if(this.transitioning)return;b=this.dimension(),this.reset(this.$element[b]()),this.transition("removeClass",a.Event("hide"),"hidden"),this.$element[b](0)},reset:function(a){var b=this.dimension();return this.$element.removeClass("collapse")[b](a||"auto")[0].offsetWidth,this.$element[a!==null?"addClass":"removeClass"]("collapse"),this},transition:function(b,c,d){var e=this,f=function(){c.type=="show"&&e.reset(),e.transitioning=0,e.$element.trigger(d)};this.$element.trigger(c);if(c.isDefaultPrevented())return;this.transitioning=1,this.$element[b]("in"),a.support.transition&&this.$element.hasClass("collapse")?this.$element.one(a.support.transition.end,f):f()},toggle:function(){this[this.$element.hasClass("in")?"hide":"show"]()}},a.fn.collapse=function(c){return this.each(function(){var d=a(this),e=d.data("collapse"),f=typeof c=="object"&&c;e||d.data("collapse",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.collapse.defaults={toggle:!0},a.fn.collapse.Constructor=b,a(function(){a("body").on("click.collapse.data-api","[data-toggle=collapse]",function(b){var c=a(this),d,e=c.attr("data-target")||b.preventDefault()||(d=c.attr("href"))&&d.replace(/.*(?=#[^\s]+$)/,""),f=a(e).data("collapse")?"toggle":c.data();a(e).collapse(f)})})}(window.jQuery),!function(a){function d(){a(b).parent().removeClass("open")}"use strict";var b='[data-toggle="dropdown"]',c=function(b){var c=a(b).on("click.dropdown.data-api",this.toggle);a("html").on("click.dropdown.data-api",function(){c.parent().removeClass("open")})};c.prototype={constructor:c,toggle:function(b){var c=a(this),e,f,g;if(c.is(".disabled, :disabled"))return;return f=c.attr("data-target"),f||(f=c.attr("href"),f=f&&f.replace(/.*(?=#[^\s]*$)/,"")),e=a(f),e.length||(e=c.parent()),g=e.hasClass("open"),d(),g||e.toggleClass("open"),!1}},a.fn.dropdown=function(b){return this.each(function(){var d=a(this),e=d.data("dropdown");e||d.data("dropdown",e=new c(this)),typeof b=="string"&&e[b].call(d)})},a.fn.dropdown.Constructor=c,a(function(){a("html").on("click.dropdown.data-api",d),a("body").on("click.dropdown",".dropdown form",function(a){a.stopPropagation()}).on("click.dropdown.data-api",b,c.prototype.toggle)})}(window.jQuery),!function(a){function c(){var b=this,c=setTimeout(function(){b.$element.off(a.support.transition.end),d.call(b)},500);this.$element.one(a.support.transition.end,function(){clearTimeout(c),d.call(b)})}function d(a){this.$element.hide().trigger("hidden"),e.call(this)}function e(b){var c=this,d=this.$element.hasClass("fade")?"fade":"";if(this.isShown&&this.options.backdrop){var e=a.support.transition&&d;this.$backdrop=a('
').appendTo(document.body),this.options.backdrop!="static"&&this.$backdrop.click(a.proxy(this.hide,this)),e&&this.$backdrop[0].offsetWidth,this.$backdrop.addClass("in"),e?this.$backdrop.one(a.support.transition.end,b):b()}else!this.isShown&&this.$backdrop?(this.$backdrop.removeClass("in"),a.support.transition&&this.$element.hasClass("fade")?this.$backdrop.one(a.support.transition.end,a.proxy(f,this)):f.call(this)):b&&b()}function f(){this.$backdrop.remove(),this.$backdrop=null}function g(){var b=this;this.isShown&&this.options.keyboard?a(document).on("keyup.dismiss.modal",function(a){a.which==27&&b.hide()}):this.isShown||a(document).off("keyup.dismiss.modal")}"use strict";var b=function(b,c){this.options=c,this.$element=a(b).delegate('[data-dismiss="modal"]',"click.dismiss.modal",a.proxy(this.hide,this))};b.prototype={constructor:b,toggle:function(){return this[this.isShown?"hide":"show"]()},show:function(){var b=this,c=a.Event("show");this.$element.trigger(c);if(this.isShown||c.isDefaultPrevented())return;a("body").addClass("modal-open"),this.isShown=!0,g.call(this),e.call(this,function(){var c=a.support.transition&&b.$element.hasClass("fade");b.$element.parent().length||b.$element.appendTo(document.body),b.$element.show(),c&&b.$element[0].offsetWidth,b.$element.addClass("in"),c?b.$element.one(a.support.transition.end,function(){b.$element.trigger("shown")}):b.$element.trigger("shown")})},hide:function(b){b&&b.preventDefault();var e=this;b=a.Event("hide"),this.$element.trigger(b);if(!this.isShown||b.isDefaultPrevented())return;this.isShown=!1,a("body").removeClass("modal-open"),g.call(this),this.$element.removeClass("in"),a.support.transition&&this.$element.hasClass("fade")?c.call(this):d.call(this)}},a.fn.modal=function(c){return this.each(function(){var d=a(this),e=d.data("modal"),f=a.extend({},a.fn.modal.defaults,d.data(),typeof c=="object"&&c);e||d.data("modal",e=new b(this,f)),typeof c=="string"?e[c]():f.show&&e.show()})},a.fn.modal.defaults={backdrop:!0,keyboard:!0,show:!0},a.fn.modal.Constructor=b,a(function(){a("body").on("click.modal.data-api",'[data-toggle="modal"]',function(b){var c=a(this),d,e=a(c.attr("data-target")||(d=c.attr("href"))&&d.replace(/.*(?=#[^\s]+$)/,"")),f=e.data("modal")?"toggle":a.extend({},e.data(),c.data());b.preventDefault(),e.modal(f)})})}(window.jQuery),!function(a){"use strict";var b=function(a,b){this.init("tooltip",a,b)};b.prototype={constructor:b,init:function(b,c,d){var e,f;this.type=b,this.$element=a(c),this.options=this.getOptions(d),this.enabled=!0,this.options.trigger!="manual"&&(e=this.options.trigger=="hover"?"mouseenter":"focus",f=this.options.trigger=="hover"?"mouseleave":"blur",this.$element.on(e,this.options.selector,a.proxy(this.enter,this)),this.$element.on(f,this.options.selector,a.proxy(this.leave,this))),this.options.selector?this._options=a.extend({},this.options,{trigger:"manual",selector:""}):this.fixTitle()},getOptions:function(b){return b=a.extend({},a.fn[this.type].defaults,b,this.$element.data()),b.delay&&typeof b.delay=="number"&&(b.delay={show:b.delay,hide:b.delay}),b},enter:function(b){var c=a(b.currentTarget)[this.type](this._options).data(this.type);if(!c.options.delay||!c.options.delay.show)return c.show();clearTimeout(this.timeout),c.hoverState="in",this.timeout=setTimeout(function(){c.hoverState=="in"&&c.show()},c.options.delay.show)},leave:function(b){var c=a(b.currentTarget)[this.type](this._options).data(this.type);if(!c.options.delay||!c.options.delay.hide)return c.hide();clearTimeout(this.timeout),c.hoverState="out",this.timeout=setTimeout(function(){c.hoverState=="out"&&c.hide()},c.options.delay.hide)},show:function(){var a,b,c,d,e,f,g;if(this.hasContent()&&this.enabled){a=this.tip(),this.setContent(),this.options.animation&&a.addClass("fade"),f=typeof this.options.placement=="function"?this.options.placement.call(this,a[0],this.$element[0]):this.options.placement,b=/in/.test(f),a.remove().css({top:0,left:0,display:"block"}).appendTo(b?this.$element:document.body),c=this.getPosition(b),d=a[0].offsetWidth,e=a[0].offsetHeight;switch(b?f.split(" ")[1]:f){case"bottom":g={top:c.top+c.height,left:c.left+c.width/2-d/2};break;case"top":g={top:c.top-e,left:c.left+c.width/2-d/2};break;case"left":g={top:c.top+c.height/2-e/2,left:c.left-d};break;case"right":g={top:c.top+c.height/2-e/2,left:c.left+c.width}}a.css(g).addClass(f).addClass("in")}},isHTML:function(a){return typeof a!="string"||a.charAt(0)==="<"&&a.charAt(a.length-1)===">"&&a.length>=3||/^(?:[^<]*<[\w\W]+>[^>]*$)/.exec(a)},setContent:function(){var a=this.tip(),b=this.getTitle();a.find(".tooltip-inner")[this.isHTML(b)?"html":"text"](b),a.removeClass("fade in top bottom left right")},hide:function(){function d(){var b=setTimeout(function(){c.off(a.support.transition.end).remove()},500);c.one(a.support.transition.end,function(){clearTimeout(b),c.remove()})}var b=this,c=this.tip();c.removeClass("in"),a.support.transition&&this.$tip.hasClass("fade")?d():c.remove()},fixTitle:function(){var a=this.$element;(a.attr("title")||typeof a.attr("data-original-title")!="string")&&a.attr("data-original-title",a.attr("title")||"").removeAttr("title")},hasContent:function(){return this.getTitle()},getPosition:function(b){return a.extend({},b?{top:0,left:0}:this.$element.offset(),{width:this.$element[0].offsetWidth,height:this.$element[0].offsetHeight})},getTitle:function(){var a,b=this.$element,c=this.options;return a=b.attr("data-original-title")||(typeof c.title=="function"?c.title.call(b[0]):c.title),a},tip:function(){return this.$tip=this.$tip||a(this.options.template)},validate:function(){this.$element[0].parentNode||(this.hide(),this.$element=null,this.options=null)},enable:function(){this.enabled=!0},disable:function(){this.enabled=!1},toggleEnabled:function(){this.enabled=!this.enabled},toggle:function(){this[this.tip().hasClass("in")?"hide":"show"]()}},a.fn.tooltip=function(c){return this.each(function(){var d=a(this),e=d.data("tooltip"),f=typeof c=="object"&&c;e||d.data("tooltip",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.tooltip.Constructor=b,a.fn.tooltip.defaults={animation:!0,placement:"top",selector:!1,template:'
',trigger:"hover",title:"",delay:0}}(window.jQuery),!function(a){"use strict";var b=function(a,b){this.init("popover",a,b)};b.prototype=a.extend({},a.fn.tooltip.Constructor.prototype,{constructor:b,setContent:function(){var a=this.tip(),b=this.getTitle(),c=this.getContent();a.find(".popover-title")[this.isHTML(b)?"html":"text"](b),a.find(".popover-content > *")[this.isHTML(c)?"html":"text"](c),a.removeClass("fade top bottom left right in")},hasContent:function(){return this.getTitle()||this.getContent()},getContent:function(){var a,b=this.$element,c=this.options;return a=b.attr("data-content")||(typeof c.content=="function"?c.content.call(b[0]):c.content),a},tip:function(){return this.$tip||(this.$tip=a(this.options.template)),this.$tip}}),a.fn.popover=function(c){return this.each(function(){var d=a(this),e=d.data("popover"),f=typeof c=="object"&&c;e||d.data("popover",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.popover.Constructor=b,a.fn.popover.defaults=a.extend({},a.fn.tooltip.defaults,{placement:"right",content:"",template:'

'})}(window.jQuery),!function(a){function b(b,c){var d=a.proxy(this.process,this),e=a(b).is("body")?a(window):a(b),f;this.options=a.extend({},a.fn.scrollspy.defaults,c),this.$scrollElement=e.on("scroll.scroll.data-api",d),this.selector=(this.options.target||(f=a(b).attr("href"))&&f.replace(/.*(?=#[^\s]+$)/,"")||"")+" .nav li > a",this.$body=a("body"),this.refresh(),this.process()}"use strict",b.prototype={constructor:b,refresh:function(){var b=this,c;this.offsets=a([]),this.targets=a([]),c=this.$body.find(this.selector).map(function(){var b=a(this),c=b.data("target")||b.attr("href"),d=/^#\w/.test(c)&&a(c);return d&&c.length&&[[d.position().top,c]]||null}).sort(function(a,b){return a[0]-b[0]}).each(function(){b.offsets.push(this[0]),b.targets.push(this[1])})},process:function(){var a=this.$scrollElement.scrollTop()+this.options.offset,b=this.$scrollElement[0].scrollHeight||this.$body[0].scrollHeight,c=b-this.$scrollElement.height(),d=this.offsets,e=this.targets,f=this.activeTarget,g;if(a>=c)return f!=(g=e.last()[0])&&this.activate(g);for(g=d.length;g--;)f!=e[g]&&a>=d[g]&&(!d[g+1]||a<=d[g+1])&&this.activate(e[g])},activate:function(b){var c,d;this.activeTarget=b,a(this.selector).parent(".active").removeClass("active"),d=this.selector+'[data-target="'+b+'"],'+this.selector+'[href="'+b+'"]',c=a(d).parent("li").addClass("active"),c.parent(".dropdown-menu")&&(c=c.closest("li.dropdown").addClass("active")),c.trigger("activate")}},a.fn.scrollspy=function(c){return this.each(function(){var d=a(this),e=d.data("scrollspy"),f=typeof c=="object"&&c;e||d.data("scrollspy",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.scrollspy.Constructor=b,a.fn.scrollspy.defaults={offset:10},a(function(){a('[data-spy="scroll"]').each(function(){var b=a(this);b.scrollspy(b.data())})})}(window.jQuery),!function(a){"use strict";var b=function(b){this.element=a(b)};b.prototype={constructor:b,show:function(){var b=this.element,c=b.closest("ul:not(.dropdown-menu)"),d=b.attr("data-target"),e,f,g;d||(d=b.attr("href"),d=d&&d.replace(/.*(?=#[^\s]*$)/,""));if(b.parent("li").hasClass("active"))return;e=c.find(".active a").last()[0],g=a.Event("show",{relatedTarget:e}),b.trigger(g);if(g.isDefaultPrevented())return;f=a(d),this.activate(b.parent("li"),c),this.activate(f,f.parent(),function(){b.trigger({type:"shown",relatedTarget:e})})},activate:function(b,c,d){function g(){e.removeClass("active").find("> .dropdown-menu > .active").removeClass("active"),b.addClass("active"),f?(b[0].offsetWidth,b.addClass("in")):b.removeClass("fade"),b.parent(".dropdown-menu")&&b.closest("li.dropdown").addClass("active"),d&&d()}var e=c.find("> .active"),f=d&&a.support.transition&&e.hasClass("fade");f?e.one(a.support.transition.end,g):g(),e.removeClass("in")}},a.fn.tab=function(c){return this.each(function(){var d=a(this),e=d.data("tab");e||d.data("tab",e=new b(this)),typeof c=="string"&&e[c]()})},a.fn.tab.Constructor=b,a(function(){a("body").on("click.tab.data-api",'[data-toggle="tab"], [data-toggle="pill"]',function(b){b.preventDefault(),a(this).tab("show")})})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=a.extend({},a.fn.typeahead.defaults,c),this.matcher=this.options.matcher||this.matcher,this.sorter=this.options.sorter||this.sorter,this.highlighter=this.options.highlighter||this.highlighter,this.updater=this.options.updater||this.updater,this.$menu=a(this.options.menu).appendTo("body"),this.source=this.options.source,this.shown=!1,this.listen()};b.prototype={constructor:b,select:function(){var a=this.$menu.find(".active").attr("data-value");return this.$element.val(this.updater(a)).change(),this.hide()},updater:function(a){return a},show:function(){var b=a.extend({},this.$element.offset(),{height:this.$element[0].offsetHeight});return this.$menu.css({top:b.top+b.height,left:b.left}),this.$menu.show(),this.shown=!0,this},hide:function(){return this.$menu.hide(),this.shown=!1,this},lookup:function(b){var c=this,d,e;return this.query=this.$element.val(),this.query?(d=a.grep(this.source,function(a){return c.matcher(a)}),d=this.sorter(d),d.length?this.render(d.slice(0,this.options.items)).show():this.shown?this.hide():this):this.shown?this.hide():this},matcher:function(a){return~a.toLowerCase().indexOf(this.query.toLowerCase())},sorter:function(a){var b=[],c=[],d=[],e;while(e=a.shift())e.toLowerCase().indexOf(this.query.toLowerCase())?~e.indexOf(this.query)?c.push(e):d.push(e):b.push(e);return b.concat(c,d)},highlighter:function(a){var b=this.query.replace(/[\-\[\]{}()*+?.,\\\^$|#\s]/g,"\\$&");return a.replace(new RegExp("("+b+")","ig"),function(a,b){return""+b+""})},render:function(b){var c=this;return b=a(b).map(function(b,d){return b=a(c.options.item).attr("data-value",d),b.find("a").html(c.highlighter(d)),b[0]}),b.first().addClass("active"),this.$menu.html(b),this},next:function(b){var c=this.$menu.find(".active").removeClass("active"),d=c.next();d.length||(d=a(this.$menu.find("li")[0])),d.addClass("active")},prev:function(a){var b=this.$menu.find(".active").removeClass("active"),c=b.prev();c.length||(c=this.$menu.find("li").last()),c.addClass("active")},listen:function(){this.$element.on("blur",a.proxy(this.blur,this)).on("keypress",a.proxy(this.keypress,this)).on("keyup",a.proxy(this.keyup,this)),(a.browser.webkit||a.browser.msie)&&this.$element.on("keydown",a.proxy(this.keypress,this)),this.$menu.on("click",a.proxy(this.click,this)).on("mouseenter","li",a.proxy(this.mouseenter,this))},keyup:function(a){switch(a.keyCode){case 40:case 38:break;case 9:case 13:if(!this.shown)return;this.select();break;case 27:if(!this.shown)return;this.hide();break;default:this.lookup()}a.stopPropagation(),a.preventDefault()},keypress:function(a){if(!this.shown)return;switch(a.keyCode){case 9:case 13:case 27:a.preventDefault();break;case 38:if(a.type!="keydown")break;a.preventDefault(),this.prev();break;case 40:if(a.type!="keydown")break;a.preventDefault(),this.next()}a.stopPropagation()},blur:function(a){var b=this;setTimeout(function(){b.hide()},150)},click:function(a){a.stopPropagation(),a.preventDefault(),this.select()},mouseenter:function(b){this.$menu.find(".active").removeClass("active"),a(b.currentTarget).addClass("active")}},a.fn.typeahead=function(c){return this.each(function(){var d=a(this),e=d.data("typeahead"),f=typeof c=="object"&&c;e||d.data("typeahead",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.typeahead.defaults={source:[],items:8,menu:'
    ',item:'
    • '},a.fn.typeahead.Constructor=b,a(function(){a("body").on("focus.typeahead.data-api",'[data-provide="typeahead"]',function(b){var c=a(this);if(c.data("typeahead"))return;b.preventDefault(),c.typeahead(c.data())})})}(window.jQuery); \ No newline at end of file diff --git a/web/sugarcane/static/jquery-1.7.2.min.js b/web/sugarcane/static/jquery-1.7.2.min.js deleted file mode 100644 index 16ad06c5aca..00000000000 --- a/web/sugarcane/static/jquery-1.7.2.min.js +++ /dev/null @@ -1,4 +0,0 @@ -/*! jQuery v1.7.2 jquery.com | jquery.org/license */ -(function(a,b){function cy(a){return f.isWindow(a)?a:a.nodeType===9?a.defaultView||a.parentWindow:!1}function cu(a){if(!cj[a]){var b=c.body,d=f("<"+a+">").appendTo(b),e=d.css("display");d.remove();if(e==="none"||e===""){ck||(ck=c.createElement("iframe"),ck.frameBorder=ck.width=ck.height=0),b.appendChild(ck);if(!cl||!ck.createElement)cl=(ck.contentWindow||ck.contentDocument).document,cl.write((f.support.boxModel?"":"")+""),cl.close();d=cl.createElement(a),cl.body.appendChild(d),e=f.css(d,"display"),b.removeChild(ck)}cj[a]=e}return cj[a]}function ct(a,b){var c={};f.each(cp.concat.apply([],cp.slice(0,b)),function(){c[this]=a});return c}function cs(){cq=b}function cr(){setTimeout(cs,0);return cq=f.now()}function ci(){try{return new a.ActiveXObject("Microsoft.XMLHTTP")}catch(b){}}function ch(){try{return new a.XMLHttpRequest}catch(b){}}function cb(a,c){a.dataFilter&&(c=a.dataFilter(c,a.dataType));var d=a.dataTypes,e={},g,h,i=d.length,j,k=d[0],l,m,n,o,p;for(g=1;g0){if(c!=="border")for(;e=0===c})}function S(a){return!a||!a.parentNode||a.parentNode.nodeType===11}function K(){return!0}function J(){return!1}function n(a,b,c){var d=b+"defer",e=b+"queue",g=b+"mark",h=f._data(a,d);h&&(c==="queue"||!f._data(a,e))&&(c==="mark"||!f._data(a,g))&&setTimeout(function(){!f._data(a,e)&&!f._data(a,g)&&(f.removeData(a,d,!0),h.fire())},0)}function m(a){for(var b in a){if(b==="data"&&f.isEmptyObject(a[b]))continue;if(b!=="toJSON")return!1}return!0}function l(a,c,d){if(d===b&&a.nodeType===1){var e="data-"+c.replace(k,"-$1").toLowerCase();d=a.getAttribute(e);if(typeof d=="string"){try{d=d==="true"?!0:d==="false"?!1:d==="null"?null:f.isNumeric(d)?+d:j.test(d)?f.parseJSON(d):d}catch(g){}f.data(a,c,d)}else d=b}return d}function h(a){var b=g[a]={},c,d;a=a.split(/\s+/);for(c=0,d=a.length;c)[^>]*$|#([\w\-]*)$)/,j=/\S/,k=/^\s+/,l=/\s+$/,m=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,n=/^[\],:{}\s]*$/,o=/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,p=/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,q=/(?:^|:|,)(?:\s*\[)+/g,r=/(webkit)[ \/]([\w.]+)/,s=/(opera)(?:.*version)?[ \/]([\w.]+)/,t=/(msie) ([\w.]+)/,u=/(mozilla)(?:.*? rv:([\w.]+))?/,v=/-([a-z]|[0-9])/ig,w=/^-ms-/,x=function(a,b){return(b+"").toUpperCase()},y=d.userAgent,z,A,B,C=Object.prototype.toString,D=Object.prototype.hasOwnProperty,E=Array.prototype.push,F=Array.prototype.slice,G=String.prototype.trim,H=Array.prototype.indexOf,I={};e.fn=e.prototype={constructor:e,init:function(a,d,f){var g,h,j,k;if(!a)return this;if(a.nodeType){this.context=this[0]=a,this.length=1;return this}if(a==="body"&&!d&&c.body){this.context=c,this[0]=c.body,this.selector=a,this.length=1;return this}if(typeof a=="string"){a.charAt(0)!=="<"||a.charAt(a.length-1)!==">"||a.length<3?g=i.exec(a):g=[null,a,null];if(g&&(g[1]||!d)){if(g[1]){d=d instanceof e?d[0]:d,k=d?d.ownerDocument||d:c,j=m.exec(a),j?e.isPlainObject(d)?(a=[c.createElement(j[1])],e.fn.attr.call(a,d,!0)):a=[k.createElement(j[1])]:(j=e.buildFragment([g[1]],[k]),a=(j.cacheable?e.clone(j.fragment):j.fragment).childNodes);return e.merge(this,a)}h=c.getElementById(g[2]);if(h&&h.parentNode){if(h.id!==g[2])return f.find(a);this.length=1,this[0]=h}this.context=c,this.selector=a;return this}return!d||d.jquery?(d||f).find(a):this.constructor(d).find(a)}if(e.isFunction(a))return f.ready(a);a.selector!==b&&(this.selector=a.selector,this.context=a.context);return e.makeArray(a,this)},selector:"",jquery:"1.7.2",length:0,size:function(){return this.length},toArray:function(){return F.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this[this.length+a]:this[a]},pushStack:function(a,b,c){var d=this.constructor();e.isArray(a)?E.apply(d,a):e.merge(d,a),d.prevObject=this,d.context=this.context,b==="find"?d.selector=this.selector+(this.selector?" ":"")+c:b&&(d.selector=this.selector+"."+b+"("+c+")");return d},each:function(a,b){return e.each(this,a,b)},ready:function(a){e.bindReady(),A.add(a);return this},eq:function(a){a=+a;return a===-1?this.slice(a):this.slice(a,a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(F.apply(this,arguments),"slice",F.call(arguments).join(","))},map:function(a){return this.pushStack(e.map(this,function(b,c){return a.call(b,c,b)}))},end:function(){return this.prevObject||this.constructor(null)},push:E,sort:[].sort,splice:[].splice},e.fn.init.prototype=e.fn,e.extend=e.fn.extend=function(){var a,c,d,f,g,h,i=arguments[0]||{},j=1,k=arguments.length,l=!1;typeof i=="boolean"&&(l=i,i=arguments[1]||{},j=2),typeof i!="object"&&!e.isFunction(i)&&(i={}),k===j&&(i=this,--j);for(;j0)return;A.fireWith(c,[e]),e.fn.trigger&&e(c).trigger("ready").off("ready")}},bindReady:function(){if(!A){A=e.Callbacks("once memory");if(c.readyState==="complete")return setTimeout(e.ready,1);if(c.addEventListener)c.addEventListener("DOMContentLoaded",B,!1),a.addEventListener("load",e.ready,!1);else if(c.attachEvent){c.attachEvent("onreadystatechange",B),a.attachEvent("onload",e.ready);var b=!1;try{b=a.frameElement==null}catch(d){}c.documentElement.doScroll&&b&&J()}}},isFunction:function(a){return e.type(a)==="function"},isArray:Array.isArray||function(a){return e.type(a)==="array"},isWindow:function(a){return a!=null&&a==a.window},isNumeric:function(a){return!isNaN(parseFloat(a))&&isFinite(a)},type:function(a){return a==null?String(a):I[C.call(a)]||"object"},isPlainObject:function(a){if(!a||e.type(a)!=="object"||a.nodeType||e.isWindow(a))return!1;try{if(a.constructor&&!D.call(a,"constructor")&&!D.call(a.constructor.prototype,"isPrototypeOf"))return!1}catch(c){return!1}var d;for(d in a);return d===b||D.call(a,d)},isEmptyObject:function(a){for(var b in a)return!1;return!0},error:function(a){throw new Error(a)},parseJSON:function(b){if(typeof b!="string"||!b)return null;b=e.trim(b);if(a.JSON&&a.JSON.parse)return a.JSON.parse(b);if(n.test(b.replace(o,"@").replace(p,"]").replace(q,"")))return(new Function("return "+b))();e.error("Invalid JSON: "+b)},parseXML:function(c){if(typeof c!="string"||!c)return null;var d,f;try{a.DOMParser?(f=new DOMParser,d=f.parseFromString(c,"text/xml")):(d=new ActiveXObject("Microsoft.XMLDOM"),d.async="false",d.loadXML(c))}catch(g){d=b}(!d||!d.documentElement||d.getElementsByTagName("parsererror").length)&&e.error("Invalid XML: "+c);return d},noop:function(){},globalEval:function(b){b&&j.test(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(w,"ms-").replace(v,x)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toUpperCase()===b.toUpperCase()},each:function(a,c,d){var f,g=0,h=a.length,i=h===b||e.isFunction(a);if(d){if(i){for(f in a)if(c.apply(a[f],d)===!1)break}else for(;g0&&a[0]&&a[j-1]||j===0||e.isArray(a));if(k)for(;i1?i.call(arguments,0):b,j.notifyWith(k,e)}}function l(a){return function(c){b[a]=arguments.length>1?i.call(arguments,0):c,--g||j.resolveWith(j,b)}}var b=i.call(arguments,0),c=0,d=b.length,e=Array(d),g=d,h=d,j=d<=1&&a&&f.isFunction(a.promise)?a:f.Deferred(),k=j.promise();if(d>1){for(;c
    a",d=p.getElementsByTagName("*"),e=p.getElementsByTagName("a")[0];if(!d||!d.length||!e)return{};g=c.createElement("select"),h=g.appendChild(c.createElement("option")),i=p.getElementsByTagName("input")[0],b={leadingWhitespace:p.firstChild.nodeType===3,tbody:!p.getElementsByTagName("tbody").length,htmlSerialize:!!p.getElementsByTagName("link").length,style:/top/.test(e.getAttribute("style")),hrefNormalized:e.getAttribute("href")==="/a",opacity:/^0.55/.test(e.style.opacity),cssFloat:!!e.style.cssFloat,checkOn:i.value==="on",optSelected:h.selected,getSetAttribute:p.className!=="t",enctype:!!c.createElement("form").enctype,html5Clone:c.createElement("nav").cloneNode(!0).outerHTML!=="<:nav>",submitBubbles:!0,changeBubbles:!0,focusinBubbles:!1,deleteExpando:!0,noCloneEvent:!0,inlineBlockNeedsLayout:!1,shrinkWrapBlocks:!1,reliableMarginRight:!0,pixelMargin:!0},f.boxModel=b.boxModel=c.compatMode==="CSS1Compat",i.checked=!0,b.noCloneChecked=i.cloneNode(!0).checked,g.disabled=!0,b.optDisabled=!h.disabled;try{delete p.test}catch(r){b.deleteExpando=!1}!p.addEventListener&&p.attachEvent&&p.fireEvent&&(p.attachEvent("onclick",function(){b.noCloneEvent=!1}),p.cloneNode(!0).fireEvent("onclick")),i=c.createElement("input"),i.value="t",i.setAttribute("type","radio"),b.radioValue=i.value==="t",i.setAttribute("checked","checked"),i.setAttribute("name","t"),p.appendChild(i),j=c.createDocumentFragment(),j.appendChild(p.lastChild),b.checkClone=j.cloneNode(!0).cloneNode(!0).lastChild.checked,b.appendChecked=i.checked,j.removeChild(i),j.appendChild(p);if(p.attachEvent)for(n in{submit:1,change:1,focusin:1})m="on"+n,o=m in p,o||(p.setAttribute(m,"return;"),o=typeof p[m]=="function"),b[n+"Bubbles"]=o;j.removeChild(p),j=g=h=p=i=null,f(function(){var d,e,g,h,i,j,l,m,n,q,r,s,t,u=c.getElementsByTagName("body")[0];!u||(m=1,t="padding:0;margin:0;border:",r="position:absolute;top:0;left:0;width:1px;height:1px;",s=t+"0;visibility:hidden;",n="style='"+r+t+"5px solid #000;",q="
    "+""+"
    ",d=c.createElement("div"),d.style.cssText=s+"width:0;height:0;position:static;top:0;margin-top:"+m+"px",u.insertBefore(d,u.firstChild),p=c.createElement("div"),d.appendChild(p),p.innerHTML="
    t
    ",k=p.getElementsByTagName("td"),o=k[0].offsetHeight===0,k[0].style.display="",k[1].style.display="none",b.reliableHiddenOffsets=o&&k[0].offsetHeight===0,a.getComputedStyle&&(p.innerHTML="",l=c.createElement("div"),l.style.width="0",l.style.marginRight="0",p.style.width="2px",p.appendChild(l),b.reliableMarginRight=(parseInt((a.getComputedStyle(l,null)||{marginRight:0}).marginRight,10)||0)===0),typeof p.style.zoom!="undefined"&&(p.innerHTML="",p.style.width=p.style.padding="1px",p.style.border=0,p.style.overflow="hidden",p.style.display="inline",p.style.zoom=1,b.inlineBlockNeedsLayout=p.offsetWidth===3,p.style.display="block",p.style.overflow="visible",p.innerHTML="
    ",b.shrinkWrapBlocks=p.offsetWidth!==3),p.style.cssText=r+s,p.innerHTML=q,e=p.firstChild,g=e.firstChild,i=e.nextSibling.firstChild.firstChild,j={doesNotAddBorder:g.offsetTop!==5,doesAddBorderForTableAndCells:i.offsetTop===5},g.style.position="fixed",g.style.top="20px",j.fixedPosition=g.offsetTop===20||g.offsetTop===15,g.style.position=g.style.top="",e.style.overflow="hidden",e.style.position="relative",j.subtractsBorderForOverflowNotVisible=g.offsetTop===-5,j.doesNotIncludeMarginInBodyOffset=u.offsetTop!==m,a.getComputedStyle&&(p.style.marginTop="1%",b.pixelMargin=(a.getComputedStyle(p,null)||{marginTop:0}).marginTop!=="1%"),typeof d.style.zoom!="undefined"&&(d.style.zoom=1),u.removeChild(d),l=p=d=null,f.extend(b,j))});return b}();var j=/^(?:\{.*\}|\[.*\])$/,k=/([A-Z])/g;f.extend({cache:{},uuid:0,expando:"jQuery"+(f.fn.jquery+Math.random()).replace(/\D/g,""),noData:{embed:!0,object:"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000",applet:!0},hasData:function(a){a=a.nodeType?f.cache[a[f.expando]]:a[f.expando];return!!a&&!m(a)},data:function(a,c,d,e){if(!!f.acceptData(a)){var g,h,i,j=f.expando,k=typeof c=="string",l=a.nodeType,m=l?f.cache:a,n=l?a[j]:a[j]&&j,o=c==="events";if((!n||!m[n]||!o&&!e&&!m[n].data)&&k&&d===b)return;n||(l?a[j]=n=++f.uuid:n=j),m[n]||(m[n]={},l||(m[n].toJSON=f.noop));if(typeof c=="object"||typeof c=="function")e?m[n]=f.extend(m[n],c):m[n].data=f.extend(m[n].data,c);g=h=m[n],e||(h.data||(h.data={}),h=h.data),d!==b&&(h[f.camelCase(c)]=d);if(o&&!h[c])return g.events;k?(i=h[c],i==null&&(i=h[f.camelCase(c)])):i=h;return i}},removeData:function(a,b,c){if(!!f.acceptData(a)){var d,e,g,h=f.expando,i=a.nodeType,j=i?f.cache:a,k=i?a[h]:h;if(!j[k])return;if(b){d=c?j[k]:j[k].data;if(d){f.isArray(b)||(b in d?b=[b]:(b=f.camelCase(b),b in d?b=[b]:b=b.split(" ")));for(e=0,g=b.length;e1,null,!1)},removeData:function(a){return this.each(function(){f.removeData(this,a)})}}),f.extend({_mark:function(a,b){a&&(b=(b||"fx")+"mark",f._data(a,b,(f._data(a,b)||0)+1))},_unmark:function(a,b,c){a!==!0&&(c=b,b=a,a=!1);if(b){c=c||"fx";var d=c+"mark",e=a?0:(f._data(b,d)||1)-1;e?f._data(b,d,e):(f.removeData(b,d,!0),n(b,c,"mark"))}},queue:function(a,b,c){var d;if(a){b=(b||"fx")+"queue",d=f._data(a,b),c&&(!d||f.isArray(c)?d=f._data(a,b,f.makeArray(c)):d.push(c));return d||[]}},dequeue:function(a,b){b=b||"fx";var c=f.queue(a,b),d=c.shift(),e={};d==="inprogress"&&(d=c.shift()),d&&(b==="fx"&&c.unshift("inprogress"),f._data(a,b+".run",e),d.call(a,function(){f.dequeue(a,b)},e)),c.length||(f.removeData(a,b+"queue "+b+".run",!0),n(a,b,"queue"))}}),f.fn.extend({queue:function(a,c){var d=2;typeof a!="string"&&(c=a,a="fx",d--);if(arguments.length1)},removeAttr:function(a){return this.each(function(){f.removeAttr(this,a)})},prop:function(a,b){return f.access(this,f.prop,a,b,arguments.length>1)},removeProp:function(a){a=f.propFix[a]||a;return this.each(function(){try{this[a]=b,delete this[a]}catch(c){}})},addClass:function(a){var b,c,d,e,g,h,i;if(f.isFunction(a))return this.each(function(b){f(this).addClass(a.call(this,b,this.className))});if(a&&typeof a=="string"){b=a.split(p);for(c=0,d=this.length;c-1)return!0;return!1},val:function(a){var c,d,e,g=this[0];{if(!!arguments.length){e=f.isFunction(a);return this.each(function(d){var g=f(this),h;if(this.nodeType===1){e?h=a.call(this,d,g.val()):h=a,h==null?h="":typeof h=="number"?h+="":f.isArray(h)&&(h=f.map(h,function(a){return a==null?"":a+""})),c=f.valHooks[this.type]||f.valHooks[this.nodeName.toLowerCase()];if(!c||!("set"in c)||c.set(this,h,"value")===b)this.value=h}})}if(g){c=f.valHooks[g.type]||f.valHooks[g.nodeName.toLowerCase()];if(c&&"get"in c&&(d=c.get(g,"value"))!==b)return d;d=g.value;return typeof d=="string"?d.replace(q,""):d==null?"":d}}}}),f.extend({valHooks:{option:{get:function(a){var b=a.attributes.value;return!b||b.specified?a.value:a.text}},select:{get:function(a){var b,c,d,e,g=a.selectedIndex,h=[],i=a.options,j=a.type==="select-one";if(g<0)return null;c=j?g:0,d=j?g+1:i.length;for(;c=0}),c.length||(a.selectedIndex=-1);return c}}},attrFn:{val:!0,css:!0,html:!0,text:!0,data:!0,width:!0,height:!0,offset:!0},attr:function(a,c,d,e){var g,h,i,j=a.nodeType;if(!!a&&j!==3&&j!==8&&j!==2){if(e&&c in f.attrFn)return f(a)[c](d);if(typeof a.getAttribute=="undefined")return f.prop(a,c,d);i=j!==1||!f.isXMLDoc(a),i&&(c=c.toLowerCase(),h=f.attrHooks[c]||(u.test(c)?x:w));if(d!==b){if(d===null){f.removeAttr(a,c);return}if(h&&"set"in h&&i&&(g=h.set(a,d,c))!==b)return g;a.setAttribute(c,""+d);return d}if(h&&"get"in h&&i&&(g=h.get(a,c))!==null)return g;g=a.getAttribute(c);return g===null?b:g}},removeAttr:function(a,b){var c,d,e,g,h,i=0;if(b&&a.nodeType===1){d=b.toLowerCase().split(p),g=d.length;for(;i=0}})});var z=/^(?:textarea|input|select)$/i,A=/^([^\.]*)?(?:\.(.+))?$/,B=/(?:^|\s)hover(\.\S+)?\b/,C=/^key/,D=/^(?:mouse|contextmenu)|click/,E=/^(?:focusinfocus|focusoutblur)$/,F=/^(\w*)(?:#([\w\-]+))?(?:\.([\w\-]+))?$/,G=function( -a){var b=F.exec(a);b&&(b[1]=(b[1]||"").toLowerCase(),b[3]=b[3]&&new RegExp("(?:^|\\s)"+b[3]+"(?:\\s|$)"));return b},H=function(a,b){var c=a.attributes||{};return(!b[1]||a.nodeName.toLowerCase()===b[1])&&(!b[2]||(c.id||{}).value===b[2])&&(!b[3]||b[3].test((c["class"]||{}).value))},I=function(a){return f.event.special.hover?a:a.replace(B,"mouseenter$1 mouseleave$1")};f.event={add:function(a,c,d,e,g){var h,i,j,k,l,m,n,o,p,q,r,s;if(!(a.nodeType===3||a.nodeType===8||!c||!d||!(h=f._data(a)))){d.handler&&(p=d,d=p.handler,g=p.selector),d.guid||(d.guid=f.guid++),j=h.events,j||(h.events=j={}),i=h.handle,i||(h.handle=i=function(a){return typeof f!="undefined"&&(!a||f.event.triggered!==a.type)?f.event.dispatch.apply(i.elem,arguments):b},i.elem=a),c=f.trim(I(c)).split(" ");for(k=0;k=0&&(h=h.slice(0,-1),k=!0),h.indexOf(".")>=0&&(i=h.split("."),h=i.shift(),i.sort());if((!e||f.event.customEvent[h])&&!f.event.global[h])return;c=typeof c=="object"?c[f.expando]?c:new f.Event(h,c):new f.Event(h),c.type=h,c.isTrigger=!0,c.exclusive=k,c.namespace=i.join("."),c.namespace_re=c.namespace?new RegExp("(^|\\.)"+i.join("\\.(?:.*\\.)?")+"(\\.|$)"):null,o=h.indexOf(":")<0?"on"+h:"";if(!e){j=f.cache;for(l in j)j[l].events&&j[l].events[h]&&f.event.trigger(c,d,j[l].handle.elem,!0);return}c.result=b,c.target||(c.target=e),d=d!=null?f.makeArray(d):[],d.unshift(c),p=f.event.special[h]||{};if(p.trigger&&p.trigger.apply(e,d)===!1)return;r=[[e,p.bindType||h]];if(!g&&!p.noBubble&&!f.isWindow(e)){s=p.delegateType||h,m=E.test(s+h)?e:e.parentNode,n=null;for(;m;m=m.parentNode)r.push([m,s]),n=m;n&&n===e.ownerDocument&&r.push([n.defaultView||n.parentWindow||a,s])}for(l=0;le&&j.push({elem:this,matches:d.slice(e)});for(k=0;k0?this.on(b,null,a,c):this.trigger(b)},f.attrFn&&(f.attrFn[b]=!0),C.test(b)&&(f.event.fixHooks[b]=f.event.keyHooks),D.test(b)&&(f.event.fixHooks[b]=f.event.mouseHooks)}),function(){function x(a,b,c,e,f,g){for(var h=0,i=e.length;h0){k=j;break}}j=j[a]}e[h]=k}}}function w(a,b,c,e,f,g){for(var h=0,i=e.length;h+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g,d="sizcache"+(Math.random()+"").replace(".",""),e=0,g=Object.prototype.toString,h=!1,i=!0,j=/\\/g,k=/\r\n/g,l=/\W/;[0,0].sort(function(){i=!1;return 0});var m=function(b,d,e,f){e=e||[],d=d||c;var h=d;if(d.nodeType!==1&&d.nodeType!==9)return[];if(!b||typeof b!="string")return e;var i,j,k,l,n,q,r,t,u=!0,v=m.isXML(d),w=[],x=b;do{a.exec(""),i=a.exec(x);if(i){x=i[3],w.push(i[1]);if(i[2]){l=i[3];break}}}while(i);if(w.length>1&&p.exec(b))if(w.length===2&&o.relative[w[0]])j=y(w[0]+w[1],d,f);else{j=o.relative[w[0]]?[d]:m(w.shift(),d);while(w.length)b=w.shift(),o.relative[b]&&(b+=w.shift()),j=y(b,j,f)}else{!f&&w.length>1&&d.nodeType===9&&!v&&o.match.ID.test(w[0])&&!o.match.ID.test(w[w.length-1])&&(n=m.find(w.shift(),d,v),d=n.expr?m.filter(n.expr,n.set)[0]:n.set[0]);if(d){n=f?{expr:w.pop(),set:s(f)}:m.find(w.pop(),w.length===1&&(w[0]==="~"||w[0]==="+")&&d.parentNode?d.parentNode:d,v),j=n.expr?m.filter(n.expr,n.set):n.set,w.length>0?k=s(j):u=!1;while(w.length)q=w.pop(),r=q,o.relative[q]?r=w.pop():q="",r==null&&(r=d),o.relative[q](k,r,v)}else k=w=[]}k||(k=j),k||m.error(q||b);if(g.call(k)==="[object Array]")if(!u)e.push.apply(e,k);else if(d&&d.nodeType===1)for(t=0;k[t]!=null;t++)k[t]&&(k[t]===!0||k[t].nodeType===1&&m.contains(d,k[t]))&&e.push(j[t]);else for(t=0;k[t]!=null;t++)k[t]&&k[t].nodeType===1&&e.push(j[t]);else s(k,e);l&&(m(l,h,e,f),m.uniqueSort(e));return e};m.uniqueSort=function(a){if(u){h=i,a.sort(u);if(h)for(var b=1;b0},m.find=function(a,b,c){var d,e,f,g,h,i;if(!a)return[];for(e=0,f=o.order.length;e":function(a,b){var c,d=typeof b=="string",e=0,f=a.length;if(d&&!l.test(b)){b=b.toLowerCase();for(;e=0)?c||d.push(h):c&&(b[g]=!1));return!1},ID:function(a){return a[1].replace(j,"")},TAG:function(a,b){return a[1].replace(j,"").toLowerCase()},CHILD:function(a){if(a[1]==="nth"){a[2]||m.error(a[0]),a[2]=a[2].replace(/^\+|\s*/g,"");var b=/(-?)(\d*)(?:n([+\-]?\d*))?/.exec(a[2]==="even"&&"2n"||a[2]==="odd"&&"2n+1"||!/\D/.test(a[2])&&"0n+"+a[2]||a[2]);a[2]=b[1]+(b[2]||1)-0,a[3]=b[3]-0}else a[2]&&m.error(a[0]);a[0]=e++;return a},ATTR:function(a,b,c,d,e,f){var g=a[1]=a[1].replace(j,"");!f&&o.attrMap[g]&&(a[1]=o.attrMap[g]),a[4]=(a[4]||a[5]||"").replace(j,""),a[2]==="~="&&(a[4]=" "+a[4]+" ");return a},PSEUDO:function(b,c,d,e,f){if(b[1]==="not")if((a.exec(b[3])||"").length>1||/^\w/.test(b[3]))b[3]=m(b[3],null,null,c);else{var g=m.filter(b[3],c,d,!0^f);d||e.push.apply(e,g);return!1}else if(o.match.POS.test(b[0])||o.match.CHILD.test(b[0]))return!0;return b},POS:function(a){a.unshift(!0);return a}},filters:{enabled:function(a){return a.disabled===!1&&a.type!=="hidden"},disabled:function(a){return a.disabled===!0},checked:function(a){return a.checked===!0},selected:function(a){a.parentNode&&a.parentNode.selectedIndex;return a.selected===!0},parent:function(a){return!!a.firstChild},empty:function(a){return!a.firstChild},has:function(a,b,c){return!!m(c[3],a).length},header:function(a){return/h\d/i.test(a.nodeName)},text:function(a){var b=a.getAttribute("type"),c=a.type;return a.nodeName.toLowerCase()==="input"&&"text"===c&&(b===c||b===null)},radio:function(a){return a.nodeName.toLowerCase()==="input"&&"radio"===a.type},checkbox:function(a){return a.nodeName.toLowerCase()==="input"&&"checkbox"===a.type},file:function(a){return a.nodeName.toLowerCase()==="input"&&"file"===a.type},password:function(a){return a.nodeName.toLowerCase()==="input"&&"password"===a.type},submit:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"submit"===a.type},image:function(a){return a.nodeName.toLowerCase()==="input"&&"image"===a.type},reset:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"reset"===a.type},button:function(a){var b=a.nodeName.toLowerCase();return b==="input"&&"button"===a.type||b==="button"},input:function(a){return/input|select|textarea|button/i.test(a.nodeName)},focus:function(a){return a===a.ownerDocument.activeElement}},setFilters:{first:function(a,b){return b===0},last:function(a,b,c,d){return b===d.length-1},even:function(a,b){return b%2===0},odd:function(a,b){return b%2===1},lt:function(a,b,c){return bc[3]-0},nth:function(a,b,c){return c[3]-0===b},eq:function(a,b,c){return c[3]-0===b}},filter:{PSEUDO:function(a,b,c,d){var e=b[1],f=o.filters[e];if(f)return f(a,c,b,d);if(e==="contains")return(a.textContent||a.innerText||n([a])||"").indexOf(b[3])>=0;if(e==="not"){var g=b[3];for(var h=0,i=g.length;h=0}},ID:function(a,b){return a.nodeType===1&&a.getAttribute("id")===b},TAG:function(a,b){return b==="*"&&a.nodeType===1||!!a.nodeName&&a.nodeName.toLowerCase()===b},CLASS:function(a,b){return(" "+(a.className||a.getAttribute("class"))+" ").indexOf(b)>-1},ATTR:function(a,b){var c=b[1],d=m.attr?m.attr(a,c):o.attrHandle[c]?o.attrHandle[c](a):a[c]!=null?a[c]:a.getAttribute(c),e=d+"",f=b[2],g=b[4];return d==null?f==="!=":!f&&m.attr?d!=null:f==="="?e===g:f==="*="?e.indexOf(g)>=0:f==="~="?(" "+e+" ").indexOf(g)>=0:g?f==="!="?e!==g:f==="^="?e.indexOf(g)===0:f==="$="?e.substr(e.length-g.length)===g:f==="|="?e===g||e.substr(0,g.length+1)===g+"-":!1:e&&d!==!1},POS:function(a,b,c,d){var e=b[2],f=o.setFilters[e];if(f)return f(a,c,b,d)}}},p=o.match.POS,q=function(a,b){return"\\"+(b-0+1)};for(var r in o.match)o.match[r]=new RegExp(o.match[r].source+/(?![^\[]*\])(?![^\(]*\))/.source),o.leftMatch[r]=new RegExp(/(^(?:.|\r|\n)*?)/.source+o.match[r].source.replace(/\\(\d+)/g,q));o.match.globalPOS=p;var s=function(a,b){a=Array.prototype.slice.call(a,0);if(b){b.push.apply(b,a);return b}return a};try{Array.prototype.slice.call(c.documentElement.childNodes,0)[0].nodeType}catch(t){s=function(a,b){var c=0,d=b||[];if(g.call(a)==="[object Array]")Array.prototype.push.apply(d,a);else if(typeof a.length=="number")for(var e=a.length;c",e.insertBefore(a,e.firstChild),c.getElementById(d)&&(o.find.ID=function(a,c,d){if(typeof c.getElementById!="undefined"&&!d){var e=c.getElementById(a[1]);return e?e.id===a[1]||typeof e.getAttributeNode!="undefined"&&e.getAttributeNode("id").nodeValue===a[1]?[e]:b:[]}},o.filter.ID=function(a,b){var c=typeof a.getAttributeNode!="undefined"&&a.getAttributeNode("id");return a.nodeType===1&&c&&c.nodeValue===b}),e.removeChild(a),e=a=null}(),function(){var a=c.createElement("div");a.appendChild(c.createComment("")),a.getElementsByTagName("*").length>0&&(o.find.TAG=function(a,b){var c=b.getElementsByTagName(a[1]);if(a[1]==="*"){var d=[];for(var e=0;c[e];e++)c[e].nodeType===1&&d.push(c[e]);c=d}return c}),a.innerHTML="",a.firstChild&&typeof a.firstChild.getAttribute!="undefined"&&a.firstChild.getAttribute("href")!=="#"&&(o.attrHandle.href=function(a){return a.getAttribute("href",2)}),a=null}(),c.querySelectorAll&&function(){var a=m,b=c.createElement("div"),d="__sizzle__";b.innerHTML="

    ";if(!b.querySelectorAll||b.querySelectorAll(".TEST").length!==0){m=function(b,e,f,g){e=e||c;if(!g&&!m.isXML(e)){var h=/^(\w+$)|^\.([\w\-]+$)|^#([\w\-]+$)/.exec(b);if(h&&(e.nodeType===1||e.nodeType===9)){if(h[1])return s(e.getElementsByTagName(b),f);if(h[2]&&o.find.CLASS&&e.getElementsByClassName)return s(e.getElementsByClassName(h[2]),f)}if(e.nodeType===9){if(b==="body"&&e.body)return s([e.body],f);if(h&&h[3]){var i=e.getElementById(h[3]);if(!i||!i.parentNode)return s([],f);if(i.id===h[3])return s([i],f)}try{return s(e.querySelectorAll(b),f)}catch(j){}}else if(e.nodeType===1&&e.nodeName.toLowerCase()!=="object"){var k=e,l=e.getAttribute("id"),n=l||d,p=e.parentNode,q=/^\s*[+~]/.test(b);l?n=n.replace(/'/g,"\\$&"):e.setAttribute("id",n),q&&p&&(e=e.parentNode);try{if(!q||p)return s(e.querySelectorAll("[id='"+n+"'] "+b),f)}catch(r){}finally{l||k.removeAttribute("id")}}}return a(b,e,f,g)};for(var e in a)m[e]=a[e];b=null}}(),function(){var a=c.documentElement,b=a.matchesSelector||a.mozMatchesSelector||a.webkitMatchesSelector||a.msMatchesSelector;if(b){var d=!b.call(c.createElement("div"),"div"),e=!1;try{b.call(c.documentElement,"[test!='']:sizzle")}catch(f){e=!0}m.matchesSelector=function(a,c){c=c.replace(/\=\s*([^'"\]]*)\s*\]/g,"='$1']");if(!m.isXML(a))try{if(e||!o.match.PSEUDO.test(c)&&!/!=/.test(c)){var f=b.call(a,c);if(f||!d||a.document&&a.document.nodeType!==11)return f}}catch(g){}return m(c,null,null,[a]).length>0}}}(),function(){var a=c.createElement("div");a.innerHTML="
    ";if(!!a.getElementsByClassName&&a.getElementsByClassName("e").length!==0){a.lastChild.className="e";if(a.getElementsByClassName("e").length===1)return;o.order.splice(1,0,"CLASS"),o.find.CLASS=function(a,b,c){if(typeof b.getElementsByClassName!="undefined"&&!c)return b.getElementsByClassName(a[1])},a=null}}(),c.documentElement.contains?m.contains=function(a,b){return a!==b&&(a.contains?a.contains(b):!0)}:c.documentElement.compareDocumentPosition?m.contains=function(a,b){return!!(a.compareDocumentPosition(b)&16)}:m.contains=function(){return!1},m.isXML=function(a){var b=(a?a.ownerDocument||a:0).documentElement;return b?b.nodeName!=="HTML":!1};var y=function(a,b,c){var d,e=[],f="",g=b.nodeType?[b]:b;while(d=o.match.PSEUDO.exec(a))f+=d[0],a=a.replace(o.match.PSEUDO,"");a=o.relative[a]?a+"*":a;for(var h=0,i=g.length;h0)for(h=g;h=0:f.filter(a,this).length>0:this.filter(a).length>0)},closest:function(a,b){var c=[],d,e,g=this[0];if(f.isArray(a)){var h=1;while(g&&g.ownerDocument&&g!==b){for(d=0;d-1:f.find.matchesSelector(g,a)){c.push(g);break}g=g.parentNode;if(!g||!g.ownerDocument||g===b||g.nodeType===11)break}}c=c.length>1?f.unique(c):c;return this.pushStack(c,"closest",a)},index:function(a){if(!a)return this[0]&&this[0].parentNode?this.prevAll().length:-1;if(typeof a=="string")return f.inArray(this[0],f(a));return f.inArray(a.jquery?a[0]:a,this)},add:function(a,b){var c=typeof a=="string"?f(a,b):f.makeArray(a&&a.nodeType?[a]:a),d=f.merge(this.get(),c);return this.pushStack(S(c[0])||S(d[0])?d:f.unique(d))},andSelf:function(){return this.add(this.prevObject)}}),f.each({parent:function(a){var b=a.parentNode;return b&&b.nodeType!==11?b:null},parents:function(a){return f.dir(a,"parentNode")},parentsUntil:function(a,b,c){return f.dir(a,"parentNode",c)},next:function(a){return f.nth(a,2,"nextSibling")},prev:function(a){return f.nth(a,2,"previousSibling")},nextAll:function(a){return f.dir(a,"nextSibling")},prevAll:function(a){return f.dir(a,"previousSibling")},nextUntil:function(a,b,c){return f.dir(a,"nextSibling",c)},prevUntil:function(a,b,c){return f.dir(a,"previousSibling",c)},siblings:function(a){return f.sibling((a.parentNode||{}).firstChild,a)},children:function(a){return f.sibling(a.firstChild)},contents:function(a){return f.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:f.makeArray(a.childNodes)}},function(a,b){f.fn[a]=function(c,d){var e=f.map(this,b,c);L.test(a)||(d=c),d&&typeof d=="string"&&(e=f.filter(d,e)),e=this.length>1&&!R[a]?f.unique(e):e,(this.length>1||N.test(d))&&M.test(a)&&(e=e.reverse());return this.pushStack(e,a,P.call(arguments).join(","))}}),f.extend({filter:function(a,b,c){c&&(a=":not("+a+")");return b.length===1?f.find.matchesSelector(b[0],a)?[b[0]]:[]:f.find.matches(a,b)},dir:function(a,c,d){var e=[],g=a[c];while(g&&g.nodeType!==9&&(d===b||g.nodeType!==1||!f(g).is(d)))g.nodeType===1&&e.push(g),g=g[c];return e},nth:function(a,b,c,d){b=b||1;var e=0;for(;a;a=a[c])if(a.nodeType===1&&++e===b)break;return a},sibling:function(a,b){var c=[];for(;a;a=a.nextSibling)a.nodeType===1&&a!==b&&c.push(a);return c}});var V="abbr|article|aside|audio|bdi|canvas|data|datalist|details|figcaption|figure|footer|header|hgroup|mark|meter|nav|output|progress|section|summary|time|video",W=/ jQuery\d+="(?:\d+|null)"/g,X=/^\s+/,Y=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/ig,Z=/<([\w:]+)/,$=/]","i"),bd=/checked\s*(?:[^=]|=\s*.checked.)/i,be=/\/(java|ecma)script/i,bf=/^\s*",""],legend:[1,"
    ","
    "],thead:[1,"","
    "],tr:[2,"","
    "],td:[3,"","
    "],col:[2,"","
    "],area:[1,"",""],_default:[0,"",""]},bh=U(c);bg.optgroup=bg.option,bg.tbody=bg.tfoot=bg.colgroup=bg.caption=bg.thead,bg.th=bg.td,f.support.htmlSerialize||(bg._default=[1,"div
    ","
    "]),f.fn.extend({text:function(a){return f.access(this,function(a){return a===b?f.text(this):this.empty().append((this[0]&&this[0].ownerDocument||c).createTextNode(a))},null,a,arguments.length)},wrapAll:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapAll(a.call(this,b))});if(this[0]){var b=f(a,this[0].ownerDocument).eq(0).clone(!0);this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstChild&&a.firstChild.nodeType===1)a=a.firstChild;return a}).append(this)}return this},wrapInner:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapInner(a.call(this,b))});return this.each(function(){var b=f(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){var b=f.isFunction(a);return this.each(function(c){f(this).wrapAll(b?a.call(this,c):a)})},unwrap:function(){return this.parent().each(function(){f.nodeName(this,"body")||f(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.appendChild(a)})},prepend:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this)});if(arguments.length){var a=f -.clean(arguments);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this.nextSibling)});if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,f.clean(arguments));return a}},remove:function(a,b){for(var c=0,d;(d=this[c])!=null;c++)if(!a||f.filter(a,[d]).length)!b&&d.nodeType===1&&(f.cleanData(d.getElementsByTagName("*")),f.cleanData([d])),d.parentNode&&d.parentNode.removeChild(d);return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++){b.nodeType===1&&f.cleanData(b.getElementsByTagName("*"));while(b.firstChild)b.removeChild(b.firstChild)}return this},clone:function(a,b){a=a==null?!1:a,b=b==null?a:b;return this.map(function(){return f.clone(this,a,b)})},html:function(a){return f.access(this,function(a){var c=this[0]||{},d=0,e=this.length;if(a===b)return c.nodeType===1?c.innerHTML.replace(W,""):null;if(typeof a=="string"&&!ba.test(a)&&(f.support.leadingWhitespace||!X.test(a))&&!bg[(Z.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Y,"<$1>");try{for(;d1&&l0?this.clone(!0):this).get();f(e[h])[b](j),d=d.concat(j)}return this.pushStack(d,a,e.selector)}}),f.extend({clone:function(a,b,c){var d,e,g,h=f.support.html5Clone||f.isXMLDoc(a)||!bc.test("<"+a.nodeName+">")?a.cloneNode(!0):bo(a);if((!f.support.noCloneEvent||!f.support.noCloneChecked)&&(a.nodeType===1||a.nodeType===11)&&!f.isXMLDoc(a)){bk(a,h),d=bl(a),e=bl(h);for(g=0;d[g];++g)e[g]&&bk(d[g],e[g])}if(b){bj(a,h);if(c){d=bl(a),e=bl(h);for(g=0;d[g];++g)bj(d[g],e[g])}}d=e=null;return h},clean:function(a,b,d,e){var g,h,i,j=[];b=b||c,typeof b.createElement=="undefined"&&(b=b.ownerDocument||b[0]&&b[0].ownerDocument||c);for(var k=0,l;(l=a[k])!=null;k++){typeof l=="number"&&(l+="");if(!l)continue;if(typeof l=="string")if(!_.test(l))l=b.createTextNode(l);else{l=l.replace(Y,"<$1>");var m=(Z.exec(l)||["",""])[1].toLowerCase(),n=bg[m]||bg._default,o=n[0],p=b.createElement("div"),q=bh.childNodes,r;b===c?bh.appendChild(p):U(b).appendChild(p),p.innerHTML=n[1]+l+n[2];while(o--)p=p.lastChild;if(!f.support.tbody){var s=$.test(l),t=m==="table"&&!s?p.firstChild&&p.firstChild.childNodes:n[1]===""&&!s?p.childNodes:[];for(i=t.length-1;i>=0;--i)f.nodeName(t[i],"tbody")&&!t[i].childNodes.length&&t[i].parentNode.removeChild(t[i])}!f.support.leadingWhitespace&&X.test(l)&&p.insertBefore(b.createTextNode(X.exec(l)[0]),p.firstChild),l=p.childNodes,p&&(p.parentNode.removeChild(p),q.length>0&&(r=q[q.length-1],r&&r.parentNode&&r.parentNode.removeChild(r)))}var u;if(!f.support.appendChecked)if(l[0]&&typeof (u=l.length)=="number")for(i=0;i1)},f.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=by(a,"opacity");return c===""?"1":c}return a.style.opacity}}},cssNumber:{fillOpacity:!0,fontWeight:!0,lineHeight:!0,opacity:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":f.support.cssFloat?"cssFloat":"styleFloat"},style:function(a,c,d,e){if(!!a&&a.nodeType!==3&&a.nodeType!==8&&!!a.style){var g,h,i=f.camelCase(c),j=a.style,k=f.cssHooks[i];c=f.cssProps[i]||i;if(d===b){if(k&&"get"in k&&(g=k.get(a,!1,e))!==b)return g;return j[c]}h=typeof d,h==="string"&&(g=bu.exec(d))&&(d=+(g[1]+1)*+g[2]+parseFloat(f.css(a,c)),h="number");if(d==null||h==="number"&&isNaN(d))return;h==="number"&&!f.cssNumber[i]&&(d+="px");if(!k||!("set"in k)||(d=k.set(a,d))!==b)try{j[c]=d}catch(l){}}},css:function(a,c,d){var e,g;c=f.camelCase(c),g=f.cssHooks[c],c=f.cssProps[c]||c,c==="cssFloat"&&(c="float");if(g&&"get"in g&&(e=g.get(a,!0,d))!==b)return e;if(by)return by(a,c)},swap:function(a,b,c){var d={},e,f;for(f in b)d[f]=a.style[f],a.style[f]=b[f];e=c.call(a);for(f in b)a.style[f]=d[f];return e}}),f.curCSS=f.css,c.defaultView&&c.defaultView.getComputedStyle&&(bz=function(a,b){var c,d,e,g,h=a.style;b=b.replace(br,"-$1").toLowerCase(),(d=a.ownerDocument.defaultView)&&(e=d.getComputedStyle(a,null))&&(c=e.getPropertyValue(b),c===""&&!f.contains(a.ownerDocument.documentElement,a)&&(c=f.style(a,b))),!f.support.pixelMargin&&e&&bv.test(b)&&bt.test(c)&&(g=h.width,h.width=c,c=e.width,h.width=g);return c}),c.documentElement.currentStyle&&(bA=function(a,b){var c,d,e,f=a.currentStyle&&a.currentStyle[b],g=a.style;f==null&&g&&(e=g[b])&&(f=e),bt.test(f)&&(c=g.left,d=a.runtimeStyle&&a.runtimeStyle.left,d&&(a.runtimeStyle.left=a.currentStyle.left),g.left=b==="fontSize"?"1em":f,f=g.pixelLeft+"px",g.left=c,d&&(a.runtimeStyle.left=d));return f===""?"auto":f}),by=bz||bA,f.each(["height","width"],function(a,b){f.cssHooks[b]={get:function(a,c,d){if(c)return a.offsetWidth!==0?bB(a,b,d):f.swap(a,bw,function(){return bB(a,b,d)})},set:function(a,b){return bs.test(b)?b+"px":b}}}),f.support.opacity||(f.cssHooks.opacity={get:function(a,b){return bq.test((b&&a.currentStyle?a.currentStyle.filter:a.style.filter)||"")?parseFloat(RegExp.$1)/100+"":b?"1":""},set:function(a,b){var c=a.style,d=a.currentStyle,e=f.isNumeric(b)?"alpha(opacity="+b*100+")":"",g=d&&d.filter||c.filter||"";c.zoom=1;if(b>=1&&f.trim(g.replace(bp,""))===""){c.removeAttribute("filter");if(d&&!d.filter)return}c.filter=bp.test(g)?g.replace(bp,e):g+" "+e}}),f(function(){f.support.reliableMarginRight||(f.cssHooks.marginRight={get:function(a,b){return f.swap(a,{display:"inline-block"},function(){return b?by(a,"margin-right"):a.style.marginRight})}})}),f.expr&&f.expr.filters&&(f.expr.filters.hidden=function(a){var b=a.offsetWidth,c=a.offsetHeight;return b===0&&c===0||!f.support.reliableHiddenOffsets&&(a.style&&a.style.display||f.css(a,"display"))==="none"},f.expr.filters.visible=function(a){return!f.expr.filters.hidden(a)}),f.each({margin:"",padding:"",border:"Width"},function(a,b){f.cssHooks[a+b]={expand:function(c){var d,e=typeof c=="string"?c.split(" "):[c],f={};for(d=0;d<4;d++)f[a+bx[d]+b]=e[d]||e[d-2]||e[0];return f}}});var bC=/%20/g,bD=/\[\]$/,bE=/\r?\n/g,bF=/#.*$/,bG=/^(.*?):[ \t]*([^\r\n]*)\r?$/mg,bH=/^(?:color|date|datetime|datetime-local|email|hidden|month|number|password|range|search|tel|text|time|url|week)$/i,bI=/^(?:about|app|app\-storage|.+\-extension|file|res|widget):$/,bJ=/^(?:GET|HEAD)$/,bK=/^\/\//,bL=/\?/,bM=/)<[^<]*)*<\/script>/gi,bN=/^(?:select|textarea)/i,bO=/\s+/,bP=/([?&])_=[^&]*/,bQ=/^([\w\+\.\-]+:)(?:\/\/([^\/?#:]*)(?::(\d+))?)?/,bR=f.fn.load,bS={},bT={},bU,bV,bW=["*/"]+["*"];try{bU=e.href}catch(bX){bU=c.createElement("a"),bU.href="",bU=bU.href}bV=bQ.exec(bU.toLowerCase())||[],f.fn.extend({load:function(a,c,d){if(typeof a!="string"&&bR)return bR.apply(this,arguments);if(!this.length)return this;var e=a.indexOf(" ");if(e>=0){var g=a.slice(e,a.length);a=a.slice(0,e)}var h="GET";c&&(f.isFunction(c)?(d=c,c=b):typeof c=="object"&&(c=f.param(c,f.ajaxSettings.traditional),h="POST"));var i=this;f.ajax({url:a,type:h,dataType:"html",data:c,complete:function(a,b,c){c=a.responseText,a.isResolved()&&(a.done(function(a){c=a}),i.html(g?f("
    ").append(c.replace(bM,"")).find(g):c)),d&&i.each(d,[c,b,a])}});return this},serialize:function(){return f.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?f.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||bN.test(this.nodeName)||bH.test(this.type))}).map(function(a,b){var c=f(this).val();return c==null?null:f.isArray(c)?f.map(c,function(a,c){return{name:b.name,value:a.replace(bE,"\r\n")}}):{name:b.name,value:c.replace(bE,"\r\n")}}).get()}}),f.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "),function(a,b){f.fn[b]=function(a){return this.on(b,a)}}),f.each(["get","post"],function(a,c){f[c]=function(a,d,e,g){f.isFunction(d)&&(g=g||e,e=d,d=b);return f.ajax({type:c,url:a,data:d,success:e,dataType:g})}}),f.extend({getScript:function(a,c){return f.get(a,b,c,"script")},getJSON:function(a,b,c){return f.get(a,b,c,"json")},ajaxSetup:function(a,b){b?b$(a,f.ajaxSettings):(b=a,a=f.ajaxSettings),b$(a,b);return a},ajaxSettings:{url:bU,isLocal:bI.test(bV[1]),global:!0,type:"GET",contentType:"application/x-www-form-urlencoded; charset=UTF-8",processData:!0,async:!0,accepts:{xml:"application/xml, text/xml",html:"text/html",text:"text/plain",json:"application/json, text/javascript","*":bW},contents:{xml:/xml/,html:/html/,json:/json/},responseFields:{xml:"responseXML",text:"responseText"},converters:{"* text":a.String,"text html":!0,"text json":f.parseJSON,"text xml":f.parseXML},flatOptions:{context:!0,url:!0}},ajaxPrefilter:bY(bS),ajaxTransport:bY(bT),ajax:function(a,c){function w(a,c,l,m){if(s!==2){s=2,q&&clearTimeout(q),p=b,n=m||"",v.readyState=a>0?4:0;var o,r,u,w=c,x=l?ca(d,v,l):b,y,z;if(a>=200&&a<300||a===304){if(d.ifModified){if(y=v.getResponseHeader("Last-Modified"))f.lastModified[k]=y;if(z=v.getResponseHeader("Etag"))f.etag[k]=z}if(a===304)w="notmodified",o=!0;else try{r=cb(d,x),w="success",o=!0}catch(A){w="parsererror",u=A}}else{u=w;if(!w||a)w="error",a<0&&(a=0)}v.status=a,v.statusText=""+(c||w),o?h.resolveWith(e,[r,w,v]):h.rejectWith(e,[v,w,u]),v.statusCode(j),j=b,t&&g.trigger("ajax"+(o?"Success":"Error"),[v,d,o?r:u]),i.fireWith(e,[v,w]),t&&(g.trigger("ajaxComplete",[v,d]),--f.active||f.event.trigger("ajaxStop"))}}typeof a=="object"&&(c=a,a=b),c=c||{};var d=f.ajaxSetup({},c),e=d.context||d,g=e!==d&&(e.nodeType||e instanceof f)?f(e):f.event,h=f.Deferred(),i=f.Callbacks("once memory"),j=d.statusCode||{},k,l={},m={},n,o,p,q,r,s=0,t,u,v={readyState:0,setRequestHeader:function(a,b){if(!s){var c=a.toLowerCase();a=m[c]=m[c]||a,l[a]=b}return this},getAllResponseHeaders:function(){return s===2?n:null},getResponseHeader:function(a){var c;if(s===2){if(!o){o={};while(c=bG.exec(n))o[c[1].toLowerCase()]=c[2]}c=o[a.toLowerCase()]}return c===b?null:c},overrideMimeType:function(a){s||(d.mimeType=a);return this},abort:function(a){a=a||"abort",p&&p.abort(a),w(0,a);return this}};h.promise(v),v.success=v.done,v.error=v.fail,v.complete=i.add,v.statusCode=function(a){if(a){var b;if(s<2)for(b in a)j[b]=[j[b],a[b]];else b=a[v.status],v.then(b,b)}return this},d.url=((a||d.url)+"").replace(bF,"").replace(bK,bV[1]+"//"),d.dataTypes=f.trim(d.dataType||"*").toLowerCase().split(bO),d.crossDomain==null&&(r=bQ.exec(d.url.toLowerCase()),d.crossDomain=!(!r||r[1]==bV[1]&&r[2]==bV[2]&&(r[3]||(r[1]==="http:"?80:443))==(bV[3]||(bV[1]==="http:"?80:443)))),d.data&&d.processData&&typeof d.data!="string"&&(d.data=f.param(d.data,d.traditional)),bZ(bS,d,c,v);if(s===2)return!1;t=d.global,d.type=d.type.toUpperCase(),d.hasContent=!bJ.test(d.type),t&&f.active++===0&&f.event.trigger("ajaxStart");if(!d.hasContent){d.data&&(d.url+=(bL.test(d.url)?"&":"?")+d.data,delete d.data),k=d.url;if(d.cache===!1){var x=f.now(),y=d.url.replace(bP,"$1_="+x);d.url=y+(y===d.url?(bL.test(d.url)?"&":"?")+"_="+x:"")}}(d.data&&d.hasContent&&d.contentType!==!1||c.contentType)&&v.setRequestHeader("Content-Type",d.contentType),d.ifModified&&(k=k||d.url,f.lastModified[k]&&v.setRequestHeader("If-Modified-Since",f.lastModified[k]),f.etag[k]&&v.setRequestHeader("If-None-Match",f.etag[k])),v.setRequestHeader("Accept",d.dataTypes[0]&&d.accepts[d.dataTypes[0]]?d.accepts[d.dataTypes[0]]+(d.dataTypes[0]!=="*"?", "+bW+"; q=0.01":""):d.accepts["*"]);for(u in d.headers)v.setRequestHeader(u,d.headers[u]);if(d.beforeSend&&(d.beforeSend.call(e,v,d)===!1||s===2)){v.abort();return!1}for(u in{success:1,error:1,complete:1})v[u](d[u]);p=bZ(bT,d,c,v);if(!p)w(-1,"No Transport");else{v.readyState=1,t&&g.trigger("ajaxSend",[v,d]),d.async&&d.timeout>0&&(q=setTimeout(function(){v.abort("timeout")},d.timeout));try{s=1,p.send(l,w)}catch(z){if(s<2)w(-1,z);else throw z}}return v},param:function(a,c){var d=[],e=function(a,b){b=f.isFunction(b)?b():b,d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(b)};c===b&&(c=f.ajaxSettings.traditional);if(f.isArray(a)||a.jquery&&!f.isPlainObject(a))f.each(a,function(){e(this.name,this.value)});else for(var g in a)b_(g,a[g],c,e);return d.join("&").replace(bC,"+")}}),f.extend({active:0,lastModified:{},etag:{}});var cc=f.now(),cd=/(\=)\?(&|$)|\?\?/i;f.ajaxSetup({jsonp:"callback",jsonpCallback:function(){return f.expando+"_"+cc++}}),f.ajaxPrefilter("json jsonp",function(b,c,d){var e=typeof b.data=="string"&&/^application\/x\-www\-form\-urlencoded/.test(b.contentType);if(b.dataTypes[0]==="jsonp"||b.jsonp!==!1&&(cd.test(b.url)||e&&cd.test(b.data))){var g,h=b.jsonpCallback=f.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,i=a[h],j=b.url,k=b.data,l="$1"+h+"$2";b.jsonp!==!1&&(j=j.replace(cd,l),b.url===j&&(e&&(k=k.replace(cd,l)),b.data===k&&(j+=(/\?/.test(j)?"&":"?")+b.jsonp+"="+h))),b.url=j,b.data=k,a[h]=function(a){g=[a]},d.always(function(){a[h]=i,g&&f.isFunction(i)&&a[h](g[0])}),b.converters["script json"]=function(){g||f.error(h+" was not called");return g[0]},b.dataTypes[0]="json";return"script"}}),f.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/javascript|ecmascript/},converters:{"text script":function(a){f.globalEval(a);return a}}}),f.ajaxPrefilter("script",function(a){a.cache===b&&(a.cache=!1),a.crossDomain&&(a.type="GET",a.global=!1)}),f.ajaxTransport("script",function(a){if(a.crossDomain){var d,e=c.head||c.getElementsByTagName("head")[0]||c.documentElement;return{send:function(f,g){d=c.createElement("script"),d.async="async",a.scriptCharset&&(d.charset=a.scriptCharset),d.src=a.url,d.onload=d.onreadystatechange=function(a,c){if(c||!d.readyState||/loaded|complete/.test(d.readyState))d.onload=d.onreadystatechange=null,e&&d.parentNode&&e.removeChild(d),d=b,c||g(200,"success")},e.insertBefore(d,e.firstChild)},abort:function(){d&&d.onload(0,1)}}}});var ce=a.ActiveXObject?function(){for(var a in cg)cg[a](0,1)}:!1,cf=0,cg;f.ajaxSettings.xhr=a.ActiveXObject?function(){return!this.isLocal&&ch()||ci()}:ch,function(a){f.extend(f.support,{ajax:!!a,cors:!!a&&"withCredentials"in a})}(f.ajaxSettings.xhr()),f.support.ajax&&f.ajaxTransport(function(c){if(!c.crossDomain||f.support.cors){var d;return{send:function(e,g){var h=c.xhr(),i,j;c.username?h.open(c.type,c.url,c.async,c.username,c.password):h.open(c.type,c.url,c.async);if(c.xhrFields)for(j in c.xhrFields)h[j]=c.xhrFields[j];c.mimeType&&h.overrideMimeType&&h.overrideMimeType(c.mimeType),!c.crossDomain&&!e["X-Requested-With"]&&(e["X-Requested-With"]="XMLHttpRequest");try{for(j in e)h.setRequestHeader(j,e[j])}catch(k){}h.send(c.hasContent&&c.data||null),d=function(a,e){var j,k,l,m,n;try{if(d&&(e||h.readyState===4)){d=b,i&&(h.onreadystatechange=f.noop,ce&&delete cg[i]);if(e)h.readyState!==4&&h.abort();else{j=h.status,l=h.getAllResponseHeaders(),m={},n=h.responseXML,n&&n.documentElement&&(m.xml=n);try{m.text=h.responseText}catch(a){}try{k=h.statusText}catch(o){k=""}!j&&c.isLocal&&!c.crossDomain?j=m.text?200:404:j===1223&&(j=204)}}}catch(p){e||g(-1,p)}m&&g(j,k,m,l)},!c.async||h.readyState===4?d():(i=++cf,ce&&(cg||(cg={},f(a).unload(ce)),cg[i]=d),h.onreadystatechange=d)},abort:function(){d&&d(0,1)}}}});var cj={},ck,cl,cm=/^(?:toggle|show|hide)$/,cn=/^([+\-]=)?([\d+.\-]+)([a-z%]*)$/i,co,cp=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]],cq;f.fn.extend({show:function(a,b,c){var d,e;if(a||a===0)return this.animate(ct("show",3),a,b,c);for(var g=0,h=this.length;g=i.duration+this.startTime){this.now=this.end,this.pos=this.state=1,this.update(),i.animatedProperties[this.prop]=!0;for(b in i.animatedProperties)i.animatedProperties[b]!==!0&&(g=!1);if(g){i.overflow!=null&&!f.support.shrinkWrapBlocks&&f.each(["","X","Y"],function(a,b){h.style["overflow"+b]=i.overflow[a]}),i.hide&&f(h).hide();if(i.hide||i.show)for(b in i.animatedProperties)f.style(h,b,i.orig[b]),f.removeData(h,"fxshow"+b,!0),f.removeData(h,"toggle"+b,!0);d=i.complete,d&&(i.complete=!1,d.call(h))}return!1}i.duration==Infinity?this.now=e:(c=e-this.startTime,this.state=c/i.duration,this.pos=f.easing[i.animatedProperties[this.prop]](this.state,c,0,1,i.duration),this.now=this.start+(this.end-this.start)*this.pos),this.update();return!0}},f.extend(f.fx,{tick:function(){var a,b=f.timers,c=0;for(;c-1,k={},l={},m,n;j?(l=e.position(),m=l.top,n=l.left):(m=parseFloat(h)||0,n=parseFloat(i)||0),f.isFunction(b)&&(b=b.call(a,c,g)),b.top!=null&&(k.top=b.top-g.top+m),b.left!=null&&(k.left=b.left-g.left+n),"using"in b?b.using.call(a,k):e.css(k)}},f.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),c=this.offset(),d=cx.test(b[0].nodeName)?{top:0,left:0}:b.offset();c.top-=parseFloat(f.css(a,"marginTop"))||0,c.left-=parseFloat(f.css(a,"marginLeft"))||0,d.top+=parseFloat(f.css(b[0],"borderTopWidth"))||0,d.left+=parseFloat(f.css(b[0],"borderLeftWidth"))||0;return{top:c.top-d.top,left:c.left-d.left}},offsetParent:function(){return this.map(function(){var a=this.offsetParent||c.body;while(a&&!cx.test(a.nodeName)&&f.css(a,"position")==="static")a=a.offsetParent;return a})}}),f.each({scrollLeft:"pageXOffset",scrollTop:"pageYOffset"},function(a,c){var d=/Y/.test(c);f.fn[a]=function(e){return f.access(this,function(a,e,g){var h=cy(a);if(g===b)return h?c in h?h[c]:f.support.boxModel&&h.document.documentElement[e]||h.document.body[e]:a[e];h?h.scrollTo(d?f(h).scrollLeft():g,d?g:f(h).scrollTop()):a[e]=g},a,e,arguments.length,null)}}),f.each({Height:"height",Width:"width"},function(a,c){var d="client"+a,e="scroll"+a,g="offset"+a;f.fn["inner"+a]=function(){var a=this[0];return a?a.style?parseFloat(f.css(a,c,"padding")):this[c]():null},f.fn["outer"+a]=function(a){var b=this[0];return b?b.style?parseFloat(f.css(b,c,a?"margin":"border")):this[c]():null},f.fn[c]=function(a){return f.access(this,function(a,c,h){var i,j,k,l;if(f.isWindow(a)){i=a.document,j=i.documentElement[d];return f.support.boxModel&&j||i.body&&i.body[d]||j}if(a.nodeType===9){i=a.documentElement;if(i[d]>=i[e])return i[d];return Math.max(a.body[e],i[e],a.body[g],i[g])}if(h===b){k=f.css(a,c),l=parseFloat(k);return f.isNumeric(l)?l:k}f(a).css(c,h)},c,a,arguments.length,null)}}),a.jQuery=a.$=f,typeof define=="function"&&define.amd&&define.amd.jQuery&&define("jquery",[],function(){return f})})(window); \ No newline at end of file diff --git a/web/sugarcane/static/script.js b/web/sugarcane/static/script.js deleted file mode 100644 index be16ad931a3..00000000000 --- a/web/sugarcane/static/script.js +++ /dev/null @@ -1,10 +0,0 @@ -$(document).ready(function () { - $('#myTab a:first').tab('show'); - - $('a').click(function (e) { - e.preventDefault(); - $(this).tab('show'); - this.blur(); - }); - -}); diff --git a/web/sugarcane/static/style.css b/web/sugarcane/static/style.css deleted file mode 100644 index ce0b728e615..00000000000 --- a/web/sugarcane/static/style.css +++ /dev/null @@ -1,48 +0,0 @@ -html { - overflow-y: scroll; -} -.buttons{ - margin-top:23px; - text-align:center; -} -.buttons button{ - margin-top:8px; - width:90%; -} -.fixed{ - position:fixed; -} -#zcontainer{ - padding-top:25px; - margin-left:35px; - width:940px; -} -#zcontainer .contain-left{ - width:940px; - display:block; - float:left; -} -.contain-left .tab-content{ - margin-left:180px; -} -#graph_box{ -} -.loading{ - margin:25px; -} -#map_control{ - width:155px; - float:right; -} -#map_canvas{ - width:600px; - height:600px; - float:left; -} -#select_area_btn{ - width:140px; - height:50px; -} -#infobox1{ - text-align:right; -} diff --git a/web/sugarcane/sugarcane.R b/web/sugarcane/sugarcane.R deleted file mode 100755 index d77215da3a3..00000000000 --- a/web/sugarcane/sugarcane.R +++ /dev/null @@ -1,206 +0,0 @@ -library(BioCro) -library(XML) -#############Reading from the fXML file generated via web-interface###### -settings.xml <- XML::xmlParse('./config.xml') -settings <- XML::xmlToList(settings.xml) - -################ Read Year and Location Details and derive model input############ -lat<-as.numeric(settings$location$latitude) -lon<-as.numeric(settings$location$longitude) -dateofplanting<-settings$simulationPeriod$dateofplanting -dateofharvest<-settings$simulationPeriod$dateofharvest -year1<-as.numeric(substr(dateofplanting,7,10)) -date1<-as.numeric(substr(dateofplanting,4,5)) -month1<-as.numeric(substr(dateofplanting,1,2)) -year2<-as.numeric(substr(dateofharvest,7,10)) -date2<-as.numeric(substr(dateofharvest,4,5)) -month2<-as.numeric(substr(dateofharvest,1,2)) - -dummydate<-as.Date(c(paste(year1,"-1","-1",sep=""),paste(year1,"-",month1,"-",date1,sep=""),paste(year2,"-",month2,"-",date2,sep=""))) -day1<-as.numeric(dummydate[2]-dummydate[1]) -dayn<-as.numeric(dummydate[3]-dummydate[1]) - -#####Getting Phenology Parameters ####################################### - - -pheno<-settings$pft$phenoParms -pp<-phenoParms() -pp[names(pheno)]<-as.numeric(pheno) - - -######Getting Nitrogen Parameters ####################################### -nitro<-settings$pft$nitroParms -nitroP<-nitroParms() -nitroP[names(nitro)]<-as.numeric(nitro) - -### Getting Photosynthesis Parameters #################################### -photo<-settings$pft$photoParms -photoP<-photoParms() -photoP[names(photo)]<-as.numeric(photo) - -### Getting Senescence Parameters ############################################### -sene<-settings$pft$seneParms -senP<-seneParms() -senP[names(sene)]<-as.numeric(sene) - -#### Getting Soil Parameters################################################## -soil<-settings$pft$soilParms -soilP<-soilParms() -soilP[names(soil)]<-as.numeric(soil) - -##### Getting Canopy Parameters ####################################### -canopy<-settings$pft$canopyParms -canopyP40<-canopyParms() -## canopyP40[names(canopy)]<-as.numeric(canopy) # Error message Error: (list) object cannot be coerced to type 'double' -# read individual elements -canopyP40$Sp<-as.numeric(canopy$Sp) -canopyP40$SpD<-as.numeric(canopy$SpD) -canopyP40$nlayers<-as.numeric(canopy$nlayers) -canopyP40$chi.l<-as.numeric(canopy$chi.l) -canopyP40$heightFactor<-as.numeric(canopy$heightFactor) - -# Reading sugar phenology -sugarpheno<-settings$pft$SugarPhenoParms -ppP50<-SugarPhenoParms() -ppP50[names(sugarpheno)]<-as.numeric(sugarpheno) - -##Here we are extracting weather data from NCEP and preparing for model ####### - -#Declare a function -library(RNCEP) - InputForWeach<-function (lat,lon,year1,year2){ - - # Get Temperature Records - avgTemp<-NCEP.gather(variable=c('air.2m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - avgTemp<-NCEP.aggregate(avgTemp,HOURS=FALSE,fxn='mean') # Average Flux for the whole day - avgTemp<-NCEP.array2df(avgTemp,var.name='avgTemp') - avgTemp<-aggregate(avgTemp~datetime,data=avgTemp,mean) # mean of all nearby spatial locations - avgTemp$datetime<-substr(avgTemp$datetime,1,10) - avgTemp$avgTemp<-avgTemp$avgTemp-273 - - # Get Solar Radiation Records - solarR<-NCEP.gather(variable=c('dswrf.sfc'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - solarR<-NCEP.aggregate(solarR,HOURS=FALSE,fxn='mean') # Average Flux for the whole day - solarR<-NCEP.array2df(solarR,var.name='solarR') - solarR$solarR<- solarR$solarR*24*60*60*1e-6 # To convert Wt/m2 to MJ/m2 - solarR<-aggregate(solarR~datetime,data=solarR,mean) # mean of all nearby spatial locations - solarR$datetime<-substr(solarR$datetime,1,10) - - ## T Maximum Data - Tmax<-NCEP.gather(variable=c('tmax.2m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Tmax<-NCEP.aggregate(Tmax,HOURS=FALSE,fxn='max') - Tmax<-NCEP.array2df(Tmax,var.name='Tmax') - Tmax<-aggregate(Tmax~datetime,data=Tmax,max) - Tmax$datetime<-substr(Tmax$datetime,1,10) - Tmax$Tmax<-Tmax$Tmax-273 - - - ## T Minimum Data - Tmin<-NCEP.gather(variable=c('tmin.2m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Tmin<-NCEP.aggregate(Tmin,HOURS=FALSE,fxn='max') - Tmin<-NCEP.array2df(Tmin,var.name='Tmin') - Tmin<-aggregate(Tmin~datetime,data=Tmin,max) - Tmin$datetime<-substr(Tmin$datetime,1,10) - Tmin$Tmin<-Tmin$Tmin-273 - - ## Relative Humidity (I am using surface level, not Grid level to get rlative humidity, not absolute humidity, hope its not a problem. - RH<-NCEP.gather(variable=c('rhum.sig995'), level='surface', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE,return.units = FALSE, status.bar=FALSE) - - # Warnign Message, not available in Reanalysis 2, Instead using Reanalysis 1. - - RHavg<-NCEP.aggregate(RH,HOURS=FALSE,fxn='mean') - RHmax<-NCEP.aggregate(RH,HOURS=FALSE,fxn='max') - RHmin<-NCEP.aggregate(RH,HOURS=FALSE,fxn='min') - RHavg<-NCEP.array2df(RHavg,var.name='RH') - RHmax<-NCEP.array2df(RHmax,var.name='RH') - RHmin<-NCEP.array2df(RHmin,var.name='RH') - - RHavg<-aggregate(RH~datetime,data=RHavg,mean) - RHmax<-aggregate(RH~datetime,data=RHmax,max) - RHmin<-aggregate(RH~datetime,data=RHmin,min) - RHavg$datetime<-substr(RHavg$datetime,1,10) - RHmax$datetime<-substr(RHmax$datetime,1,10) - RHmin$datetime<-substr(RHmin$datetime,1,10) - RHavg$RH<-RHavg$RH*0.01 ## Percent to Fraction - RHmax$RH<-RHmax$RH*0.01 ## Percent to Fraction - RHmin$RH<-RHmin$RH*0.01 ## Percent to Fraction - - - ## WInD SPEED - - Vwind<-NCEP.gather(variable=c('vwnd.10m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Vwind<-NCEP.aggregate(Vwind,HOURS=FALSE,fxn='mean') - Vwind<-NCEP.array2df(Vwind,var.name='Vwind') - Vwind<-aggregate(Vwind~datetime,data=Vwind,mean) - Vwind$datetime<-substr(Vwind$datetime,1,10) - - Uwind<-NCEP.gather(variable=c('uwnd.10m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Uwind<-NCEP.aggregate(Uwind,HOURS=FALSE,fxn='mean') - Uwind<-NCEP.array2df(Uwind,var.name='Uwind') - Uwind<-aggregate(Uwind~datetime,data=Uwind,mean) - Uwind$datetime<-substr(Uwind$datetime,1,10) - - Uwind$Uwind<-sqrt(Uwind$Uwind^2+Vwind$Vwind^2) - Uwind$Uwind<-Uwind$Uwind*4.87/log(67.8*10-5.42) # converting Windspeed from 10m to 2 m height using correlation provided by FAO (http://www.fao.org/docrep/X0490E/x0490e07.htm) - - Uwind$Uwind<-Uwind$Uwind*(3600)/(1609) # unit conversion from m/s to miles per hr - - - ## Precipitation - - Rain<-NCEP.gather(variable=c('prate.sfc'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Rain<-NCEP.aggregate(Rain,HOURS=FALSE,fxn='mean') - Rain<-NCEP.array2df(Rain,var.name='Rain') - Rain<-aggregate(Rain~datetime,data=Rain,mean) - Rain$datetime<-substr(Rain$datetime,1,10) - Rain$Rain<-Rain$Rain*(24*60*60)*(1/1000)*39.37 # Converting from kg/m2 sec to kg/m2 to m3/m2 to inches - - day<-numeric(0) - year<-numeric(0) -for (i in year1:year2) - { - if(lubridate::leap_year(i)) - { - indx<-as.integer(length(day)) - day[as.integer(indx+1):as.integer(indx+366)]=seq(1:366) - year[as.integer(indx+1):as.integer(indx+366)]=rep(i,366) - } else { - indx<-as.integer(length(day)) - day[as.integer(indx+1):as.integer(indx+365)]=seq(1:365) - year[as.integer(indx+1):as.integer(indx+365)]=rep(i,365) - } - } -result<-data.frame(year=year,day=day,solarR=solarR$solarR,Tmax=Tmax$Tmax, Tmin=Tmin$Tmin, Tavg=avgTemp$avgTemp, RHmax=RHmax$RH,RHmin=RHmin$RH, RHavg=RHavg$RH, WS=Uwind$Uwind,precip=Rain$Rain) - return(result) - } - -climdata<-InputForWeach(lat=lat,lon=lon,year1=year1,year2=year2) -wet<-weachNEW(climdata,lat=lat,ts=1, temp.units="Celsius", rh.units="fraction",ws.units="mph",pp.units="in") - - -res<- BioGro(wet,lat=lat,phenoControl=pp,canopyControl=canopyP40, soilControl=soilP,photoControl=photoP, seneControl=senP,sugarphenoControl=ppP50,nitroControl=nitroP,day1 = day1, dayn = dayn,iRhizome=4,irtl=1e-03) - -Date<-seq(dummydate[2],dummydate[3]+1,1) -DAP<-seq(0,length(Date)-1) -Leaf=res$Leaf -Stem=res$Stem -Root=res$Root -Sugar<-res$Sugar -LAI<-res$LAI -ThermalT<-res$dailyThermalT - -toprint<-data.frame(DAP=DAP,Leaf=Leaf,Stem=Stem,Root=Root,Sugar=Sugar,LAI=LAI,ThermalT=ThermalT) - -toprint<-round(toprint,digit=2) -write.table(toprint, file="./ooutput",append=FALSE,sep='\t') - - - - diff --git a/web/sugarcane/sugarcaneForBioCro.R b/web/sugarcane/sugarcaneForBioCro.R deleted file mode 100644 index 43dc5764c2d..00000000000 --- a/web/sugarcane/sugarcaneForBioCro.R +++ /dev/null @@ -1,201 +0,0 @@ -library(BioCro) -library(XML) -#############Reading from the fXML file generated via web-interface###### -settings.xml <- XML::xmlParse('./config.xml') -settings <- XML::xmlToList(settings.xml) - -################ Read Year and Location Details and derive model input############ -lat<-as.numeric(settings$location$latitude) -lon<-as.numeric(settings$location$longitude) -dateofplanting<-settings$simulationPeriod$dateofplanting -dateofharvest<-settings$simulationPeriod$dateofharvest -year1<-as.numeric(substr(dateofplanting,7,10)) -date1<-as.numeric(substr(dateofplanting,4,5)) -month1<-as.numeric(substr(dateofplanting,1,2)) -year2<-as.numeric(substr(dateofharvest,7,10)) -date2<-as.numeric(substr(dateofharvest,4,5)) -month2<-as.numeric(substr(dateofharvest,1,2)) - -dummydate<-as.Date(c(paste(year1,"-1","-1",sep=""),paste(year1,"-",month1,"-",date1,sep=""),paste(year2,"-",month2,"-",date2,sep=""))) -day1<-as.numeric(dummydate[2]-dummydate[1]) -dayn<-as.numeric(dummydate[3]-dummydate[1]) - -#####Getting Phenology Parameters ####################################### - - -pheno<-settings$pft$phenoParms -pp<-phenoParms() -pp[names(pheno)]<-as.numeric(pheno) - - -######Getting Nitrogen Parameters ####################################### -nitro<-settings$pft$nitroParms -nitroP<-nitroParms() -nitroP[names(nitro)]<-as.numeric(nitro) - -### Getting Photosynthesis Parameters #################################### -photo<-settings$pft$photoParms -photoP<-photoParms() -photoP[names(photo)]<-as.numeric(photo) - -### Getting Senescence Parameters ############################################### -sene<-settings$pft$seneParms -senP<-seneParms() -senP[names(sene)]<-as.numeric(sene) - -#### Getting Soil Parameters################################################## -soil<-settings$pft$soilParms -soilP<-soilParms() -soilP[names(soil)]<-as.numeric(soil) - -##### Getting Canopy Parameters ####################################### -canopy<-settings$pft$canopyParms -canopyP40<-canopyParms() -## canopyP40[names(canopy)]<-as.numeric(canopy) # Error message Error: (list) object cannot be coerced to type 'double' -# read individual elements -canopyP40$Sp<-as.numeric(canopy$Sp) -canopyP40$SpD<-as.numeric(canopy$SpD) -canopyP40$nlayers<-as.numeric(canopy$nlayers) -canopyP40$chi.l<-as.numeric(canopy$chi.l) -canopyP40$heightFactor<-as.numeric(canopy$heightFactor) - -# Reading sugar phenology -sugarpheno<-settings$pft$SugarPhenoParms -ppP50<-SugarPhenoParms() -ppP50[names(sugarpheno)]<-as.numeric(sugarpheno) - -##Here we are extracting weather data from NCEP and preparing for model ####### - -#Declare a function -library(RNCEP) - InputForWeach<-function (lat,lon,year1,year2){ - - # Get Temperature Records - avgTemp<-NCEP.gather(variable=c('air.2m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - avgTemp<-NCEP.aggregate(avgTemp,HOURS=FALSE,fxn='mean') # Average Flux for the whole day - avgTemp<-NCEP.array2df(avgTemp,var.name='avgTemp') - avgTemp<-aggregate(avgTemp~datetime,data=avgTemp,mean) # mean of all nearby spatial locations - avgTemp$datetime<-substr(avgTemp$datetime,1,10) - avgTemp$avgTemp<-avgTemp$avgTemp-273 - - # Get Solar Radiation Records - solarR<-NCEP.gather(variable=c('dswrf.sfc'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - solarR<-NCEP.aggregate(solarR,HOURS=FALSE,fxn='mean') # Average Flux for the whole day - solarR<-NCEP.array2df(solarR,var.name='solarR') - solarR$solarR<- solarR$solarR*24*60*60*1e-6 # To convert Wt/m2 to MJ/m2 - solarR<-aggregate(solarR~datetime,data=solarR,mean) # mean of all nearby spatial locations - solarR$datetime<-substr(solarR$datetime,1,10) - - ## T Maximum Data - Tmax<-NCEP.gather(variable=c('tmax.2m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Tmax<-NCEP.aggregate(Tmax,HOURS=FALSE,fxn='max') - Tmax<-NCEP.array2df(Tmax,var.name='Tmax') - Tmax<-aggregate(Tmax~datetime,data=Tmax,max) - Tmax$datetime<-substr(Tmax$datetime,1,10) - Tmax$Tmax<-Tmax$Tmax-273 - - - ## T Minimum Data - Tmin<-NCEP.gather(variable=c('tmin.2m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Tmin<-NCEP.aggregate(Tmin,HOURS=FALSE,fxn='max') - Tmin<-NCEP.array2df(Tmin,var.name='Tmin') - Tmin<-aggregate(Tmin~datetime,data=Tmin,max) - Tmin$datetime<-substr(Tmin$datetime,1,10) - Tmin$Tmin<-Tmin$Tmin-273 - - ## Relative Humidity (I am using surface level, not Grid level to get rlative humidity, not absolute humidity, hope its not a problem. - RH<-NCEP.gather(variable=c('rhum.sig995'), level='surface', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE,return.units = FALSE, status.bar=FALSE) - - # Warnign Message, not available in Reanalysis 2, Instead using Reanalysis 1. - - RHavg<-NCEP.aggregate(RH,HOURS=FALSE,fxn='mean') - RHmax<-NCEP.aggregate(RH,HOURS=FALSE,fxn='max') - RHmin<-NCEP.aggregate(RH,HOURS=FALSE,fxn='min') - RHavg<-NCEP.array2df(RHavg,var.name='RH') - RHmax<-NCEP.array2df(RHmax,var.name='RH') - RHmin<-NCEP.array2df(RHmin,var.name='RH') - - RHavg<-aggregate(RH~datetime,data=RHavg,mean) - RHmax<-aggregate(RH~datetime,data=RHmax,max) - RHmin<-aggregate(RH~datetime,data=RHmin,min) - RHavg$datetime<-substr(RHavg$datetime,1,10) - RHmax$datetime<-substr(RHmax$datetime,1,10) - RHmin$datetime<-substr(RHmin$datetime,1,10) - RHavg$RH<-RHavg$RH*0.01 ## Percent to Fraction - RHmax$RH<-RHmax$RH*0.01 ## Percent to Fraction - RHmin$RH<-RHmin$RH*0.01 ## Percent to Fraction - - - ## WInD SPEED - - Vwind<-NCEP.gather(variable=c('vwnd.10m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE - Vwind<-NCEP.aggregate(Vwind,HOURS=FALSE,fxn='mean') - Vwind<-NCEP.array2df(Vwind,var.name='Vwind') - Vwind<-aggregate(Vwind~datetime,data=Vwind,mean) - Vwind$datetime<-substr(Vwind$datetime,1,10) - - Uwind<-NCEP.gather(variable=c('uwnd.10m'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Uwind<-NCEP.aggregate(Uwind,HOURS=FALSE,fxn='mean') - Uwind<-NCEP.array2df(Uwind,var.name='Uwind') - Uwind<-aggregate(Uwind~datetime,data=Uwind,mean) - Uwind$datetime<-substr(Uwind$datetime,1,10) - - Uwind$Uwind<-sqrt(Uwind$Uwind^2+Vwind$Vwind^2) - Uwind$Uwind<-Uwind$Uwind*4.87/log(67.8*10-5.42) # converting Windspeed from 10m to 2 m height using correlation provided by FAO (http://www.fao.org/docrep/X0490E/x0490e07.htm) - - Uwind$Uwind<-Uwind$Uwind*(3600)/(1609) # unit conversion from m/s to miles per hr - - - ## Precipitation - - Rain<-NCEP.gather(variable=c('prate.sfc'), level='gaussian', months.minmax=c(1,12), years.minmax=c(year1,year2),lat.southnorth=c(lat,lat),lon.westeast=c(lon,lon), reanalysis2 = TRUE, - return.units = FALSE, status.bar=FALSE) - Rain<-NCEP.aggregate(Rain,HOURS=FALSE,fxn='mean') - Rain<-NCEP.array2df(Rain,var.name='Rain') - Rain<-aggregate(Rain~datetime,data=Rain,mean) - Rain$datetime<-substr(Rain$datetime,1,10) - Rain$Rain<-Rain$Rain*(24*60*60)*(1/1000)*39.37 # Converting from kg/m2 sec to kg/m2 to m3/m2 to inches - - day<-numeric(0) - year<-numeric(0) - -for (i in year1:year2) { - if(lubridate::leap_year(i)) { - indx<-as.integer(length(day)) - day[as.integer(indx+1):as.integer(indx+366)]=seq(1:366) - year[as.integer(indx+1):as.integer(indx+366)]=rep(i,366) - } else { - indx<-as.integer(length(day)) - day[as.integer(indx+1):as.integer(indx+365)]=seq(1:365) - year[as.integer(indx+1):as.integer(indx+365)]=rep(i,365) - } - } -result<-data.frame(year=year,day=day,solarR=solarR$solarR,Tmax=Tmax$Tmax, Tmin=Tmin$Tmin, Tavg=avgTemp$avgTemp, RHmax=RHmax$RH,RHmin=RHmin$RH, RHavg=RHavg$RH, WS=Uwind$Uwind,precip=Rain$Rain) - return(result) - } - -climdata<-InputForWeach(lat=lat,lon=lon,year1=year1,year2=year2) -wet<-weachNEW(climdata,lat=lat,ts=1, temp.units="Celsius", rh.units="fraction",ws.units="mph",pp.units="in") - - -res<- BioGro(wet,lat=lat,phenoControl=pp,canopyControl=canopyP40, soilControl=soilP,photoControl=photoP, seneControl=senP,sugarphenoControl=ppP50,nitroControl=nitroP,day1 = day1, dayn = dayn,iRhizome=4,irtl=1e-03) - -Date<-seq(dummydate[2],dummydate[3]+1,1) -DAP<-seq(0,length(Date)-1) -Leaf=res$Leaf -Stem=res$Stem -Root=res$Root -Sugar<-res$Sugar -LAI<-res$LAI -ThermalT<-res$dailyThermalT - -toprint<-data.frame(DAP=DAP,Leaf=Leaf,Stem=Stem,Root=Root,Sugar=Sugar,LAI=LAI,ThermalT=ThermalT) - -round(toprint,digit=2) -write.table(toprint, file="./ooutput",append=FALSE,sep='\t') diff --git a/web/workflow.R b/web/workflow.R index 02ba8acece9..317aef7faa7 100755 --- a/web/workflow.R +++ b/web/workflow.R @@ -2,7 +2,7 @@ #------------------------------------------------------------------------------- # Copyright (c) 2012 University of Illinois, NCSA. # All rights reserved. This program and the accompanying materials -# are made available under the terms of the +# are made available under the terms of the # University of Illinois/NCSA Open Source License # which accompanies this distribution, and is available at # http://opensource.ncsa.illinois.edu/license.html @@ -11,82 +11,85 @@ # ---------------------------------------------------------------------- # Load required libraries # ---------------------------------------------------------------------- -library(PEcAn.all) -library(PEcAn.utils) -library(RCurl) +library("PEcAn.all") +library("RCurl") + + +# -------------------------------------------------- +# get command-line arguments +args <- get_args() # make sure always to call status.end -options(warn=1) -options(error=quote({ - PEcAn.utils::status.end("ERROR") - PEcAn.remote::kill.tunnel(settings) +options(warn = 1) +options(error = quote({ + try(PEcAn.utils::status.end("ERROR")) + try(PEcAn.remote::kill.tunnel(settings)) if (!interactive()) { q(status = 1) } })) -#options(warning.expression=status.end("ERROR")) - - # ---------------------------------------------------------------------- # PEcAn Workflow # ---------------------------------------------------------------------- # Open and read in settings file for PEcAn run. -args <- commandArgs(trailingOnly = TRUE) -if (is.na(args[1])){ - settings <- PEcAn.settings::read.settings("pecan.xml") -} else { - settings.file <- args[1] - settings <- PEcAn.settings::read.settings(settings.file) -} +settings <- PEcAn.settings::read.settings(args$settings) # Check for additional modules that will require adding settings -if("benchmarking" %in% names(settings)){ +if ("benchmarking" %in% names(settings)) { library(PEcAn.benchmark) settings <- papply(settings, read_settings_BRR) } -if("sitegroup" %in% names(settings)){ - if(is.null(settings$sitegroup$nSite)){ - settings <- PEcAn.settings::createSitegroupMultiSettings(settings, - sitegroupId = settings$sitegroup$id) +if ("sitegroup" %in% names(settings)) { + if (is.null(settings$sitegroup$nSite)) { + settings <- PEcAn.settings::createSitegroupMultiSettings(settings, + sitegroupId = settings$sitegroup$id + ) } else { - settings <- PEcAn.settings::createSitegroupMultiSettings(settings, - sitegroupId = settings$sitegroup$id, - nSite = settings$sitegroup$nSite) + settings <- PEcAn.settings::createSitegroupMultiSettings( + settings, + sitegroupId = settings$sitegroup$id, + nSite = settings$sitegroup$nSite + ) } - settings$sitegroup <- NULL ## zero out so don't expand a second time if re-reading + # zero out so don't expand a second time if re-reading + settings$sitegroup <- NULL } -# Update/fix/check settings. Will only run the first time it's called, unless force=TRUE -settings <- PEcAn.settings::prepare.settings(settings, force = FALSE) +# Update/fix/check settings. +# Will only run the first time it's called, unless force=TRUE +settings <- + PEcAn.settings::prepare.settings(settings, force = FALSE) # Write pecan.CHECKED.xml PEcAn.settings::write.settings(settings, outputfile = "pecan.CHECKED.xml") # start from scratch if no continue is passed in -statusFile <- file.path(settings$outdir, "STATUS") -if (length(which(commandArgs() == "--continue")) == 0 && file.exists(statusFile)) { - file.remove(statusFile) +status_file <- file.path(settings$outdir, "STATUS") +if (args$continue && file.exists(status_file)) { + file.remove(status_file) } # Do conversions settings <- PEcAn.workflow::do_conversions(settings) # Query the trait database for data and priors -if (PEcAn.utils::status.check("TRAIT") == 0){ +if (PEcAn.utils::status.check("TRAIT") == 0) { PEcAn.utils::status.start("TRAIT") settings <- PEcAn.workflow::runModule.get.trait.data(settings) - PEcAn.settings::write.settings(settings, outputfile='pecan.TRAIT.xml') + PEcAn.settings::write.settings(settings, + outputfile = "pecan.TRAIT.xml" + ) PEcAn.utils::status.end() -} else if (file.exists(file.path(settings$outdir, 'pecan.TRAIT.xml'))) { - settings <- PEcAn.settings::read.settings(file.path(settings$outdir, 'pecan.TRAIT.xml')) +} else if (file.exists(file.path(settings$outdir, "pecan.TRAIT.xml"))) { + settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.TRAIT.xml")) } # Run the PEcAn meta.analysis -if(!is.null(settings$meta.analysis)) { - if (PEcAn.utils::status.check("META") == 0){ +if (!is.null(settings$meta.analysis)) { + if (PEcAn.utils::status.check("META") == 0) { PEcAn.utils::status.start("META") PEcAn.MA::runModule.run.meta.analysis(settings) PEcAn.utils::status.end() @@ -94,24 +97,37 @@ if(!is.null(settings$meta.analysis)) { } # Write model specific configs -if (PEcAn.utils::status.check("CONFIG") == 0){ +if (PEcAn.utils::status.check("CONFIG") == 0) { PEcAn.utils::status.start("CONFIG") - settings <- PEcAn.workflow::runModule.run.write.configs(settings) - PEcAn.settings::write.settings(settings, outputfile='pecan.CONFIGS.xml') + settings <- + PEcAn.workflow::runModule.run.write.configs(settings) + PEcAn.settings::write.settings(settings, outputfile = "pecan.CONFIGS.xml") PEcAn.utils::status.end() -} else if (file.exists(file.path(settings$outdir, 'pecan.CONFIGS.xml'))) { - settings <- PEcAn.settings::read.settings(file.path(settings$outdir, 'pecan.CONFIGS.xml')) +} else if (file.exists(file.path(settings$outdir, "pecan.CONFIGS.xml"))) { + settings <- PEcAn.settings::read.settings(file.path(settings$outdir, "pecan.CONFIGS.xml")) } -if ((length(which(commandArgs() == "--advanced")) != 0) && (PEcAn.utils::status.check("ADVANCED") == 0)) { +if ((length(which(commandArgs() == "--advanced")) != 0) +&& (PEcAn.utils::status.check("ADVANCED") == 0)) { PEcAn.utils::status.start("ADVANCED") - q(); + q() } # Start ecosystem model runs if (PEcAn.utils::status.check("MODEL") == 0) { PEcAn.utils::status.start("MODEL") - PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = FALSE) + stop_on_error <- as.logical(settings[[c("run", "stop_on_error")]]) + if (length(stop_on_error) == 0) { + # If we're doing an ensemble run, don't stop. If only a single run, we + # should be stopping. + if (is.null(settings[["ensemble"]]) || + as.numeric(settings[[c("ensemble", "size")]]) == 1) { + stop_on_error <- TRUE + } else { + stop_on_error <- FALSE + } + } + PEcAn.remote::runModule.start.model.runs(settings, stop.on.error = stop_on_error) PEcAn.utils::status.end() } @@ -122,31 +138,34 @@ if (PEcAn.utils::status.check("OUTPUT") == 0) { PEcAn.utils::status.end() } -# Run ensemble analysis on model output. -if ('ensemble' %in% names(settings) & PEcAn.utils::status.check("ENSEMBLE") == 0) { +# Run ensemble analysis on model output. +if ("ensemble" %in% names(settings) +&& PEcAn.utils::status.check("ENSEMBLE") == 0) { PEcAn.utils::status.start("ENSEMBLE") - runModule.run.ensemble.analysis(settings, TRUE) + runModule.run.ensemble.analysis(settings, TRUE) PEcAn.utils::status.end() } # Run sensitivity analysis and variance decomposition on model output -if ('sensitivity.analysis' %in% names(settings) & PEcAn.utils::status.check("SENSITIVITY") == 0) { +if ("sensitivity.analysis" %in% names(settings) +&& PEcAn.utils::status.check("SENSITIVITY") == 0) { PEcAn.utils::status.start("SENSITIVITY") runModule.run.sensitivity.analysis(settings) PEcAn.utils::status.end() } # Run parameter data assimilation -if ('assim.batch' %in% names(settings)) { +if ("assim.batch" %in% names(settings)) { if (PEcAn.utils::status.check("PDA") == 0) { PEcAn.utils::status.start("PDA") - settings <- PEcAn.assim.batch::runModule.assim.batch(settings) + settings <- + PEcAn.assim.batch::runModule.assim.batch(settings) PEcAn.utils::status.end() } } # Run state data assimilation -if ('state.data.assimilation' %in% names(settings)) { +if ("state.data.assimilation" %in% names(settings)) { if (PEcAn.utils::status.check("SDA") == 0) { PEcAn.utils::status.start("SDA") settings <- sda.enfk(settings) @@ -155,9 +174,13 @@ if ('state.data.assimilation' %in% names(settings)) { } # Run benchmarking -if("benchmarking" %in% names(settings) & "benchmark" %in% names(settings$benchmarking)){ +if ("benchmarking" %in% names(settings) +&& "benchmark" %in% names(settings$benchmarking)) { PEcAn.utils::status.start("BENCHMARKING") - results <- papply(settings, function(x) calc_benchmark(x, bety)) + results <- + papply(settings, function(x) { + calc_benchmark(x, bety) + }) PEcAn.utils::status.end() } @@ -165,15 +188,25 @@ if("benchmarking" %in% names(settings) & "benchmark" %in% names(settings$benchma if (PEcAn.utils::status.check("FINISHED") == 0) { PEcAn.utils::status.start("FINISHED") PEcAn.remote::kill.tunnel(settings) - db.query(paste("UPDATE workflows SET finished_at=NOW() WHERE id=", - settings$workflow$id, "AND finished_at IS NULL"), - params = settings$database$bety) - + db.query( + paste( + "UPDATE workflows SET finished_at=NOW() WHERE id=", + settings$workflow$id, + "AND finished_at IS NULL" + ), + params = settings$database$bety + ) + # Send email if configured - if (!is.null(settings$email) && !is.null(settings$email$to) && (settings$email$to != "")) { - sendmail(settings$email$from, settings$email$to, - paste0("Workflow has finished executing at ", base::date()), - paste0("You can find the results on ", settings$email$url)) + if (!is.null(settings$email) + && !is.null(settings$email$to) + && (settings$email$to != "")) { + sendmail( + settings$email$from, + settings$email$to, + paste0("Workflow has finished executing at ", base::date()), + paste0("You can find the results on ", settings$email$url) + ) } PEcAn.utils::status.end() }