diff --git a/.Rbuildignore b/.Rbuildignore index 716531b..a7d7e9a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,18 +1,10 @@ -^Meta$ -^doc$ ^.*\.Rproj$ ^\.Rproj\.user$ ^\vignettes$ -^twdtw_results/ ^examples/ -^.travis.yml$ -_config.yml # Other files README.md -corinho.R -tardis.f -tardis.o ^\.git/ .gitignore ^README\.Rmd$ @@ -21,18 +13,14 @@ tardis.o ^.*\.xml$ ^README-.*\.png$ ^cran-comments\.md$ -src/symbols.rds$ -jss\.bst$ -jss\.cls$ TODO$ -tic.R dtwSat-Ex_i386.Rout dtwSat-Ex_x64.Rout examples_i386 examples_x64 -vignettes/twdtw03-speed.Rmd -^data/mod13q1/ -^data/mod13q1.db ^CRAN-RELEASE$ ^CRAN-SUBMISSION$ +^LICENSE\.md$ +^dtwSat\.Rproj$ +^\.github$ diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..a3ac618 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,49 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + +name: R-CMD-check + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: macos-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 0000000..2c5bb50 --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,50 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + +name: test-coverage + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr + needs: coverage + + - name: Test coverage + run: | + covr::codecov( + quiet = FALSE, + clean = FALSE, + install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package") + ) + shell: Rscript {0} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v3 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/.gitignore b/.gitignore index 1e046a7..527b631 100644 --- a/.gitignore +++ b/.gitignore @@ -1,29 +1,39 @@ -Meta -doc # History files .Rhistory +.Rapp.history +# Session Data files +.RData +# User-specific files +.Ruserdata # Example code in package build process *-Ex.R -# R data files from past sessions -.Rdata +# Output files from R CMD build +/*.tar.gz +# Output files from R CMD check +/*.Rcheck/ # RStudio files .Rproj.user/ +# produced vignettes +vignettes/*.html +vignettes/*.pdf +# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 +.httr-oauth +# knitr and R markdown default cache directories +*_cache/ +/cache/ +# Temporary files created by R markdown +*.utf8.md +*.knit.md +# R Environment Variables +.Renviron .Rproj.user -# Man fileis -#man/ -#.Rd -.Rd~ -README.md~ +.Rdata +.DS_Store +.quarto +revdep/ +CRAN-SUBMISSION + # Other files src/symbols.rds -twdtw_results/ -*.xml -corinho.R -tardis.f *.o *.so -Makefile -dtw_result_subarea_250m_1_2017-09-01.tif -/doc/ -/Meta/ -CRAN-SUBMISSION diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 3994ef3..0000000 --- a/.travis.yml +++ /dev/null @@ -1,54 +0,0 @@ -language: r - -r: - - release -# - devel - -deploy.skip_cleanup: true - -sudo: required -dist: trusty - -cache: - - packages - - ccache - -latex: true - -r_github_packages: - - r-lib/covr - -bioc_packages: - - Biobase - -addons: - apt: - sources: - - sourceline: 'ppa:ubuntugis/ubuntugis-unstable' - packages: - - libproj-dev - - libgeos-dev - - libspatialite-dev - - libgdal-dev - -before_install: - - R -e 'install.packages("rgdal", repos="http://R-Forge.R-project.org")' - - R -q -e 'install.packages("remotes"); remotes::install_github("ropenscilabs/tic"); tic::prepare_all_stages()' - -r_packages: - - covr - -after_success: - - Rscript -e 'library(covr); codecov()' - -after_success: - - R -q -e 'covr::codecov(quiet = FALSE)' - -install: R -q -e 'tic::install()' -script: R -q -e 'tic::script()' -before_deploy: R -q -e 'tic::before_deploy()' -deploy: - provider: script - script: R -q -e 'tic::deploy()' - on: - branch: master diff --git a/DESCRIPTION b/DESCRIPTION index edb5e33..4e08634 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: dtwSat Type: Package Title: Time-Weighted Dynamic Time Warping for Satellite Image Time Series Analysis Version: 1.0.0 -Date: 2023-06-30 +Date: 2023-09-03 Authors@R: c(person(given = "Victor", family = "Maus", @@ -22,98 +22,36 @@ Authors@R: role = c("ctb"), comment = c(ORCID = "0000-0002-6642-2543")) ) -Description: Provides an implementation of the Time-Weighted Dynamic Time - Warping (TWDTW) method for land cover mapping. TWDTW computes the similarity between - satellite image time series with a set of known temporal patterns - (e.g. phenological cycles of the vegetation). - 'dtwSat' offers the user methods to create temporal patterns for land cover types, - perform TWDTW analysis for satellite datasets, visualize the results of the analysis, - produce land cover maps, create temporal plots for land cover change, and compute - accuracy metrics. +Description: Provides a robust approach to land use mapping using multi-dimensional + (multi-band) satellite image time series. By leveraging the Time-Weighted Dynamic + Time Warping (TWDTW) distance metric in tandem with a 1-NN classifier, the package + provides functions to produce land use maps based on distinct seasonality patterns, + typically observed in the phenological cycles of vegetation. The TWDTW algorithm is + described in Maus et al. (2016) and + Maus et al. (2019) . A key strength of TWDTW is its ability + to recognize patterns with only a minimal training set, achieving notable accuracy. + The package features tools for generating temporal patterns for various land cover types, + conducting land use mapping, and visualizing the outcomes. +License: GPL (>= 3) +URL: https://github.com/vwmaus/dtwSat/ +BugReports: https://github.com/vwmaus/dtwSat/issues/ +Maintainer: Victor Maus +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.2.3 Depends: - R (>= 3.5.0), - zoo, - raster, + twdtw, + sf, + stars, ggplot2 Imports: - methods, - rgdal, - dtw, - proxy, + mgcv, + stats, scales, reshape2, - grDevices, - RColorBrewer, - plyr, - stats, - sp, - lubridate, - caret, - mgcv, - xtable, - Rdpack, - data.table, - foreach + rlang Suggests: - gridExtra, - grid, - png, - Hmisc, rbenchmark, - doParallel, - knitr, - rmarkdown -License: GPL (>= 3) | file LICENSE -URL: https://www.victor-maus.com/dtwSat/, https://github.com/vwmaus/dtwSat/ -BugReports: https://github.com/vwmaus/dtwSat/issues/ -Maintainer: Victor Maus -LazyData: true -VignetteBuilder: - knitr -Encoding: UTF-8 -RoxygenNote: 7.2.3 -Collate: - 'class-crossValidation.R' - 'class-twdtwRaster.R' - 'class-twdtwAssessment.R' - 'class-twdtwTimeSeries.R' - 'class-twdtwMatches.R' - 'createPatterns.R' - 'data.R' - 'dtw.R' - 'dwtSat.R' - 'getInternals.R' - 'getMatchingDates.R' - 'getTimeSeries.R' - 'linearWeight.R' - 'logisticWeight.R' - 'methods.R' - 'miscellaneous.R' - 'plot.R' - 'plotAccuracy.R' - 'plotAdjustedArea.R' - 'plotAlignments.R' - 'plotArea.R' - 'plotChanges.R' - 'plotClassification.R' - 'plotCostMatrix.R' - 'plotDistance.R' - 'plotMapSamples.R' - 'plotMaps.R' - 'plotMatches.R' - 'plotPaths.R' - 'plotPatterns.R' - 'plotTimeSeries.R' - 'resampleTimeSeries.R' - 'subset.R' - 'twdtw.R' - 'twdtwApply.R' - 'twdtwAssess.R' - 'twdtwClassify.R' - 'twdtwCrossValidate.R' - 'twdtwDist.R' - 'twdtwXtable.R' - 'twdtw_reduce_time.R' - 'utils.R' - 'zzz.R' -RdMacros: Rdpack + stringr, + testthat (>= 3.0.0) +Config/testthat/edition: 3 diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 8b36c59..0000000 --- a/LICENSE +++ /dev/null @@ -1,16 +0,0 @@ -GPL (>= 2) - -R Package dtwSat: Time-Weighted Dynamic Time Warping (TWDTW) for -multi-band satellite image time series analysis. - -Copyright (c) 2015 Victor Maus - -This program is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License -as published by the Free Software Foundation; either version 2 -of the License, or (at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 index 0000000..175443c --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,595 @@ +GNU General Public License +========================== + +_Version 3, 29 June 2007_ +_Copyright © 2007 Free Software Foundation, Inc. <>_ + +Everyone is permitted to copy and distribute verbatim copies of this license +document, but changing it is not allowed. + +## Preamble + +The GNU General Public License is a free, copyleft license for software and other +kinds of works. + +The licenses for most software and other practical works are designed to take away +your freedom to share and change the works. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change all versions of a +program--to make sure it remains free software for all its users. We, the Free +Software Foundation, use the GNU General Public License for most of our software; it +applies also to any other work released this way by its authors. You can apply it to +your programs, too. + +When we speak of free software, we are referring to freedom, not price. Our General +Public Licenses are designed to make sure that you have the freedom to distribute +copies of free software (and charge for them if you wish), that you receive source +code or can get it if you want it, that you can change the software or use pieces of +it in new free programs, and that you know you can do these things. + +To protect your rights, we need to prevent others from denying you these rights or +asking you to surrender the rights. Therefore, you have certain responsibilities if +you distribute copies of the software, or if you modify it: responsibilities to +respect the freedom of others. + +For example, if you distribute copies of such a program, whether gratis or for a fee, +you must pass on to the recipients the same freedoms that you received. You must make +sure that they, too, receive or can get the source code. And you must show them these +terms so they know their rights. + +Developers that use the GNU GPL protect your rights with two steps: **(1)** assert +copyright on the software, and **(2)** offer you this License giving you legal permission +to copy, distribute and/or modify it. + +For the developers' and authors' protection, the GPL clearly explains that there is +no warranty for this free software. For both users' and authors' sake, the GPL +requires that modified versions be marked as changed, so that their problems will not +be attributed erroneously to authors of previous versions. + +Some devices are designed to deny users access to install or run modified versions of +the software inside them, although the manufacturer can do so. This is fundamentally +incompatible with the aim of protecting users' freedom to change the software. The +systematic pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we have designed +this version of the GPL to prohibit the practice for those products. If such problems +arise substantially in other domains, we stand ready to extend this provision to +those domains in future versions of the GPL, as needed to protect the freedom of +users. + +Finally, every program is threatened constantly by software patents. States should +not allow patents to restrict development and use of software on general-purpose +computers, but in those that do, we wish to avoid the special danger that patents +applied to a free program could make it effectively proprietary. To prevent this, the +GPL assures that patents cannot be used to render the program non-free. + +The precise terms and conditions for copying, distribution and modification follow. + +## TERMS AND CONDITIONS + +### 0. Definitions + +“This License” refers to version 3 of the GNU General Public License. + +“Copyright” also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + +“The Program” refers to any copyrightable work licensed under this +License. Each licensee is addressed as “you”. “Licensees” and +“recipients” may be individuals or organizations. + +To “modify” a work means to copy from or adapt all or part of the work in +a fashion requiring copyright permission, other than the making of an exact copy. The +resulting work is called a “modified version” of the earlier work or a +work “based on” the earlier work. + +A “covered work” means either the unmodified Program or a work based on +the Program. + +To “propagate” a work means to do anything with it that, without +permission, would make you directly or secondarily liable for infringement under +applicable copyright law, except executing it on a computer or modifying a private +copy. Propagation includes copying, distribution (with or without modification), +making available to the public, and in some countries other activities as well. + +To “convey” a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through a computer +network, with no transfer of a copy, is not conveying. + +An interactive user interface displays “Appropriate Legal Notices” to the +extent that it includes a convenient and prominently visible feature that **(1)** +displays an appropriate copyright notice, and **(2)** tells the user that there is no +warranty for the work (except to the extent that warranties are provided), that +licensees may convey the work under this License, and how to view a copy of this +License. If the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + +### 1. Source Code + +The “source code” for a work means the preferred form of the work for +making modifications to it. “Object code” means any non-source form of a +work. + +A “Standard Interface” means an interface that either is an official +standard defined by a recognized standards body, or, in the case of interfaces +specified for a particular programming language, one that is widely used among +developers working in that language. + +The “System Libraries” of an executable work include anything, other than +the work as a whole, that **(a)** is included in the normal form of packaging a Major +Component, but which is not part of that Major Component, and **(b)** serves only to +enable use of the work with that Major Component, or to implement a Standard +Interface for which an implementation is available to the public in source code form. +A “Major Component”, in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system (if any) on which +the executable work runs, or a compiler used to produce the work, or an object code +interpreter used to run it. + +The “Corresponding Source” for a work in object code form means all the +source code needed to generate, install, and (for an executable work) run the object +code and to modify the work, including scripts to control those activities. However, +it does not include the work's System Libraries, or general-purpose tools or +generally available free programs which are used unmodified in performing those +activities but which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for the work, and +the source code for shared libraries and dynamically linked subprograms that the work +is specifically designed to require, such as by intimate data communication or +control flow between those subprograms and other parts of the work. + +The Corresponding Source need not include anything that users can regenerate +automatically from other parts of the Corresponding Source. + +The Corresponding Source for a work in source code form is that same work. + +### 2. Basic Permissions + +All rights granted under this License are granted for the term of copyright on the +Program, and are irrevocable provided the stated conditions are met. This License +explicitly affirms your unlimited permission to run the unmodified Program. The +output from running a covered work is covered by this License only if the output, +given its content, constitutes a covered work. This License acknowledges your rights +of fair use or other equivalent, as provided by copyright law. + +You may make, run and propagate covered works that you do not convey, without +conditions so long as your license otherwise remains in force. You may convey covered +works to others for the sole purpose of having them make modifications exclusively +for you, or provide you with facilities for running those works, provided that you +comply with the terms of this License in conveying all material for which you do not +control copyright. Those thus making or running the covered works for you must do so +exclusively on your behalf, under your direction and control, on terms that prohibit +them from making any copies of your copyrighted material outside their relationship +with you. + +Conveying under any other circumstances is permitted solely under the conditions +stated below. Sublicensing is not allowed; section 10 makes it unnecessary. + +### 3. Protecting Users' Legal Rights From Anti-Circumvention Law + +No covered work shall be deemed part of an effective technological measure under any +applicable law fulfilling obligations under article 11 of the WIPO copyright treaty +adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention +of such measures. + +When you convey a covered work, you waive any legal power to forbid circumvention of +technological measures to the extent such circumvention is effected by exercising +rights under this License with respect to the covered work, and you disclaim any +intention to limit operation or modification of the work as a means of enforcing, +against the work's users, your or third parties' legal rights to forbid circumvention +of technological measures. + +### 4. Conveying Verbatim Copies + +You may convey verbatim copies of the Program's source code as you receive it, in any +medium, provided that you conspicuously and appropriately publish on each copy an +appropriate copyright notice; keep intact all notices stating that this License and +any non-permissive terms added in accord with section 7 apply to the code; keep +intact all notices of the absence of any warranty; and give all recipients a copy of +this License along with the Program. + +You may charge any price or no price for each copy that you convey, and you may offer +support or warranty protection for a fee. + +### 5. Conveying Modified Source Versions + +You may convey a work based on the Program, or the modifications to produce it from +the Program, in the form of source code under the terms of section 4, provided that +you also meet all of these conditions: + +* **a)** The work must carry prominent notices stating that you modified it, and giving a +relevant date. +* **b)** The work must carry prominent notices stating that it is released under this +License and any conditions added under section 7. This requirement modifies the +requirement in section 4 to “keep intact all notices”. +* **c)** You must license the entire work, as a whole, under this License to anyone who +comes into possession of a copy. This License will therefore apply, along with any +applicable section 7 additional terms, to the whole of the work, and all its parts, +regardless of how they are packaged. This License gives no permission to license the +work in any other way, but it does not invalidate such permission if you have +separately received it. +* **d)** If the work has interactive user interfaces, each must display Appropriate Legal +Notices; however, if the Program has interactive interfaces that do not display +Appropriate Legal Notices, your work need not make them do so. + +A compilation of a covered work with other separate and independent works, which are +not by their nature extensions of the covered work, and which are not combined with +it such as to form a larger program, in or on a volume of a storage or distribution +medium, is called an “aggregate” if the compilation and its resulting +copyright are not used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work in an aggregate +does not cause this License to apply to the other parts of the aggregate. + +### 6. Conveying Non-Source Forms + +You may convey a covered work in object code form under the terms of sections 4 and +5, provided that you also convey the machine-readable Corresponding Source under the +terms of this License, in one of these ways: + +* **a)** Convey the object code in, or embodied in, a physical product (including a +physical distribution medium), accompanied by the Corresponding Source fixed on a +durable physical medium customarily used for software interchange. +* **b)** Convey the object code in, or embodied in, a physical product (including a +physical distribution medium), accompanied by a written offer, valid for at least +three years and valid for as long as you offer spare parts or customer support for +that product model, to give anyone who possesses the object code either **(1)** a copy of +the Corresponding Source for all the software in the product that is covered by this +License, on a durable physical medium customarily used for software interchange, for +a price no more than your reasonable cost of physically performing this conveying of +source, or **(2)** access to copy the Corresponding Source from a network server at no +charge. +* **c)** Convey individual copies of the object code with a copy of the written offer to +provide the Corresponding Source. This alternative is allowed only occasionally and +noncommercially, and only if you received the object code with such an offer, in +accord with subsection 6b. +* **d)** Convey the object code by offering access from a designated place (gratis or for +a charge), and offer equivalent access to the Corresponding Source in the same way +through the same place at no further charge. You need not require recipients to copy +the Corresponding Source along with the object code. If the place to copy the object +code is a network server, the Corresponding Source may be on a different server +(operated by you or a third party) that supports equivalent copying facilities, +provided you maintain clear directions next to the object code saying where to find +the Corresponding Source. Regardless of what server hosts the Corresponding Source, +you remain obligated to ensure that it is available for as long as needed to satisfy +these requirements. +* **e)** Convey the object code using peer-to-peer transmission, provided you inform +other peers where the object code and Corresponding Source of the work are being +offered to the general public at no charge under subsection 6d. + +A separable portion of the object code, whose source code is excluded from the +Corresponding Source as a System Library, need not be included in conveying the +object code work. + +A “User Product” is either **(1)** a “consumer product”, which +means any tangible personal property which is normally used for personal, family, or +household purposes, or **(2)** anything designed or sold for incorporation into a +dwelling. In determining whether a product is a consumer product, doubtful cases +shall be resolved in favor of coverage. For a particular product received by a +particular user, “normally used” refers to a typical or common use of +that class of product, regardless of the status of the particular user or of the way +in which the particular user actually uses, or expects or is expected to use, the +product. A product is a consumer product regardless of whether the product has +substantial commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + +“Installation Information” for a User Product means any methods, +procedures, authorization keys, or other information required to install and execute +modified versions of a covered work in that User Product from a modified version of +its Corresponding Source. The information must suffice to ensure that the continued +functioning of the modified object code is in no case prevented or interfered with +solely because modification has been made. + +If you convey an object code work under this section in, or with, or specifically for +use in, a User Product, and the conveying occurs as part of a transaction in which +the right of possession and use of the User Product is transferred to the recipient +in perpetuity or for a fixed term (regardless of how the transaction is +characterized), the Corresponding Source conveyed under this section must be +accompanied by the Installation Information. But this requirement does not apply if +neither you nor any third party retains the ability to install modified object code +on the User Product (for example, the work has been installed in ROM). + +The requirement to provide Installation Information does not include a requirement to +continue to provide support service, warranty, or updates for a work that has been +modified or installed by the recipient, or for the User Product in which it has been +modified or installed. Access to a network may be denied when the modification itself +materially and adversely affects the operation of the network or violates the rules +and protocols for communication across the network. + +Corresponding Source conveyed, and Installation Information provided, in accord with +this section must be in a format that is publicly documented (and with an +implementation available to the public in source code form), and must require no +special password or key for unpacking, reading or copying. + +### 7. Additional Terms + +“Additional permissions” are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. Additional +permissions that are applicable to the entire Program shall be treated as though they +were included in this License, to the extent that they are valid under applicable +law. If additional permissions apply only to part of the Program, that part may be +used separately under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + +When you convey a copy of a covered work, you may at your option remove any +additional permissions from that copy, or from any part of it. (Additional +permissions may be written to require their own removal in certain cases when you +modify the work.) You may place additional permissions on material, added by you to a +covered work, for which you have or can give appropriate copyright permission. + +Notwithstanding any other provision of this License, for material you add to a +covered work, you may (if authorized by the copyright holders of that material) +supplement the terms of this License with terms: + +* **a)** Disclaiming warranty or limiting liability differently from the terms of +sections 15 and 16 of this License; or +* **b)** Requiring preservation of specified reasonable legal notices or author +attributions in that material or in the Appropriate Legal Notices displayed by works +containing it; or +* **c)** Prohibiting misrepresentation of the origin of that material, or requiring that +modified versions of such material be marked in reasonable ways as different from the +original version; or +* **d)** Limiting the use for publicity purposes of names of licensors or authors of the +material; or +* **e)** Declining to grant rights under trademark law for use of some trade names, +trademarks, or service marks; or +* **f)** Requiring indemnification of licensors and authors of that material by anyone +who conveys the material (or modified versions of it) with contractual assumptions of +liability to the recipient, for any liability that these contractual assumptions +directly impose on those licensors and authors. + +All other non-permissive additional terms are considered “further +restrictions” within the meaning of section 10. If the Program as you received +it, or any part of it, contains a notice stating that it is governed by this License +along with a term that is a further restriction, you may remove that term. If a +license document contains a further restriction but permits relicensing or conveying +under this License, you may add to a covered work material governed by the terms of +that license document, provided that the further restriction does not survive such +relicensing or conveying. + +If you add terms to a covered work in accord with this section, you must place, in +the relevant source files, a statement of the additional terms that apply to those +files, or a notice indicating where to find the applicable terms. + +Additional terms, permissive or non-permissive, may be stated in the form of a +separately written license, or stated as exceptions; the above requirements apply +either way. + +### 8. Termination + +You may not propagate or modify a covered work except as expressly provided under +this License. Any attempt otherwise to propagate or modify it is void, and will +automatically terminate your rights under this License (including any patent licenses +granted under the third paragraph of section 11). + +However, if you cease all violation of this License, then your license from a +particular copyright holder is reinstated **(a)** provisionally, unless and until the +copyright holder explicitly and finally terminates your license, and **(b)** permanently, +if the copyright holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + +Moreover, your license from a particular copyright holder is reinstated permanently +if the copyright holder notifies you of the violation by some reasonable means, this +is the first time you have received notice of violation of this License (for any +work) from that copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + +Termination of your rights under this section does not terminate the licenses of +parties who have received copies or rights from you under this License. If your +rights have been terminated and not permanently reinstated, you do not qualify to +receive new licenses for the same material under section 10. + +### 9. Acceptance Not Required for Having Copies + +You are not required to accept this License in order to receive or run a copy of the +Program. Ancillary propagation of a covered work occurring solely as a consequence of +using peer-to-peer transmission to receive a copy likewise does not require +acceptance. However, nothing other than this License grants you permission to +propagate or modify any covered work. These actions infringe copyright if you do not +accept this License. Therefore, by modifying or propagating a covered work, you +indicate your acceptance of this License to do so. + +### 10. Automatic Licensing of Downstream Recipients + +Each time you convey a covered work, the recipient automatically receives a license +from the original licensors, to run, modify and propagate that work, subject to this +License. You are not responsible for enforcing compliance by third parties with this +License. + +An “entity transaction” is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an organization, or +merging organizations. If propagation of a covered work results from an entity +transaction, each party to that transaction who receives a copy of the work also +receives whatever licenses to the work the party's predecessor in interest had or +could give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if the predecessor +has it or can get it with reasonable efforts. + +You may not impose any further restrictions on the exercise of the rights granted or +affirmed under this License. For example, you may not impose a license fee, royalty, +or other charge for exercise of rights granted under this License, and you may not +initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging +that any patent claim is infringed by making, using, selling, offering for sale, or +importing the Program or any portion of it. + +### 11. Patents + +A “contributor” is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The work thus +licensed is called the contributor's “contributor version”. + +A contributor's “essential patent claims” are all patent claims owned or +controlled by the contributor, whether already acquired or hereafter acquired, that +would be infringed by some manner, permitted by this License, of making, using, or +selling its contributor version, but do not include claims that would be infringed +only as a consequence of further modification of the contributor version. For +purposes of this definition, “control” includes the right to grant patent +sublicenses in a manner consistent with the requirements of this License. + +Each contributor grants you a non-exclusive, worldwide, royalty-free patent license +under the contributor's essential patent claims, to make, use, sell, offer for sale, +import and otherwise run, modify and propagate the contents of its contributor +version. + +In the following three paragraphs, a “patent license” is any express +agreement or commitment, however denominated, not to enforce a patent (such as an +express permission to practice a patent or covenant not to sue for patent +infringement). To “grant” such a patent license to a party means to make +such an agreement or commitment not to enforce a patent against the party. + +If you convey a covered work, knowingly relying on a patent license, and the +Corresponding Source of the work is not available for anyone to copy, free of charge +and under the terms of this License, through a publicly available network server or +other readily accessible means, then you must either **(1)** cause the Corresponding +Source to be so available, or **(2)** arrange to deprive yourself of the benefit of the +patent license for this particular work, or **(3)** arrange, in a manner consistent with +the requirements of this License, to extend the patent license to downstream +recipients. “Knowingly relying” means you have actual knowledge that, but +for the patent license, your conveying the covered work in a country, or your +recipient's use of the covered work in a country, would infringe one or more +identifiable patents in that country that you have reason to believe are valid. + +If, pursuant to or in connection with a single transaction or arrangement, you +convey, or propagate by procuring conveyance of, a covered work, and grant a patent +license to some of the parties receiving the covered work authorizing them to use, +propagate, modify or convey a specific copy of the covered work, then the patent +license you grant is automatically extended to all recipients of the covered work and +works based on it. + +A patent license is “discriminatory” if it does not include within the +scope of its coverage, prohibits the exercise of, or is conditioned on the +non-exercise of one or more of the rights that are specifically granted under this +License. You may not convey a covered work if you are a party to an arrangement with +a third party that is in the business of distributing software, under which you make +payment to the third party based on the extent of your activity of conveying the +work, and under which the third party grants, to any of the parties who would receive +the covered work from you, a discriminatory patent license **(a)** in connection with +copies of the covered work conveyed by you (or copies made from those copies), or **(b)** +primarily for and in connection with specific products or compilations that contain +the covered work, unless you entered into that arrangement, or that patent license +was granted, prior to 28 March 2007. + +Nothing in this License shall be construed as excluding or limiting any implied +license or other defenses to infringement that may otherwise be available to you +under applicable patent law. + +### 12. No Surrender of Others' Freedom + +If conditions are imposed on you (whether by court order, agreement or otherwise) +that contradict the conditions of this License, they do not excuse you from the +conditions of this License. If you cannot convey a covered work so as to satisfy +simultaneously your obligations under this License and any other pertinent +obligations, then as a consequence you may not convey it at all. For example, if you +agree to terms that obligate you to collect a royalty for further conveying from +those to whom you convey the Program, the only way you could satisfy both those terms +and this License would be to refrain entirely from conveying the Program. + +### 13. Use with the GNU Affero General Public License + +Notwithstanding any other provision of this License, you have permission to link or +combine any covered work with a work licensed under version 3 of the GNU Affero +General Public License into a single combined work, and to convey the resulting work. +The terms of this License will continue to apply to the part which is the covered +work, but the special requirements of the GNU Affero General Public License, section +13, concerning interaction through a network will apply to the combination as such. + +### 14. Revised Versions of this License + +The Free Software Foundation may publish revised and/or new versions of the GNU +General Public License from time to time. Such new versions will be similar in spirit +to the present version, but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Program specifies that +a certain numbered version of the GNU General Public License “or any later +version” applies to it, you have the option of following the terms and +conditions either of that numbered version or of any later version published by the +Free Software Foundation. If the Program does not specify a version number of the GNU +General Public License, you may choose any version ever published by the Free +Software Foundation. + +If the Program specifies that a proxy can decide which future versions of the GNU +General Public License can be used, that proxy's public statement of acceptance of a +version permanently authorizes you to choose that version for the Program. + +Later license versions may give you additional or different permissions. However, no +additional obligations are imposed on any author or copyright holder as a result of +your choosing to follow a later version. + +### 15. Disclaimer of Warranty + +THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM “AS IS” WITHOUT WARRANTY OF ANY KIND, EITHER +EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE +QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE +DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + +### 16. Limitation of Liability + +IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY +COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS +PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, +INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE +OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE +WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + +### 17. Interpretation of Sections 15 and 16 + +If the disclaimer of warranty and limitation of liability provided above cannot be +given local legal effect according to their terms, reviewing courts shall apply local +law that most closely approximates an absolute waiver of all civil liability in +connection with the Program, unless a warranty or assumption of liability accompanies +a copy of the Program in return for a fee. + +_END OF TERMS AND CONDITIONS_ + +## How to Apply These Terms to Your New Programs + +If you develop a new program, and you want it to be of the greatest possible use to +the public, the best way to achieve this is to make it free software which everyone +can redistribute and change under these terms. + +To do so, attach the following notices to the program. It is safest to attach them +to the start of each source file to most effectively state the exclusion of warranty; +and each file should have at least the “copyright” line and a pointer to +where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + +If the program does terminal interaction, make it output a short notice like this +when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type 'show c' for details. + +The hypothetical commands `show w` and `show c` should show the appropriate parts of +the General Public License. Of course, your program's commands might be different; +for a GUI interface, you would use an “about box”. + +You should also get your employer (if you work as a programmer) or school, if any, to +sign a “copyright disclaimer” for the program, if necessary. For more +information on this, and how to apply and follow the GNU GPL, see +<>. + +The GNU General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may consider it +more useful to permit linking proprietary applications with the library. If this is +what you want to do, use the GNU Lesser General Public License instead of this +License. But first, please read +<>. diff --git a/NAMESPACE b/NAMESPACE index 5c60500..fb17b02 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,130 +1,20 @@ # Generated by roxygen2: do not edit by hand -export(asymmetric) -export(createPatterns) -export(getDatesFromDOY) -export(linearWeight) -export(logisticWeight) -export(plot) -export(plotAccuracy) -export(plotAdjustedArea) -export(plotAlignments) -export(plotArea) -export(plotChanges) -export(plotClassification) -export(plotCostMatrix) -export(plotDistance) -export(plotMapSamples) -export(plotMaps) -export(plotMatches) -export(plotPaths) -export(plotPatterns) -export(plotTimeSeries) -export(rabinerJuangStepPattern) -export(resampleTimeSeries) -export(shiftDates) -export(symmetric1) -export(symmetric2) -export(twdtwApply) -export(twdtwClassify) -export(twdtwReduceTime) -exportMethods("[") -exportMethods("[[") -exportMethods(as.data.frame) -exportMethods(as.list) -exportMethods(as.twdtwTimeSeries) -exportMethods(bands) -exportMethods(coordinates) -exportMethods(coverages) -exportMethods(createPatterns) -exportMethods(crop) -exportMethods(dim) -exportMethods(extent) -exportMethods(getAlignments) -exportMethods(getInternals) -exportMethods(getMatches) -exportMethods(getPatterns) -exportMethods(getTimeSeries) -exportMethods(index) -exportMethods(is.twdtwMatches) -exportMethods(is.twdtwRaster) -exportMethods(is.twdtwTimeSeries) -exportMethods(labels) -exportMethods(layers) -exportMethods(length) -exportMethods(levels) -exportMethods(names) -exportMethods(ncol) -exportMethods(nlayers) -exportMethods(nrow) -exportMethods(plot) -exportMethods(projecttwdtwRaster) -exportMethods(res) -exportMethods(resampleTimeSeries) -exportMethods(shiftDates) -exportMethods(show) -exportMethods(subset) -exportMethods(summary) -exportMethods(twdtwApply) -exportMethods(twdtwAssess) -exportMethods(twdtwClassify) -exportMethods(twdtwCrossValidate) -exportMethods(twdtwMatches) -exportMethods(twdtwRaster) -exportMethods(twdtwTimeSeries) -exportMethods(twdtwXtable) -exportMethods(writeRaster) +export(create_patterns) +export(plot_patterns) +export(shift_dates) import(ggplot2) -import(methods) -import(raster) -import(rgdal) -import(zoo) -importFrom(RColorBrewer,brewer.pal) -importFrom(Rdpack,reprompt) -importFrom(caret,createDataPartition) -importFrom(data.table,rbindlist) -importFrom(dtw,asymmetric) -importFrom(dtw,rabinerJuangStepPattern) -importFrom(dtw,symmetric1) -importFrom(dtw,symmetric2) -importFrom(foreach,"%dopar%") -importFrom(foreach,foreach) -importFrom(grDevices,gray.colors) -importFrom(grDevices,terrain.colors) -importFrom(lubridate,"day<-") -importFrom(lubridate,"month<-") -importFrom(lubridate,"year<-") -importFrom(lubridate,day) -importFrom(lubridate,month) -importFrom(lubridate,year) +import(sf) +import(stars) +import(twdtw) importFrom(mgcv,gam) importFrom(mgcv,predict.gam) -importFrom(plyr,alply) -importFrom(proxy,dist) -importFrom(proxy,pr_DB) +importFrom(mgcv,s) importFrom(reshape2,melt) +importFrom(rlang,.data) importFrom(scales,date_format) importFrom(scales,percent) importFrom(scales,pretty_breaks) -importFrom(sp,CRS) -importFrom(sp,Polygon) -importFrom(sp,Polygons) -importFrom(sp,SpatialPoints) -importFrom(sp,SpatialPointsDataFrame) -importFrom(sp,SpatialPolygons) -importFrom(sp,bbox) -importFrom(sp,coordinates) -importFrom(sp,over) -importFrom(sp,spTransform) -importFrom(stats,ave) -importFrom(stats,na.omit) -importFrom(stats,qnorm) -importFrom(stats,sd) -importFrom(stats,window) -importFrom(stats,xtabs) -importFrom(utils,flush.console) -importFrom(utils,globalVariables) -importFrom(utils,packageDescription) -importFrom(xtable,print.xtable) -importFrom(xtable,xtable) -useDynLib(dtwSat, .registration = TRUE) +importFrom(stats,as.formula) +importFrom(stats,predict) +importFrom(stats,setNames) diff --git a/NEWS.md b/NEWS.md index 9c7a3f0..46b8eed 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # dtwSat v1.0.0 -* Major release: drops dependencies on rgdal and rgeos +* Major release: drops dependencies and simplifies package # dtwSat v0.2.8 diff --git a/R/class-crossValidation.R b/R/class-crossValidation.R deleted file mode 100644 index 297b73a..0000000 --- a/R/class-crossValidation.R +++ /dev/null @@ -1,115 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-11-27 # -# # -############################################################### - - -#' @title class "twdtwCrossValidation" -#' @name twdtwCrossValidation-class -#' @aliases twdtwCrossValidation -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This class stores the results of the cross-validation. -#' -#' @param object an object of class twdtwCrossValidation. -#' -#' @param conf.int specifies the confidence level (0-1) for interval estimation of the -#' population mean. For more details see \code{\link[ggplot2]{mean_cl_boot}}. -#' -#' @param ... Other arguments. Not used. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{createPatterns}}, and -#' \code{\link[dtwSat]{twdtwApply}}. -#' -#' @section Slots : -#' \describe{ -#' \item{\code{partitions}:}{A list with the indices of time series used for training.} -#' \item{\code{accuracy}:}{A list with the accuracy and other TWDTW information for each -#' data partitions.} -#' } -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' \dontrun{ -#' # Data folder -#' data_folder = system.file("lucc_MT/data", package = "dtwSat") -#' -#' # Read dates -#' dates = scan(paste(data_folder,"timeline", sep = "/"), what = "dates") -#' -#' # Read raster time series -#' evi = brick(paste(data_folder,"evi.tif", sep = "/")) -#' raster_timeseries = twdtwRaster(evi, timeline = dates) -#' -#' # Read field samples -#' field_samples = read.csv(paste(data_folder,"samples.csv", sep = "/")) -#' table(field_samples[["label"]]) -#' -#' # Read field samples projection -#' proj_str = scan(paste(data_folder,"samples_projection", sep = "/"), -#' what = "character") -#' -#' # Get sample time series from raster time series -#' field_samples_ts = getTimeSeries(raster_timeseries, -#' y = field_samples, proj4string = proj_str) -#' field_samples_ts -#' -#' # Run cross validation -#' set.seed(1) -#' # Define TWDTW weight function -#' log_fun = logisticWeight(alpha=-0.1, beta=50) -#' cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, -#' freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) -#' cross_validation -#' -#' summary(cross_validation) -#' -#' plot(cross_validation) -#' -#' } -NULL -setClass( - Class = "twdtwCrossValidation", - slots = c(partitions = "list", accuracy = "list"), - validity = function(object){ - if(!is(object@partitions, "list")){ - stop("[twdtwCrossValidation: validation] Invalid partitions, class different from list.") - }else{} - if(!is(object@accuracy, "list")){ - stop("[twdtwCrossValidation: validation] Invalid accuracy, class different from list.") - }else{} - return(TRUE) - } -) - -setMethod("initialize", - signature = "twdtwCrossValidation", - definition = - function(.Object, partitions, accuracy){ - .Object@partitions = list(Resample1=NULL) - .Object@accuracy = list(OverallAccuracy=NULL, UsersAccuracy=NULL, ProducersAccuracy=NULL, - ErrorMatrix=table(NULL), data=data.frame(NULL)) - if(!missing(partitions)) - .Object@partitions = partitions - if(!missing(accuracy)) - .Object@accuracy = accuracy - validObject(.Object) - return(.Object) - } -) - diff --git a/R/class-twdtwAssessment.R b/R/class-twdtwAssessment.R deleted file mode 100644 index c935454..0000000 --- a/R/class-twdtwAssessment.R +++ /dev/null @@ -1,95 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2017-01-18 # -# # -############################################################### - -#' @include class-twdtwRaster.R -#' @title class "twdtwAssessment" -#' @name twdtwAssessment-class -#' @aliases twdtwAssessment -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This class stores the map assessment metrics. -#' -#' @param object an object of class twdtwAssessment. -#' -#' @seealso \code{\link[dtwSat]{twdtwClassify}}, -#' \code{\link[dtwSat]{twdtwAssess}}, and -#' \code{\link[dtwSat]{twdtwXtable}}. -#' -#' @section Slots : -#' \describe{ -#' \item{\code{accuracySummary}:}{Overall Accuracy, User's Accuracy, Producer's Accuracy, -#' Error Matrix (confusion matrix), and Estimated Area, considering all time periods.} -#' \item{\code{accuracyByPeriod}:}{Overall Accuracy, User's Accuracy, Producer's Accuracy, -#' Error Matrix (confusion matrix), and Estimated Area, for each time periods independently -#' from each other.} -#' \item{\code{data}:}{A \code{\link[sp]{SpatialPointsDataFrame}} with sample ID, period, -#' date from, date to, reference labels, predicted labels, and TWDTW distance.} -#' \item{\code{map}:}{A \code{\link[dtwSat]{twdtwRaster}} with the raster maps.} -#' } -#' -#' @details -#' If the twdtwRaster is unprojected (longitude/latitude) the estimated area is the sum of the approximate -#' surface area in km2 of each cell (pixel). If the twdtwRaster is projected the estimated area is calculated -#' using the the pixel resolution in the map unit. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -NULL -setClass( - Class = "twdtwAssessment", - slots = c(accuracySummary = "list", accuracyByPeriod = "list", data = "SpatialPointsDataFrame", map = "twdtwRaster"), - validity = function(object){ - if(!is(object@accuracySummary, "list")){ - stop("[twdtwAssessment: validation] Invalid partitions, class different from list.") - }else{} - if(!is(object@accuracyByPeriod, "list")){ - stop("[twdtwAssessment: validation] Invalid accuracy, class different from list.") - }else{} - if(!is(object@data, "SpatialPointsDataFrame")){ - stop("[twdtwAssessment: validation] Invalid accuracy, class different from SpatialPointsDataFrame.") - }else{} - if(!is(object@map, "twdtwRaster")){ - stop("[twdtwAssessment: validation] Invalid accuracy, class different from twdtwRaster.") - }else{} - return(TRUE) - } -) - -setMethod("initialize", - signature = "twdtwAssessment", - definition = - function(.Object, accuracySummary, accuracyByPeriod, data, map){ - .Object@accuracySummary = list(OverallAccuracy=NULL, UsersAccuracy=NULL, ProducersAccuracy=NULL, ErrorMatrix=table(NULL)) - .Object@accuracyByPeriod = list(list(OverallAccuracy=NULL, UsersAccuracy=NULL, ProducersAccuracy=NULL, - ErrorMatrix=table(NULL))) - .Object@data = SpatialPointsDataFrame(coords = cbind(0,0), - data = data.frame(Sample.id=0, Period=NA, from=NA, to=NA, Distance=NA, Predicted=NA, Reference=NA, Distance=NA)) - .Object@map = new("twdtwRaster") - if(!missing(accuracySummary)) - .Object@accuracySummary = accuracySummary - if(!missing(accuracyByPeriod)) - .Object@accuracyByPeriod = accuracyByPeriod - if(!missing(data)) - .Object@data = data - if(!missing(map)) - .Object@map = map - validObject(.Object) - return(.Object) - } -) - - diff --git a/R/class-twdtwMatches.R b/R/class-twdtwMatches.R deleted file mode 100644 index 26b7861..0000000 --- a/R/class-twdtwMatches.R +++ /dev/null @@ -1,148 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2015-09-01 # -# # -############################################################### - - -#' @title class "twdtwMatches" -#' @name twdtwMatches-class -#' @aliases twdtwMatches -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Class for Time-Weighted Dynamic Time Warping results. -#' -#' @param labels a vector with labels of the time series. -#' @param x an object of class twdtwMatches. -#' @param object an object of class twdtwMatches. -#' @param timeseries a \code{\link[dtwSat]{twdtwTimeSeries}} object. -#' @param patterns a \code{\link[dtwSat]{twdtwTimeSeries}} object. -#' @param alignments an object of class list with the TWDTW results with -#' the same length as \code{timeseries} or a list of twdtwMatches. -#' -#' @include class-twdtwTimeSeries.R -#' -#' @section Slots : -#' \describe{ -#' \item{\code{timeseries}:}{An object of class \code{\link[dtwSat]{twdtwTimeSeries-class}} with the satellite time series.} -#' \item{\code{pattern}:}{An object of class \code{\link[dtwSat]{twdtwTimeSeries-class}} with the temporal patterns.} -#' \item{\code{alignments}:}{A \code{\link[base]{list}} of TWDTW results with the same length as -#' the \code{timeseries}. Each element in this list has the following results for each temporal pattern -#' in \code{patterns}: -#' \cr\code{from}: a vector with the starting dates of each match in the format "YYYY-MM-DD", -#' \cr\code{to}: a vector with the ending dates of each match in the format "YYYY-MM-DD", -#' \cr\code{distance}: a vector with TWDTW dissimilarity measure, and -#' \cr\code{K}: the number of matches of the pattern. -#' } -#' \item{This list might have additional elements:}{ if \code{keep=TRUE} in the \code{twdtwApply} call -#' the list is extended to include internal structures used during the TWDTW computation: -#' \cr\code{costMatrix}: cumulative cost matrix, -#' \cr\code{directionMatrix}: directions of steps that would be taken from each element of matrix, -#' \cr\code{startingMatrix}: the starting points of each element of the matrix, -#' \cr\code{stepPattern}: \code{\link[dtw]{stepPattern}} used for the -#' computation, see package \code{\link[dtw]{dtw}}, -#' \cr\code{N}: the length of the \code{pattern}, -#' \cr\code{M}: the length of the time series \code{timeseries}, -#' \cr\code{timeWeight}: time weight matrix, -#' \cr\code{localMatrix}: local cost matrix, -#' \cr\code{matching}: A list whose elements have the matching points for -#' each match between pattern the time series, such that: -#' \cr--\code{index1}: a vector with matching points of the pattern, and -#' \cr--\code{index2}: a vector with matching points of the time series. -#' } -#' } -#' -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{twdtwTimeSeries-class}}, and -#' \code{\link[dtwSat]{twdtwRaster-class}} -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' ts = twdtwTimeSeries(timeseries=MOD13Q1.ts.list) -#' patterns = twdtwTimeSeries(timeseries=MOD13Q1.patterns.list) -#' matches = twdtwApply(x = ts, y = patterns, keep=TRUE, legacy=TRUE) -#' class(matches) -#' length(matches) -#' matches -NULL -setClass( - Class = "twdtwMatches", - slots = c(timeseries="twdtwTimeSeries", - patterns = "twdtwTimeSeries", - alignments = "list"), - validity = function(object){ - if(!is(object@alignments, "list")){ - stop("[twdtwMatches: validation] Invalid alignments object, class different from list.") - }else{} - if(!is(object@timeseries, "twdtwTimeSeries")){ - stop("[twdtwMatches: validation] Invalid timeseries object, class different from twdtwTimeSeries.") - }else{} - if(!is(object@patterns, "twdtwTimeSeries")){ - stop("[twdtwMatches: validation] Invalid patterns object, class different from list of twdtwTimeSeries.") - }else{} - return(TRUE) - } -) - -setMethod("initialize", - signature = "twdtwMatches", - definition = - function(.Object, timeseries, patterns, alignments){ - .Object@timeseries = new("twdtwTimeSeries") - .Object@patterns = new("twdtwTimeSeries") - .Object@alignments = list() - if(!missing(alignments)) - .Object@alignments = alignments - if(!missing(timeseries)) - .Object@timeseries = timeseries - if(!missing(patterns)) - .Object@patterns = patterns - validObject(.Object) - return(.Object) - } -) - -setGeneric(name = "twdtwMatches", - def = function(timeseries=NULL, patterns=NULL, alignments=NULL) standardGeneric("twdtwMatches") -) - -#' @inheritParams twdtwMatches-class -#' @aliases twdtwMatches-create -#' @describeIn twdtwMatches Create object of class twdtwMatches. -#' -#' @examples -#' # Creating objects of class twdtwMatches -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat = twdtwApply(ts, patt, weight.fun = logisticWeight(-0.1, 100), -#' keep=TRUE, legacy=TRUE) -#' mat = twdtwMatches(ts, patterns=patt, alignments=mat) -#' mat -#' -#' @export -setMethod(f = "twdtwMatches", - definition = function(timeseries, patterns, alignments){ - aligs = alignments - if(is(alignments, "twdtwMatches")) alignments = list(alignments) - if(all(sapply(alignments, is.twdtwMatches))) { - aligs = alignments - if(is(alignments, "list")) aligs = do.call("c", lapply(alignments, function(x) x@alignments)) - if(is.null(timeseries)) timeseries = do.call("twdtwTimeSeries", lapply(alignments, function(x) subset(x@timeseries))) - if(is.null(patterns)) patterns=alignments[[1]]@patterns - } - new("twdtwMatches", timeseries=timeseries, patterns=patterns, alignments=aligs) - }) diff --git a/R/class-twdtwRaster.R b/R/class-twdtwRaster.R deleted file mode 100644 index 8fd9bd8..0000000 --- a/R/class-twdtwRaster.R +++ /dev/null @@ -1,256 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-18 # -# # -############################################################### - - -#' @title class "twdtwRaster" -#' @name twdtwRaster-class -#' @aliases twdtwRaster -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Class for set of satellite time series. -#' -#' @param ... objects of class \code{\link[raster]{RasterBrick-class}} or -#' \code{\link[raster]{RasterStack-class}}. -#' -#' @param timeline a vector with the dates of the satellite images -#' in the format of "YYYY-MM-DD". -#' -#' @param layers a vector with the names of the \code{Raster*} objects -#' passed to "\code{...}". If not provided the layers are set to the -#' names of objects in "\code{...}". -#' -#' @param labels a vector of class \code{\link[base]{character}} with -#' labels of the values in the Raster* objects. This is -#' useful for categorical Raster* values of land use classes. -#' -#' @param levels a vector of class \code{\link[base]{numeric}} with -#' levels of the values in the Raster* objects. This is -#' useful for categorical Raster* values of land use classes. -#' -#' @param doy A \code{\link[raster]{RasterBrick-class}} or -#' \code{\link[raster]{RasterStack-class}} with a sequence of days of the year for each pixel. -#' \code{doy} must have the same spatial and temporal extents as the Raster* objects passed to \code{...}. -#' If \code{doy} is not provided then at least one Raster* object must be passed through \code{...}. -#' -#' @param filepath A character. The path to save the raster time series. If provided the -#' function saves a raster file for each Raster* object in the list, \emph{i.e} one file -#' for each time series. This way the function retrieves a list of -#' \code{\link[raster]{RasterBrick-class}}. It is useful when the time series are -#' originally stored in separated files. See details. -#' -#' @param object an object of class twdtwRaster. -#' -#' @param x an object of class twdtwRaster. -#' -#' @details The performance of the functions \code{\link[dtwSat]{twdtwApply}} and -#' \code{\link[dtwSat]{getTimeSeries}} is improved if the Raster* objects are connected -#' to files with the whole time series for each attribute. -#' -#' @section Slots : -#' \describe{ -#' \item{\code{timeseries}:}{A list of multi-layer Raster* objects -#' with the satellite image time series.} -#' \item{\code{timeline}:}{A vector of class \code{\link[base]{date}} -#' with dates of the satellite images in \code{timeseries}.} -#' \item{\code{layers}:}{A vector of class \code{\link[base]{character}} -#' with the names of the Raster* objects.} -#' \item{\code{labels}:}{A vector of class \code{\link[base]{factor}} -#' with levels and labels of the values in the Raster* objects. This -#' is useful for categorical Raster* values of land use classes.} -#' } -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{getTimeSeries}}, -#' \code{\link[dtwSat]{twdtwMatches-class}}, and -#' \code{\link[dtwSat]{twdtwTimeSeries-class}} -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' # Creating a new object of class twdtwTimeSeries -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = new("twdtwRaster", timeseries = evi, timeline = timeline) -#' -NULL -setClass( - Class = "twdtwRaster", - slots = c(timeseries = "list", timeline="Date", layers = "character", labels = "character", levels="numeric"), - validity = function(object){ - if(!is(object@timeline, "Date")){ - stop("[twdtwTimeSeries: validation] Invalid timeline object, class different from Date.") - }else{} - if(any(!(sapply(object@timeseries, is, "RasterBrick") | sapply(object@timeseries, is, "RasterStack") | sapply(object@timeseries, is, "RasterLayer")))){ - stop("[twdtwRaster: validation] Invalid timeseries object, class different from Raster*.") - }else{} - if(!is(object@layers, "character")){ - stop("[twdtwTimeSeries: validation] Invalid layers object, class different from character.") - }else{} - if( length(object@layers)>0 & length(object@layers)!=length(object@timeseries) ){ - stop("[twdtwTimeSeries: validation] Invalid length, layers and timeseries do not have the same length.") - }else{} - if(!is(object@labels, "character")){ - stop("[twdtwTimeSeries: validation] Invalid labels object, class different from character.") - }else{} - if(!is(object@levels, "numeric")){ - stop("[twdtwTimeSeries: validation] Invalid levels object, class different from numeric.") - }else{} - if( length(object@labels) != length(object@levels) ){ - stop("[twdtwTimeSeries: validation] Invalid length, labels and levels do not have the same length.") - }else{} - lapply(object@timeseries, FUN=compareRaster, object@timeseries[[1]], extent=TRUE, rowcol=TRUE, - crs=TRUE, res=TRUE, orig=TRUE, rotation=TRUE, stopiffalse=TRUE) - return(TRUE) - } -) - -setMethod("initialize", - signature = "twdtwRaster", - definition = - function(.Object, timeseries, timeline, doy, layers, labels, levels){ - - .Object@timeseries = list(Layer0=brick()) - .Object@timeline = as.Date(0) - .Object@labels = as.character() - .Object@levels = numeric() - if(!missing(timeseries)){ - if(is(timeseries, "RasterBrick") | is(timeseries, "RasterStack") | is(timeseries, "RasterLayer") ) - timeseries = list(timeseries) - .Object@timeseries = timeseries - if(is.null(names(.Object@timeseries))) - names(.Object@timeseries) = paste0("Layer", seq_along(.Object@timeseries)-1) - } else { - if(!missing(layers)) - names(.Object@timeseries) = layers - } - if(!missing(doy)) - .Object@timeseries = c(doy = doy, .Object@timeseries) - .Object@layers = names(.Object@timeseries) - if(!missing(labels)) - .Object@labels = as.character(labels) - if(missing(levels)) - levels = seq_along(.Object@labels) - .Object@levels = as.numeric(levels) - if(!missing(timeline)) - .Object@timeline = as.Date(timeline) - validObject(.Object) - names(.Object@timeline) = paste0("date.", format(.Object@timeline,"%Y.%m.%d")) - .Object@timeseries = lapply(.Object@timeseries, function(x) { names(x)=names(.Object@timeline); x}) - return(.Object) - } -) - - -setGeneric(name = "twdtwRaster", - def = function(..., timeline, doy=NULL, layers=NULL, labels=NULL, levels=NULL, filepath=NULL) - standardGeneric("twdtwRaster") -) - - -#' @inheritParams twdtwRaster -#' @aliases twdtwRaster-create -#' @describeIn twdtwRaster Create object of class twdtwRaster. -#' -#' @examples -#' \dontrun{ -#' # Creating objects of class twdtwRaster -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' ts_evi = twdtwRaster(evi, timeline=timeline) -#' -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -#' red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -#' nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -#' mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -#' doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -#' rts = twdtwRaster(doy, evi, ndvi, blue, red, nir, mir, timeline = timeline) -#' } -#' @export -setMethod(f = "twdtwRaster", - definition = function(..., timeline, doy, layers, labels, levels){ - arg_names = names(list(...)) - not_named = setdiff(as.character(match.call(expand.dots=TRUE)), as.character(match.call(expand.dots=FALSE))) - if(is.null(arg_names)){ - arg_names = not_named - } else { - arg_names[arg_names==""] = not_named[arg_names==""] - } - x = list(...) - names(x) = c(arg_names) - if(missing(doy)){ - if(any(arg_names %in% "doy")){ - doy = x[[which(arg_names %in% "doy")]] - x = x[which(!(arg_names %in% "doy"))] - } - } - I = which(sapply(x, is, "RasterBrick") | sapply(x, is, "RasterStack") | sapply(x, is, "RasterLayer")) - if(length(I) < 1) - stop("There are no Raster* objects in the list of arguments") - # Split arguments - timeseries = x[I] - dotargs = x[-I] - creat.twdtwRaster(timeseries=timeseries, timeline=as.Date(timeline), doy=doy, - layers=layers, labels=labels, levels=levels, dotargs=dotargs) - }) - - -creat.twdtwRaster = function(timeseries, timeline, doy, layers, labels, levels, dotargs){ - - # Check timeline - nl = sapply(c(timeseries), nlayers) - if(!is.null(doy)) - nl = c(nlayers(doy), nl) - if(any(nl!=length(timeline))) - stop("Raster objects do not have the same length as the timeline") - - res = timeseries - # Save a single file (complete time series) for each raster attribute - # if (filepath != "") { - # dir.create(filepath, showWarnings = FALSE) - # write(as.character(timeline), file = paste(filepath, "timeline", sep="/")) - # aux = res - # if(!is.null(doy)) - # aux = c(doy=doy, res) - # res_brick = lapply(names(aux), function(i){ - # filename = paste(filepath, i, sep="/") - # dotargs = c(x = aux[[i]], filename = filename, dotargs) - # r = do.call(writeRaster, dotargs) - # r - # }) - # names(res_brick) = names(aux) - # doy = NULL - # res = res_brick - # if(any(names(res)=="doy")){ - # res = res_brick[-1] - # doy = res_brick[[1]] - # } - # } - if(is.null(layers)) layers = names(res) - if(is.null(doy)) - return(new("twdtwRaster", timeseries = res, timeline = timeline, layers = layers, labels = labels, levels=levels)) - new("twdtwRaster", timeseries = res, timeline = timeline, doy=doy, layers = layers, labels = labels, levels=levels) -} - -.creat.doy = function(x, timeline){ - array_data = rep(as.numeric(format(as.Date(timeline), "%j")), each=ncell(x)) - e = extent(x) - brick(array(array_data, dim = dim(x)), xmn=e[1], xmx=e[2], ymn=e[3], ymx=e[4], crs = projection(x)) -} - - diff --git a/R/class-twdtwTimeSeries.R b/R/class-twdtwTimeSeries.R deleted file mode 100644 index 1b5a8fb..0000000 --- a/R/class-twdtwTimeSeries.R +++ /dev/null @@ -1,155 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-18 # -# # -############################################################### - -#' @title class "twdtwTimeSeries" -#' @name twdtwTimeSeries-class -#' @aliases twdtwTimeSeries -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Class for setting irregular time series. -#' -#' @param ... \code{\link[dtwSat]{twdtwTimeSeries}} objects, -#' \code{\link[zoo]{zoo}} objects or a list of \code{\link[zoo]{zoo}} objects. -#' @param labels a vector with labels of the time series. -#' @param object an object of class twdtwTimeSeries. -#' @param x an object of class twdtwTimeSeries. -#' -#' @section Slots : -#' \describe{ -#' \item{\code{timeseries}:}{A list of \code{\link[zoo]{zoo}} objects.} -#' \item{\code{labels}:}{A vector of class \code{\link[base]{factor}} with time series labels.} -#' } -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{getTimeSeries}}, and -#' \code{\link[dtwSat]{twdtwApply}} -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' # Creating a new object of class twdtwTimeSeries -#' ptt = new("twdtwTimeSeries", timeseries = MOD13Q1.patterns.list, -#' labels = names(MOD13Q1.patterns.list)) -#' class(ptt) -#' labels(ptt) -#' levels(ptt) -#' length(ptt) -#' nrow(ptt) -#' ncol(ptt) -#' dim(ptt) -NULL -setClass( - Class = "twdtwTimeSeries", - slots = c(timeseries = "list", labels = "factor"), - validity = function(object){ - if(!is(object@timeseries, "list")){ - stop("[twdtwTimeSeries: validation] Invalid timeseries object, class different from list.") - }else{} - if(any(length(object@timeseries)>1 & !sapply(object@timeseries, is.zoo))){ - stop("[twdtwTimeSeries: validation] Invalid timeseries object, class different from list of zoo objects.") - }else{} - if(!is(object@labels, "factor")){ - stop("[twdtwTimeSeries: validation] Invalid labels object, class different from character.") - }else{} - if( length(object@labels)!=0 & length(object@labels)!=length(object@timeseries) ){ - stop("[twdtwTimeSeries: validation] Invalid labels, labels and timeseries do not have the same length.") - }else{} - return(TRUE) - } -) - -setMethod("initialize", - signature = "twdtwTimeSeries", - definition = - function(.Object, timeseries, labels){ - .Object@timeseries = list() - .Object@labels = factor(NULL) - if(!missing(timeseries)){ - if(is(timeseries, "zoo")) timeseries = list(timeseries) - .Object@timeseries = timeseries - .Object@labels = factor( paste0("ts",seq_along(timeseries)) ) - if(!is.null(names(timeseries))) .Object@labels = factor(names(timeseries)) - } - if(!missing(labels)){ - .Object@labels = factor(labels) - names(.Object@timeseries) = as.character(labels) - } - validObject(.Object) - return(.Object) - } -) - -setGeneric(name = "twdtwTimeSeries", - def = function(...) standardGeneric("twdtwTimeSeries") -) - -#' @inheritParams twdtwTimeSeries-class -#' @aliases twdtwTimeSeries-create -#' -#' @describeIn twdtwTimeSeries Create object of class twdtwTimeSeries. -#' -#' @examples -#' # Creating objects of class twdtwTimeSeries from zoo objects -#' ts = twdtwTimeSeries(MOD13Q1.ts) -#' ts -#' -#' # Creating objects of class twdtwTimeSeries from list of zoo objects -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' patt -#' -#' # Joining objects of class twdtwTimeSeries -#' tsA = twdtwTimeSeries(MOD13Q1.ts.list[[1]], labels = "A") -#' tsB = twdtwTimeSeries(B = MOD13Q1.ts.list[[2]]) -#' ts = twdtwTimeSeries(tsA, tsB, C=MOD13Q1.ts) -#' ts -#' -#' @export -setMethod(f = "twdtwTimeSeries", - definition = function(..., labels=NULL){ - timeseries = list(...) - joint_timeseries = list() - timeseries_class = sapply(timeseries, class) - zoo_obj = NULL - list_obj = NULL - twdtw_obj = NULL - check_class = c("zoo", "list", "twdtwTimeSeries") %in% timeseries_class - if(check_class[1]){ - zoo_obj = timeseries[which(timeseries_class=="zoo")] - names(zoo_obj) = names(timeseries)[which(timeseries_class=="zoo")] - if(is.null(names(zoo_obj))) names(zoo_obj) = paste0("ts",seq_along(zoo_obj)) - joint_timeseries = c(joint_timeseries, zoo_obj) - } else {} - if(check_class[2]){ - list_obj = c(do.call("c", timeseries[which(timeseries_class=="list")])) - if(is.null(names(list_obj))) names(list_obj) = paste0("ts", seq_along(list_obj)) - joint_timeseries = c(joint_timeseries, list_obj) - } else {} - if(check_class[3]){ - twdtw_obj = do.call("c", lapply(timeseries[which(timeseries_class=="twdtwTimeSeries")], getTimeSeries)) - names(twdtw_obj) = as.character(unlist(lapply(timeseries[which(timeseries_class=="twdtwTimeSeries")], labels))) - joint_timeseries = c(joint_timeseries, twdtw_obj) - } else {} - if(is.null(labels)) labels = names(joint_timeseries) - new("twdtwTimeSeries", timeseries = joint_timeseries, labels = labels) - }) - - - - - diff --git a/R/createPatterns.R b/R/createPatterns.R deleted file mode 100644 index f737743..0000000 --- a/R/createPatterns.R +++ /dev/null @@ -1,173 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-18 # -# # -############################################################### - - -#' @title Create patterns -#' @name createPatterns -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Create temporal patterns from objects of class twdtwTimeSeries. -#' -#' @param x an object of class \code{\link[dtwSat]{twdtwTimeSeries}}. -#' -#' @param from A character or \code{\link[base]{Dates}} object in the format -#' "yyyy-mm-dd". If not provided it is equal to the smallest date of the -#' first element in x. See details. -#' -#' @param to A \code{\link[base]{character}} or \code{\link[base]{Dates}} -#' object in the format "yyyy-mm-dd". If not provided it is equal to the -#' greatest date of the first element in x. See details. -#' -#' @param attr A vector character or numeric. The attributes in \code{x} to be used. -#' If not declared the function uses all attributes. -#' -#' @param freq An integer. The sampling frequency of the output patterns. -#' -#' @param split A logical. If TRUE the samples are split by label. If FALSE -#' all samples are set to the same label. -#' -#' @param formula A formula. Argument to pass to \code{\link[mgcv]{gam}}. -#' -#' @param ... other arguments to pass to the function \code{\link[mgcv]{gam}} in the -#' package \pkg{mgcv}. -#' -#' @return an object of class \code{\link[dtwSat]{twdtwTimeSeries}} -#' -#' -#' @details The hidden assumption is that the temporal pattern is a cycle the repeats itself -#' within a given time interval. Therefore, all time series samples in \code{x} are aligned -#' with each other, keeping their respective sequence of days of the year. The function fits a -#' Generalized Additive Model (GAM) to the aligned set of samples. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwTimeSeries-class}}, -#' \code{\link[dtwSat]{getTimeSeries}}, and -#' \code{\link[dtwSat]{twdtwApply}} -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @export -setGeneric("createPatterns", function(x, from=NULL, to=NULL, freq=1, attr=NULL, split=TRUE, formula, ...) standardGeneric("createPatterns")) - -#' @rdname createPatterns -#' @aliases createPatterns-twdtwMatches -#' @examples -#' # Creating patterns from objects of class twdtwTimeSeries -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, timeline=timeline) -#' -#' # Read field samples -#' \dontrun{ -#' field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -#' prj_string = scan(system.file("lucc_MT/data/samples_projection", package="dtwSat"), -#' what = "character") -#' -#' # Extract time series -#' ts = getTimeSeries(rts, y = field_samples, proj4string = prj_string) -#' -#' # Create temporal patterns -#' patt = createPatterns(x=ts, from="2005-09-01", to="2006-09-01", freq=8, formula = y~s(x)) -#' -#' # Plot patterns -#' autoplot(patt[[1]], facets = NULL) + xlab("Time") + ylab("Value") -#' -#' } -#' @export -setMethod("createPatterns", "twdtwTimeSeries", - function(x, from, to, freq, attr, split, formula, ...) { - - # Get formula variables - if(!is(formula, "formula")) - stop("missing formula") - vars = all.vars(formula) - - # Split samples according to their labels - if(split) { - levels = as.character(levels(x)) - labels = as.character(labels(x)) - names(levels) = levels - x = lapply(levels, function(l) x[labels==l] ) - } else { - levels = as.character(levels(x)[1]) - labels = rep(levels, length(x)) - names(levels) = levels - x@labels = factor(labels) - x = list(x) - names(x) = levels - } - - # Create patterns - res = lapply(x, FUN = .createPattern, from=from, to=to, freq=freq, attr=attr, formula=formula, ...) - twdtwTimeSeries(res) -}) - - -.createPattern = function(x, from, to, freq, attr, formula, ...){ - - # Pattern period - if( is.null(from) | is.null(to) ){ - from = as.Date(min(index(x[[1]]))) - to = as.Date(max(index(x[[1]]))) - } - - from = as.Date(from) - to = as.Date(to) - - # Get formula variables - vars = all.vars(formula) - - # Shift dates to match the same period - df = do.call("rbind", lapply(as.list(x), function(x){ - res = shiftDates(x, year=as.numeric(format(to, "%Y"))) - res = window(res, start = from, end = to) - res = data.frame(time=index(res), res) - names(res) = c("time", names(x)) - res - })) - names(df)[1] = vars[2] - - dates = as.Date(df[[vars[2]]]) - pred_time = seq(from, to, freq) - - fun = function(y, ...){ - df = data.frame(y, as.numeric(dates)) - names(df) = vars - fit = gam(data = df, formula = formula, ...) - time = data.frame(as.numeric(pred_time)) - names(time) = vars[2] - predict.gam(fit, newdata = time) - } - - if(is.null(attr)) attr = names(df)[-which(names(df) %in% vars[2])] - - res = sapply(as.list(df[attr]), FUN=fun, ...) - zoo(data.frame(res), as.Date(pred_time)) -} - - - - - - - - - - - diff --git a/R/create_patterns.R b/R/create_patterns.R new file mode 100644 index 0000000..856d1dd --- /dev/null +++ b/R/create_patterns.R @@ -0,0 +1,146 @@ +#' Create a Pattern Using GAM +#' +#' This function creates a pattern based on Generalized Additive Models (GAM). +#' It uses the specified formula to fit the model and predict values. +#' +#' @param x A three dimensions stars object (x, y, time) with the satellite image time series. +#' @param y An sf object with the coordinates of the training points. +#' @param formula A formula for the GAM. Default is \code{band ~ \link[mgcv]{s}(time)}. +#' @param start_column Name of the column in y that indicates the start date. Default is 'start_date'. +#' @param end_column Name of the column in y that indicates the end date. Default is 'end_date'. +#' @param label_colum Name of the column in y that contains land use labels. Default is 'label'. +#' @param sampling_freq The time frequency for sampling including unit, e.g '16 day'. If NULL, the function will infer it. +#' @param ... Additional arguments passed to the GAM function. +#' +#' @return A list containing the predicted values for each label. +#' +#' +#' +#' @export +create_patterns = function(x, y, formula = band ~ s(time), start_column = 'start_date', + end_column = 'end_date', label_colum = 'label', + sampling_freq = NULL, ...){ + + # Check if x is a stars object with a time dimension + if (!inherits(x, "stars") || dim(x)['time'] < 1) { + stop("x must be a stars object with a 'time' dimension") + } + + # Check if y is an sf object with point geometry + if (!inherits(y, "sf") || !all(st_is(y, "POINT"))) { + stop("y must be an sf object with point geometry") + } + + # Check for required columns in y + required_columns <- c(start_column, end_column, label_colum) + missing_columns <- setdiff(required_columns, names(y)) + if (length(missing_columns) > 0) { + stop(paste("Missing required columns in y:", paste(missing_columns, collapse = ", "))) + } + + # Check if formula has two + if(length(all.vars(formula)) != 2) { + stop("The formula should have only one predictor!") + } + + # Convert columns to date-time + y[ , start_column] <- to_date_time(y[[start_column]]) + y[ , end_column] <- to_date_time(y[[end_column]]) + + # Extract time series from stars + y_ts <- extract_time_series(x, y) + y_ts$geom <- NULL + + # Shift dates + unique_ids <- unique(y_ts$id) + for (id in seq_along(unique_ids)) { + idx <- y_ts$id == unique_ids[id] + y_ts[idx, 'time'] <- shift_dates(y_ts[idx, 'time']) + } + + # Split data frame by label and remove label column + y_ts <- lapply(split(y_ts, y_ts$label), function(df) { + df$label <- NULL + return(df) + }) + + # Determine sampling frequency + if (is.null(sampling_freq)) { + sampling_freq <- get_stars_time_freq(x) + cat("Sampling frequency inferred from the stars object:", as.numeric(sampling_freq), attr(sampling_freq, "units"), "\n") + } + + # Define GAM function + gam_fun <- function(y, t, formula, ...){ + df <- data.frame(y, t = as.numeric(t)) + df <- setNames(list(y, as.numeric(t)), all.vars(formula)) + fit <- mgcv::gam(data = df, formula = formula, ...) + pred_t <- setNames(list(as.numeric(seq(min(t), max(t), by = sampling_freq))), all.vars(formula)[2]) + predict(fit, newdata = pred_t) + } + + # Apply GAM function + patterns <- lapply(y_ts, function(ts){ + y_time <- ts$time + ts$time <- NULL + ts$id <- NULL + sapply(as.list(ts), function(y) { + gam_fun(y, y_time, formula, ...) + }) + }) + + return(patterns) + +} + + + +#' Extract Time Series from a Stars Object for Specified Points +#' +#' This function extracts a time series from a stars object for each specified point in the sf object. +#' Each extracted sample is then labeled with an ID and the label from the sf object. +#' +#' @param x A stars object containing the raster time series data. +#' @param y An sf object containing the point geometries and their associated labels. +#' +#' @return A data.frame with the extracted time series for each point in the sf object, +#' with additional columns for the ID and label of each sample. +#' +#' +extract_time_series <- function(x, y) { + ts_samples <- st_extract(x, y) + ts_samples$id <- 1:dim(ts_samples)["geom"] + ts_samples$label <- y$label + as.data.frame(ts_samples) +} + + + +#' Compute the Most Common Sampling Frequency in a Stars Object +#' +#' This function calculates the most common difference between consecutive time points in a stars object. +#' This can be useful for determining the sampling frequency of the time series data. +#' +#' @param x A stars object containing time series data. +#' +#' @return A difftime object representing the most common time difference between consecutive samples. +#' +#' +get_stars_time_freq <- function(x) { + + # Extract the time dimension + time_values <- st_get_dimension_values(x, "time") + + # Compute the differences between consecutive time points + time_diffs <- diff(time_values) + + # Convert differences to days (while retaining the difftime class) + time_diffs <- as.difftime(time_diffs, units = "days") + + # Identify the mode + mode_val_index <- which.max(tabulate(match(time_diffs, unique(time_diffs)))) + freq <- diff(time_values[mode_val_index:(mode_val_index+1)]) + + return(freq) +} + diff --git a/R/data.R b/R/data.R deleted file mode 100644 index af40ca9..0000000 --- a/R/data.R +++ /dev/null @@ -1,151 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2015-09-01 # -# # -############################################################### - - -############################################################### -#### DATASET DOCUMENTATION - - -#' @title Data: patterns time series -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This dataset has a list of patterns with the phenological cycle of: Soybean, -#' Cotton, and Maize. These time series are based on the MODIS product -#' MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. The patterns were built -#' from ground truth samples of each -#' crop using Generalized Additive Models (GAM), see \link[dtwSat]{createPatterns}. -#' -#' @docType data -#' @format A named \code{list} of three \link[zoo]{zoo} objects, ''Soybean'', ''Cotton'', -#' and ''Maize'', whose indices are \code{\link[base]{Dates}} in the format ''yyyy-mm-dd''. -#' Each node has 6 attributes: ''ndvi'', ''evi'', ''red'', ''nir'', ''blue'', -#' and ''mir''. -#' -#' @seealso -#' \link[dtwSat]{MOD13Q1.ts}, -#' \link[dtwSat]{MOD13Q1.ts.list}, and -#' \link[dtwSat]{createPatterns}. -#' -#' @seealso For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -#' -#' @references -#' \insertAllCited{} -#' -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} - -#' -"MOD13Q1.patterns.list" - - -#' @title Data: An example of satellite time series -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This dataset has a time series based on the -#' MODIS product MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. -#' It is an irregularly sampled time series -#' using the real date of each pixel from ''2009-08-05'' to ''2013-07-31''. -#' -#' @docType data -#' @format A \link[zoo]{zoo} object, whose indices are \code{\link[base]{Dates}} -#' in the format ''yyyy-mm-dd''. Each node has 6 attributes: ''ndvi'', -#' ''evi'', ''red'', ''nir'', ''blue'', and ''mir''. -#' -#' @seealso -#' \link[dtwSat]{MOD13Q1.ts.list}, -#' \link[dtwSat]{MOD13Q1.patterns.list}. -#' -#' -#' @seealso For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -#' -#' @references -#' \insertAllCited{} -#' -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} - -#' -"MOD13Q1.ts" - -#' @title Data: Labels of the satellite time series in MOD13Q1.ts -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description These labels are based on field work. -#' -#' @docType data -#' @format An object of class \link[base]{data.frame}, whose attributes are: -#' the label of the crop class ''label'', the start of the crop period ''from'', -#' and the end of the crop period ''to''. The dates are in the format ''yyyy-mm-dd''. -#' -#' @seealso -#' \link[dtwSat]{MOD13Q1.ts}. -#' -"MOD13Q1.ts.labels" - -#' @title Data: A list of satellite time series -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This dataset has a list of time series based on the -#' MODIS product MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. -#' It is an irregularly sampled time series -#' using the real date of each pixel from ''2009-08-05'' to ''2013-07-31''. -#' -#' @docType data -#' @format A \link[zoo]{zoo} object, whose indices are \code{\link[base]{Dates}} -#' in the format ''yyyy-mm-dd''. Each node has 6 attributes: ''ndvi'', -#' ''evi'', ''red'', ''nir'', ''blue'', and ''mir''. -#' -#' @seealso -#' \link[dtwSat]{MOD13Q1.ts}, and -#' \link[dtwSat]{MOD13Q1.patterns.list}. -#' -#' -#' @seealso For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -#' -#' @references -#' \insertAllCited{} -#' -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} - -#' -"MOD13Q1.ts.list" - -#' @title Data: Pattern time series -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This dataset has a list of patterns with the phenological cycle of: Water, -#' Cotton-Fallow, Forest, Low vegetation, Pasture, Soybean-Cotton, Soybean-Maize, Soybean-Millet, -#' Soybean-Sunflower, and Wetland. These time series are based on the MODIS product -#' MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. -#' The patterns were built from ground truth samples of each -#' crop using Generalized Additive Models (GAM), see \link[dtwSat]{createPatterns}. -#' -#' @docType data -#' @format A \link[dtwSat]{twdtwTimeSeries} object. -#' -#' @seealso For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -#' -#' @references -#' \insertAllCited{} -#' -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -"MOD13Q1.MT.yearly.patterns" - diff --git a/R/dtw.R b/R/dtw.R deleted file mode 100644 index 6b80399..0000000 --- a/R/dtw.R +++ /dev/null @@ -1,134 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# call Fortran DTW inplementation - 2015-10-27 # -# # -############################################################### - - -# @useDynLib dtwSat computecost -.computecost = function(cm, step.matrix){ - - cm = rbind(0, cm) - n = nrow(cm) - m = ncol(cm) - - if(is.loaded("computecost", PACKAGE = "dtwSat", type = "Fortran")){ - out = .Fortran(computecost, - CM = matrix(as.double(cm), n, m), - DM = matrix(as.integer(0), n, m), - VM = matrix(as.integer(0), n, m), - SM = matrix(as.integer(step.matrix), nrow(step.matrix), ncol(step.matrix)), - N = as.integer(n), - M = as.integer(m), - NS = as.integer(nrow(step.matrix))) - } else { - stop("Fortran computecost lib is not loaded") - } - - res = list() - res$costMatrix = out$CM[-1,] - res$directionMatrix = out$DM[-1,] - res$startingMatrix = out$VM[-1,] - res$stepPattern = step.matrix - res$N = n - 1 - res$M = m - res -} - - -# @useDynLib dtwSat tracepath -.tracepath = function(dm, step.matrix, jmin){ - - n = nrow(dm) - m = ncol(dm) - if(is.null(jmin)) - jmin = m - - if(is.loaded("tracepath", PACKAGE = "dtwSat", type = "Fortran")){ - aloc = length(jmin)*10*n - paths = .Fortran(tracepath, - DM = matrix(as.integer(dm), n, m), - SM = matrix(as.integer(step.matrix), nrow(step.matrix), ncol(step.matrix)), - JMIN = as.vector(as.integer(jmin)), - IND1 = rep(as.integer(0), aloc), - IND2 = rep(as.integer(0), aloc), - POS = as.vector(rep(as.integer(0),length(jmin)+1)), - N = as.integer(n), - M = as.integer(m), - NS = as.integer(nrow(step.matrix)), - NJ = as.integer(length(jmin)), - AL = as.integer(aloc)) - - res = lapply(seq_along(paths$POS)[-1], function(p){ - I = (paths$POS[p]:((paths$POS[p-1])+1)) - # -I[1] removes first row in the matrix which was created artificially - list(index1 = paths$IND1[I][-I[1]], index2 = paths$IND2[I][-tail(I, 1)]) - }) - }else{ - stop("Fortran tracepath lib is not loaded") - } - - res -} - -# @useDynLib dtwSat bestmatches -.bestmatches = function(x, m, n, levels, breaks, overlap, fill=9999){ - if(is.loaded("bestmatches", PACKAGE = "dtwSat", type = "Fortran")){ - if(length(x[[1]]$distance)<1){ - res = list( - XM = matrix(as.integer(c(as.numeric(x[[1]]$from), as.numeric(x[[1]]$to))), ncol = 2), - AM = matrix(as.double(fill), nrow = n, ncol = m), - DM = as.double(x[[1]]$distance), - DP = as.integer(as.numeric(breaks)), - X = as.integer(match(x[[1]]$label, levels)), - IM = matrix(as.integer(0), nrow = n, ncol = 3), - DB = as.double(x[,2]), - A = as.integer(x[[1]]$Alig.N), - K = as.integer(length(x)), - P = as.integer(length(breaks)), - L = as.integer(length(levels)), - OV = as.double(overlap)) - } else { - res = try(.Fortran(bestmatches, - XM = matrix(as.integer(c(as.numeric(x[[1]]$from), as.numeric(x[[1]]$to))), ncol = 2), - AM = matrix(as.double(fill), nrow = n, ncol = m), - DM = as.double(x[[1]]$distance), - DP = as.integer(as.numeric(breaks)), - X = as.integer(match(x[[1]]$label, levels)), - IM = matrix(as.integer(0), nrow = n, ncol = 3), - DB = as.double(rep(0, n)), - A = as.integer(x[[1]]$Alig.N), - K = as.integer(length(x[[1]]$Alig.N)), - P = as.integer(length(breaks)), - L = as.integer(length(levels)), - OV = as.double(overlap))) - } - } else { - stop("Fortran bestmatches lib is not loaded") - } - if(is(res, "try-error")){ - res = list( - XM = matrix(as.integer(c(as.numeric(x[[1]]$from), as.numeric(x[[1]]$to))), ncol = 2), - AM = array(as.double(fill), dim=c(n, m)), - DM = as.double(x[[1]]$distance), - DP = as.integer(as.numeric(breaks)), - X = as.integer(match(x[[1]]$label, levels)), - IM = matrix(as.integer(0), nrow = n, ncol = 3), - DB = as.double(x[,2]), - A = as.integer(x[[1]]$Alig.N), - K = as.integer(length(x)), - P = as.integer(length(breaks)), - L = as.integer(length(levels)), - OV = as.double(overlap) - ) - } - res -} diff --git a/R/dwtSat.R b/R/dwtSat.R deleted file mode 100644 index d352d15..0000000 --- a/R/dwtSat.R +++ /dev/null @@ -1,35 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-07-14 # -# # -############################################################### - -#' @title Time-Weighted Dynamic Time Warping for Satellite Image Time Series -#' @name dtwSat -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Provides an implementation of the Time-Weighted Dynamic Time Warping -#' (TWDTW) method for land use and land cover mapping using satellite image time series -#' \insertCite{Maus:2016,Maus:2019}{dtwSat}. -#' TWDTW is based on the Dynamic Time Warping technique and has achieved high accuracy -#' for land use and land cover classification using satellite data. The method is based -#' on comparing unclassified satellite image time series with a set of known temporal -#' patterns (e.g. phenological cycles associated with the vegetation). Using 'dtwSat' -#' the user can build temporal patterns for land cover types, apply the TWDTW analysis -#' for satellite datasets, visualize the results of the time series analysis, produce -#' land cover maps, and create temporal plots for land cover change analysis. -#' -#' @references -#' \insertAllCited{} -#' -#' @seealso \code{\link[dtwSat]{twdtwApply}} -#' -NULL \ No newline at end of file diff --git a/R/getInternals.R b/R/getInternals.R deleted file mode 100644 index bbc0740..0000000 --- a/R/getInternals.R +++ /dev/null @@ -1,84 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-18 # -# # -############################################################### - -setGeneric("getInternals", function(object, timeseries.labels=NULL, patterns.labels=NULL) standardGeneric("getInternals")) -setGeneric("getAlignments", function(object, timeseries.labels=NULL, patterns.labels=NULL) standardGeneric("getAlignments")) -setGeneric("getMatches", function(object, timeseries.labels=NULL, patterns.labels=NULL) standardGeneric("getMatches")) - -#' @title Get elements from twdtwMatches objects -#' @name get -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Get elements from \code{\link[dtwSat]{twdtwMatches-class}} objects. -#' -#' @inheritParams twdtwMatches-class -#' @param timeseries.labels a vector with labels of the time series. -#' @param patterns.labels a vector with labels of the patterns. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, and -#' \code{\link[dtwSat]{twdtwApply}} -#' -#' @examples -#' # Getting patterns from objects of class twdtwMatches -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' mat = twdtwApply(x=ts, y=patt, weight.fun=logisticWeight(-0.1,100), -#' keep=TRUE, legacy = TRUE) -#' getPatterns(mat) -#' getTimeSeries(mat) -#' getAlignments(mat) -#' getMatches(mat) -#' getInternals(mat) -#' -#' @return a list with TWDTW results or an object \code{\link[dtwSat]{twdtwTimeSeries-class}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' -NULL - -#' @aliases getAlignments -#' @inheritParams get -#' @rdname get -#' @export -setMethod("getAlignments", c("twdtwMatches","ANY","ANY"), - function(object, timeseries.labels, patterns.labels) - getAlignments.twdtwMatches(object, timeseries.labels, patterns.labels, attr = c("label", "from", "to", "distance", "K")) ) - -#' @aliases getInternals -#' @inheritParams get -#' @rdname get -#' @export -setMethod("getInternals", c("twdtwMatches","ANY","ANY"), - function(object, timeseries.labels, patterns.labels) - getAlignments.twdtwMatches(object, timeseries.labels, patterns.labels, attr = c("internals")) ) - -#' @aliases getMatches -#' @inheritParams get -#' @rdname get -#' @export -setMethod("getMatches", c("twdtwMatches","ANY","ANY"), - function(object, timeseries.labels, patterns.labels) - getAlignments.twdtwMatches(object, timeseries.labels, patterns.labels, attr = c("matching")) ) - -getAlignments.twdtwMatches = function(object, timeseries.labels, patterns.labels, attr){ - if(is.null(timeseries.labels)) timeseries.labels = labels(object@timeseries) - if(is.null(patterns.labels)) patterns.labels = labels(object@patterns) - res = object[timeseries.labels, patterns.labels, drop=FALSE] - lapply(res, function(x) lapply(x, function(x) x[attr]) ) -} \ No newline at end of file diff --git a/R/getMatchingDates.R b/R/getMatchingDates.R deleted file mode 100644 index a590f48..0000000 --- a/R/getMatchingDates.R +++ /dev/null @@ -1,18 +0,0 @@ -getMatchingDates <- function(x){ - - best_aligs <- x$internals$alignments[x$internals$alignments[,6]==1,,drop=FALSE] - best_aligs <- best_aligs[order(best_aligs[,1]),,drop=FALSE] - - out <- lapply(1:nrow(best_aligs), function(i){ - ts_id <- best_aligs[i,5] - idx <- as.data.frame(.tracepath(dm = x$internals$internals[[ts_id]]$DM, - step.matrix = x$internals$internals[[ts_id]]$SM, - jmin = best_aligs[i,3])) - idx$patternDates <- x$internals$internals[[ts_id]]$patternDates[idx$index1] - idx$tsDates <- x$internals$internals[[ts_id]]$tsDates[idx$index2] - return(idx) - }) - - return(out) - -} diff --git a/R/getTimeSeries.R b/R/getTimeSeries.R deleted file mode 100644 index 2bec0d6..0000000 --- a/R/getTimeSeries.R +++ /dev/null @@ -1,195 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-18 # -# # -############################################################### - -setGeneric("getTimeSeries", function(object, ...) standardGeneric("getTimeSeries")) -setGeneric("getPatterns", function(object, ...) standardGeneric("getPatterns")) - -#' @title Get time series from twdtw* objects -#' @name getTimeSeries -#' @aliases getPatterns -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Get time series from objects of class twdtw*. -#' -#' @param object an object of class twdtw*. -#' -#' @param y a \code{\link[base]{data.frame}} whose attributes are: longitude, -#' latitude, the start ''from'' and the end ''to'' of the time interval -#' for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} -#' whose attributes are the start ''from'' and the end ''to'' of the time interval. -#' If missing ''from'' and/or ''to'', they are set to the time range of the -#' \code{object}. -#' -#' @param id.labels a numeric or character with an column name from \code{y} to -#' be used as sample labels. Optional. -#' -#' @param labels character vector with time series labels. For signature -#' \code{\link[dtwSat]{twdtwRaster}} this argument can be used to set the -#' labels for each sample in \code{y}, or it can be combined with \code{id.labels} -#' to select samples with a specific label. -#' -#' @param proj4string projection string, see \code{\link[sp]{CRS-class}}. Used -#' if \code{y} is a \code{\link[base]{data.frame}}. -#' -#' @return An object of class \code{\link[dtwSat]{twdtwTimeSeries}}. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{twdtwTimeSeries-class}}, and -#' \code{\link[dtwSat]{twdtwMatches-class}} -#' -#' @return a list with TWDTW results or an object \code{\link[dtwSat]{twdtwTimeSeries-class}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' # Getting time series from objects of class twdtwTimeSeries -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' getTimeSeries(ts, 2) -#' # Getting time series from objects of class twdtwTimeSeries -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat = twdtwApply(x=ts, y=patt, keep=TRUE, legacy=TRUE) -#' getTimeSeries(mat, 2) -#' -#' ## This example creates a twdtwRaster object and extract time series from it. -#' -#' # Creating objects of class twdtwRaster with evi and ndvi time series -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, timeline=timeline) -#' -#' # Location and time range -#' ts_location = data.frame(longitude = -55.96957, latitude = -12.03864, -#' from = "2007-09-01", to = "2013-09-01") -#' prj_string = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0" -#' -#' # Extract time series -#' ts = getTimeSeries(rts, y = ts_location, proj4string = prj_string) -#' -#' autoplot(ts[[1]], facets = NULL) + xlab("Time") + ylab("Value") -#' -NULL - - -#' @aliases getTimeSeries-twdtwTimeSeries -#' @inheritParams getTimeSeries -#' @rdname getTimeSeries -#' @export -setMethod("getTimeSeries", "twdtwTimeSeries", - function(object, labels=NULL) getTimeSeries.twdtwTimeSeries(object=object, labels=labels) ) - -#' @aliases getTimeSeries-twdtwMatches -#' @inheritParams getTimeSeries -#' @rdname getTimeSeries -#' @export -setMethod("getTimeSeries", "twdtwMatches", - function(object, labels=NULL) getTimeSeries(object=object@timeseries, labels=labels) ) - - -#' @aliases getPatterns-twdtwMatches -#' @inheritParams getTimeSeries -#' @rdname getTimeSeries -#' @export -setMethod("getPatterns", "twdtwMatches", - function(object, labels=NULL) getTimeSeries(object=object@patterns, labels=labels) ) - -# Get time series from object of class twdtwTimeSeries by labels -getTimeSeries.twdtwTimeSeries = function(object, labels){ - res = subset(object, labels) - res@timeseries -} - -#' @aliases getTimeSeries-twdtwRaster -#' @inheritParams getTimeSeries -#' @rdname getTimeSeries -#' @export -setMethod("getTimeSeries", "twdtwRaster", - function(object, y, labels=NULL, proj4string = NULL, id.labels=NULL){ - - y = .adjustLabelID(y, labels, id.labels) - - if(!"from"%in%names(y)) - y$from = as.Date(index(object)[1]) - if(!"to"%in%names(y)) - y$to = as.Date(tail(index(object),1)) - - y = .toSpatialPointsDataFrame(y, object, proj4string) - - extractTimeSeries.twdtwRaster(object, y) - }) - -extractTimeSeries.twdtwRaster = function(x, y){ - - # Reproject points to raster projection - y = spTransform(y, CRS(projection(x@timeseries[[1]]))) - # Check if the coordinates are over the raster extent - pto = .getPointsOverRaster(x, y) - if(length(pto)<1) - stop("Extents do not overlap") - if(length(pto) # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-19 # -# # -############################################################### - - -#' @title Linear weight function -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Builds a linear time weight -#' function to compute the TWDTW local cost matrix [1]. -#' -#' @param a numeric. The slop of the line. -#' @param b numeric. The intercept of the line. -#' -#' @docType methods -#' @return A \code{\link[base]{function}} object. -#' -#' @details The linear \code{linearWeight} and \code{logisticWeight} weight functions -#' can be passed to \code{\link[dtwSat]{twdtwApply}} through the argument \code{weight.fun}. -#' This will add a time-weight to the dynamic time warping analysis. The time weight -#' creates a global constraint useful to analyse time series with phenological cycles -#' of vegetation that are usually bound to seasons. In previous studies by -#' \insertCite{Maus:2016;textual}{dtwSat} the logistic weight had better results than the -#' linear for land cover classification. See \insertCite{Maus:2016;textual}{dtwSat} and -#' \insertCite{Maus:2019;textual}{dtwSat}. -#' -#' @seealso \code{\link[dtwSat]{twdtwApply}} -#' -#' @references -#' \insertAllCited{} -#' -#' @examples -#' lin_fun = linearWeight(a=0.1) -#' lin_fun -#' -#' @export -linearWeight = function(a, b=0){ - function(phi, psi) phi + a*psi + b -} - diff --git a/R/logisticWeight.R b/R/logisticWeight.R deleted file mode 100644 index f36764e..0000000 --- a/R/logisticWeight.R +++ /dev/null @@ -1,50 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Logistic weight function -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Builds a logistic time weight -#' function to compute the TWDTW local cost matrix [1]. -#' -#' @param alpha numeric. The steepness of logistic weight. -#' @param beta numeric. The midpoint of logistic weight. -#' -#' @docType methods -#' @return A \code{\link[base]{function}} object. -#' -#' @details The linear \code{linearWeight} and \code{logisticWeight} weight functions -#' can be passed to \code{\link[dtwSat]{twdtwApply}} through the argument \code{weight.fun}. -#' This will add a time-weight to the dynamic time warping analysis. The time weight -#' creates a global constraint useful to analyze time series with phenological cycles -#' of vegetation that are usually bound to seasons. In previous studies by -#' \insertCite{Maus:2016;textual}{dtwSat} the logistic weight had better results than the -#' linear for land cover classification. See \insertCite{Maus:2016;textual}{dtwSat} and -#' \insertCite{Maus:2019;textual}{dtwSat}. -#' -#' @seealso \code{\link[dtwSat]{twdtwApply}} -#' -#' @references -#' \insertAllCited{} -#' -#' @examples -#' log_fun = logisticWeight(alpha=-0.1, beta=100) -#' log_fun -#' -#' @export -logisticWeight = function(alpha, beta){ - function(phi, psi) phi + 1 / (1 + exp(alpha * (psi - beta ))) -} - diff --git a/R/methods.R b/R/methods.R deleted file mode 100644 index 8ecc054..0000000 --- a/R/methods.R +++ /dev/null @@ -1,630 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-22 # -# # -############################################################### - -setGeneric("layers", - function(x) standardGeneric("layers")) - -setGeneric("index", - function(x) standardGeneric("index")) - -setGeneric("coverages", - function(x) standardGeneric("coverages")) - -setGeneric("as.twdtwTimeSeries", - function(x) standardGeneric("as.twdtwTimeSeries")) - -setGeneric("bands", - function(x) standardGeneric("bands")) - -setGeneric("is.twdtwTimeSeries", - function(x) standardGeneric("is.twdtwTimeSeries")) - -setGeneric("is.twdtwMatches", - function(x) standardGeneric("is.twdtwMatches")) - -setGeneric("is.twdtwRaster", - function(x) standardGeneric("is.twdtwRaster")) - -setGeneric("projecttwdtwRaster", - function(x, ...) standardGeneric("projecttwdtwRaster")) - -as.data.frame.twdtwTimeSeries <- function(x){ - lapply(x[], function(y){ - out <- data.frame(date = index(y), y) - rownames(out) <- NULL - return(out) - }) -} - -as.list.twdtwTimeSeries = function(x) lapply(seq_along(x), function(i) - new("twdtwTimeSeries", x[[i]], labels(x)[i]) ) - -as.list.twdtwRaster = function(x) { - I = coverages(x) - names(I) = I - lapply(I, function(i) x[[i]]) -} - -as.list.twdtwMatches = function(x) lapply(seq_along(x@timeseries), function(i) - new("twdtwMatches", new("twdtwTimeSeries", x@timeseries[[i]], labels(x@timeseries)[i]), x@patterns, list(x@alignments[[i]])) ) - -dim.twdtwTimeSeries = function(x){ - res = data.frame(as.character(labels(x)), t(sapply(x@timeseries, dim))) - names(res) = c("label", "nrow", "ncol") - row.names(res) = NULL - res -} - -dim.twdtwRaster = function(x){ - res = c(nlayers(x), dim=dim(x@timeseries[[1]])) - names(res) = c("nlayers", "nrow", "ncol", "ntime") - res -} - -res.twdtwRaster = function(x){ - res(x@timeseries[[1]]) -} - -extent.twdtwRaster = function(x){ - extent(x@timeseries[[1]]) -} - -writeRaster.twdtwRaster = function(x, filepath, ...){ - lapply(names(x@timeseries), function(i) writeRaster(x@timeseries[[i]], filename = paste0(filepath, "/", i, ".grd"), ...)) -} - -ncol.twdtwRaster = function(x){ - ncol(x@timeseries[[1]]) -} - -nrow.twdtwRaster = function(x){ - nrow(x@timeseries[[1]]) -} - -nlayers.twdtwRaster = function(x){ - length(coverages(x)) -} - -levels.twdtwRaster = function(x){ - x@levels -} - -layers.twdtwRaster = function(x){ - x@layers -} - -coverages.twdtwRaster = function(x){ - x@layers -} - -bands.twdtwRaster = function(x){ - x@layers -} - -names.twdtwRaster = function(x){ - names(x@timeline) -} - -length.twdtwRaster = function(x){ - nlayers(x) -} - -index.twdtwRaster = function(x){ - x@timeline -} - -index.twdtwTimeSeries = function(x){ - lapply(x@timeseries, index) -} - -index.twdtwMatches = function(x){ - lapply(getTimeSeries(x), index) -} - -length.twdtwTimeSeries = function(x){ - length(x@timeseries) -} - -length.twdtwMatches = function(x){ - if(length(x@alignments)<1) return(x@alignments) - sum(sapply(x[], nrow)) -} - -nrow.twdtwTimeSeries = function(x){ - res = sapply(x@timeseries, nrow) - names(res) = as.character(labels(x)) - res -} - -ncol.twdtwTimeSeries = function(x){ - res = sapply(x@timeseries, ncol) - names(res) = as.character(labels(x)) - res -} - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod(f = "dim", "twdtwTimeSeries", - definition = dim.twdtwTimeSeries) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "dim", "twdtwRaster", - definition = dim.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "res", "twdtwRaster", - definition = res.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "extent", "twdtwRaster", - definition = extent.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod("writeRaster", "twdtwRaster", - definition = function(x, filepath = ".", ...) { - writeRaster.twdtwRaster(x, filepath, ...) - } -) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "ncol", "twdtwRaster", - definition = ncol.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "nrow", "twdtwRaster", - definition = nrow.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "nlayers", "twdtwRaster", - definition = nlayers.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "levels", "twdtwRaster", - definition = levels.twdtwRaster) - -#' @aliases layers -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "layers", "twdtwRaster", - definition = layers.twdtwRaster) - -#' @aliases coverages -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "coverages", "twdtwRaster", - definition = coverages.twdtwRaster) - -#' @aliases bands -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "bands", "twdtwRaster", - definition = bands.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "names", "twdtwRaster", - definition = names.twdtwRaster) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "index", "twdtwRaster", - definition = index.twdtwRaster) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod(f = "index", "twdtwTimeSeries", - definition = index.twdtwTimeSeries) - -#' @inheritParams twdtwMatches-class -#' @rdname twdtwMatches-class -#' @export -setMethod(f = "index", "twdtwMatches", - definition = index.twdtwMatches) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod(f = "nrow", "twdtwTimeSeries", - definition = nrow.twdtwTimeSeries) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod(f = "ncol", "twdtwTimeSeries", - definition = ncol.twdtwTimeSeries) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "length", signature = signature("twdtwRaster"), - definition = length.twdtwRaster) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod(f = "length", signature = signature("twdtwTimeSeries"), - definition = length.twdtwTimeSeries) - -#' @inheritParams twdtwMatches-class -#' @rdname twdtwMatches-class -#' @export -setMethod(f = "length", signature = signature("twdtwMatches"), - definition = length.twdtwMatches) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod("as.list", "twdtwTimeSeries", as.list.twdtwTimeSeries) - -#' @inheritParams twdtwMatches-class -#' @rdname twdtwMatches-class -#' @export -setMethod("as.list", "twdtwMatches", as.list.twdtwMatches) - -#' @inheritParams twdtwMatches-class -#' @rdname twdtwMatches-class -#' @export -setMethod("as.list", "twdtwRaster", as.list.twdtwRaster) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod("as.data.frame", "twdtwTimeSeries", as.data.frame.twdtwTimeSeries) - -#' @inheritParams twdtwTimeSeries-class -#' @param i indices of the time series. -#' @rdname twdtwTimeSeries-class -#' @export -setMethod("[", "twdtwTimeSeries", function(x, i) { - if(missing(i)) i = 1:length(x) - if(any(is.na(i))) stop("NA index not permitted") - x@timeseries[i] -}) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod("[[", "twdtwTimeSeries", function(x, i) { - if(any(is.na(i))) stop("NA index not permitted") - x@timeseries[[i, drop=FALSE]] -}) - -#' @inheritParams twdtwRaster-class -#' @param i indices of the time series. -#' @rdname twdtwRaster-class -#' @export -setMethod("[", "twdtwRaster", function(x, i) { - if(missing(i)) i = 2:nlayers(x) - if(length(i)>1) i = i[i>1] - if(any(i > nlayers(x))) - stop("subscript out of bounds") - if(any(is.na(i))) stop("NA index not permitted") - if(any("doy"==layers(x))) - return(new("twdtwRaster", timeseries=x@timeseries[i], timeline = x@timeline, doy = x@timeseries[[1]])) - new("twdtwRaster", timeseries=x@timeseries[i], timeline = x@timeline) -}) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod("[[", "twdtwRaster", function(x, i) { - if(any(is.na(i))) stop("NA index not permitted") - x@timeseries[[i]] -}) - -#' @inheritParams twdtwMatches-class -#' @param i indices of the time series. -#' @param j indices of the pattern. -#' @param drop if TRUE returns a data.frame, if FALSE returns a list. -#' Default is TRUE. -#' @rdname twdtwMatches-class -#' @export -setMethod("[", "twdtwMatches", function(x, i, j, drop=TRUE) { - if(length(x@alignments)<1) return(x@alignments) - if(missing(i)) i = 1:length(x@alignments) - # if(missing(j)) j = 2:length(x@patterns) - if(any(is.na(i))) stop("NA index not permitted") - if(is(i, "character")) i = match(i, names(x@timeseries@timeseries)) - res = x@alignments[i] - if(missing(j)) j = 1:length(res[[1]]) - if(is(j, "character")) j = match(j, names(x@patterns@timeseries)) - if(any(is.na(j))) stop("NA index not permitted") - res = lapply(res, function(x) x[j]) - res = res[sapply(res, length)>0] - if(!drop) return(res) - lapply(res, function(x){ - res = do.call("rbind", lapply(seq_along(x), function(jj){ - data.frame(Alig.N=seq_along(x[[jj]]$distance),from=x[[jj]]$from, to=x[[jj]]$to, distance=x[[jj]]$distance, label=x[[jj]]$label, row.names=NULL) - })) - res[order(res$from),] - }) -}) - -#' @inheritParams twdtwMatches-class -#' @rdname twdtwMatches-class -#' @export -setMethod("[[", c("twdtwMatches", "numeric"), function(x, i, j,drop=TRUE) { - if(any(is.na(i))) stop("NA index not permitted") - if(missing(j)) j = 1:length(x@alignments[[1]]) - x[i,j,drop=drop][[1]] -}) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod("labels", signature = signature(object="twdtwTimeSeries"), - definition = function(object) as.character(object@labels)) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod("levels", "twdtwTimeSeries", - definition = function(x) levels(factor(labels(x)))) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod("labels", signature = signature(object="twdtwRaster"), - definition = function(object) as.character(object@labels)) - -#' @inheritParams twdtwMatches-class -#' @rdname twdtwMatches-class -#' @export -setMethod("labels", - signature = signature(object="twdtwMatches"), - definition = function(object){ - list(timeseries = labels(object@timeseries), - patterns = labels(object@patterns)) - } -) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @param y Extent object, or any object from which an Extent object can be extracted. -#' @export -setMethod("crop", - signature = signature("twdtwRaster"), - definition = function(x, y, ...){ - x@timeseries = lapply(x@timeseries, crop, y=y, ...) - x - } -) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @param obj object of class twdtwRaster. -#' @export -setMethod("coordinates", - signature = signature("twdtwRaster"), - definition = function(obj, ...){ - coordinates(obj@timeseries[[1]], ...) - } -) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod("extent", - signature = signature("twdtwRaster"), - definition = function(x, y, ...){ - extent(x@timeseries[[1]]) - } -) - -# Show objects of class twdtwTimeSeries -show.twdtwTimeSeries = function(object){ - cat("An object of class \"twdtwTimeSeries\"\n") - cat("Slot \"timeseries\" length:",length(object),"\n") - cat("Slot \"labels\": ") - I = match(1:3, seq_along(labels(object))) - print(labels(object)[na.omit(I)]) - invisible(NULL) -} - -# Show objects of class twdtwMatches -show.twdtwMatches = function(object){ - cat("An object of class \"twdtwMatches\"\n") - cat("Number of time series:",length(object@timeseries),"\n") - cat("Number of alignments:",length(object),"\n") - cat("Patterns labels:",as.character(labels(object@patterns)),"\n") - invisible(NULL) -} - -# Show objects of class twdtwRaster -show.twdtwRaster = function(object){ - cat("An object of class \"twdtwRaster\"\n") - cat("Time series layers:",coverages(object),"\n") - cat("Time range:",paste(min(object@timeline)),"...",paste(max(object@timeline)),"\n") - cat("Dimensions:",dim(object),"(nlayers, nrow, ncol, length)\n") - cat("Resolution:",res(object)," (x, y)\n") - cat("Extent :",as.vector(extent(object)), "(xmin, xmax, ymin, ymax)\n") - cat("Coord.ref.:",projection(object@timeseries[[1]]),"\n") - invisible(NULL) -} - -# Show objects of class twdtwAssessment -show.twdtwAssessment = function(object){ - cat("An object of class \"twdtwAssessment\"\n") - cat("Number of classification intervals:",length(object@accuracyByPeriod),"\n") - cat("Accuracy metrics summary\n") - cat("\nOverall\n") - aux = object@accuracySummary$OverallAccuracy - names(aux) = gsub("ci", "ci*", names(aux)) - print(aux, digits=2) - cat("\nUser's\n") - aux = object@accuracySummary$UsersAccuracy - colnames(aux) = gsub("ci", "ci*", colnames(aux)) - print(aux, digits=2) - cat("\nProducer's\n") - aux = object@accuracySummary$ProducersAccuracy - colnames(aux) = gsub("ci", "ci*", colnames(aux)) - print(aux, digits=2) - cat("\nArea and uncertainty\n") - aux = object@accuracySummary$AreaUncertainty - colnames(aux) = gsub("ci", "ci*", colnames(aux)) - print(aux, digits=2) - cat("\n*",100*object@accuracySummary$conf.int,"% confidence interval\n") - invisible(NULL) -} - -# Show objects of class twdtwCrossValidation -show.twdtwCrossValidation = function(object){ - res = summary(object, conf.int=.95) - cat("An object of class \"twdtwCrossValidation\"\n") - cat("Number of data partitions:",length(object@partitions),"\n") - cat("Accuracy metrics using bootstrap simulation (CI .95)\n") - cat("\nOverall\n") - print(res$Overall, digits=2) - cat("\nUser's\n") - print(res$Users, digits=2) - cat("\nProducer's\n") - print(res$Producers, digits=2) - invisible(NULL) -} - -# Project raster which belongs to a twdtwRaster object -projecttwdtwRaster.twdtwRaster = function(x, to, ...){ - x@timeseries = lapply(x@timeseries, projectRaster, to, ...) - x -} - -summary.twdtwCrossValidation = function(object, conf.int=.95, ...){ - - ov = do.call("rbind", lapply(object@accuracy, function(x){ - data.frame(OV=x$OverallAccuracy, row.names = NULL) - })) - - uapa = do.call("rbind", lapply(object@accuracy, function(x){ - data.frame(label=names(x$UsersAccuracy), UA=x$UsersAccuracy, PA=x$ProducersAccuracy, row.names = NULL) - })) - - sd_ov = sd(ov[, c("OV")]) - sd_uapa = aggregate(uapa[, c("UA","PA")], list(uapa$label), sd) - l_names = unique(uapa$label) - names(l_names) = l_names - ic_ov = mean_cl_boot(x = ov[, c("OV")], conf.int = conf.int, ...) - names(ic_ov) = NULL - assess_ov = unlist(c(Accuracy=ic_ov[1], sd=sd_ov, CImin=ic_ov[2], CImax=ic_ov[3])) - ic_ua = t(sapply(l_names, function(i) mean_cl_boot(x = uapa$UA[uapa$label==i], conf.int = conf.int, ...))) - names(ic_ua) = NULL - assess_ua = data.frame(Accuracy=unlist(ic_ua[,1]), sd=sd_uapa[,"UA"], CImin=unlist(ic_ua[,2]), CImax=unlist(ic_ua[,3])) - ic_pa = t(sapply(l_names, function(i) mean_cl_boot(x = uapa$PA[uapa$label==i], conf.int = conf.int, ...))) - names(ic_pa) = NULL - assess_pa = data.frame(Accuracy=unlist(ic_pa[,1]), sd=sd_uapa[,"PA"], CImin=unlist(ic_pa[,2]), CImax=unlist(ic_pa[,3])) - list(Overall=assess_ov, Users=assess_ua, Producers=assess_pa) -} - -#' @inheritParams twdtwCrossValidation-class -#' @rdname twdtwCrossValidation-class -#' @export -setMethod(f = "show", "twdtwCrossValidation", - definition = show.twdtwCrossValidation) - -#' @inheritParams twdtwAssessment-class -#' @rdname twdtwAssessment-class -#' @export -setMethod(f = "show", "twdtwAssessment", - definition = show.twdtwAssessment) - -#' @inheritParams twdtwCrossValidation-class -#' @rdname twdtwCrossValidation-class -#' @export -setMethod(f = "summary", "twdtwCrossValidation", - definition = summary.twdtwCrossValidation) - -#' @inheritParams twdtwTimeSeries-class -#' @rdname twdtwTimeSeries-class -#' @export -setMethod(f = "show", "twdtwTimeSeries", - definition = show.twdtwTimeSeries) - -#' @inheritParams twdtwMatches-class -#' @rdname twdtwMatches-class -#' @export -setMethod(f = "show", "twdtwMatches", - definition = show.twdtwMatches) - -#' @inheritParams twdtwRaster-class -#' @rdname twdtwRaster-class -#' @export -setMethod(f = "show", "twdtwRaster", - definition = show.twdtwRaster) - -#' @aliases as.twdtwTimeSeries -#' @inheritParams twdtwTimeSeries-class -#' @describeIn twdtwTimeSeries convert list of data.frame to class twdtwTimeSeries. -#' @export -setMethod("as.twdtwTimeSeries", "ANY", - function(x) twdtwTimeSeries(lapply(x[], function(y) zoo(y[, names(y)!="date"], order.by = y$date)))) - -#' @aliases is.twdtwTimeSeries -#' @inheritParams twdtwTimeSeries-class -#' @describeIn twdtwTimeSeries Check if the object belongs to the class twdtwTimeSeries. -#' @export -setMethod("is.twdtwTimeSeries", "ANY", - function(x) is(x, "twdtwTimeSeries")) - -#' @aliases is.twdtwMatches -#' @inheritParams twdtwMatches-class -#' @describeIn twdtwMatches Check if the object belongs to the class twdtwMatches. -#' @export -setMethod("is.twdtwMatches", "ANY", - function(x) is(x, "twdtwMatches")) - -#' @aliases is.twdtwRaster -#' @inheritParams twdtwRaster-class -#' @describeIn twdtwRaster Check if the object belongs to the class twdtwRaster. -#' @export -setMethod("is.twdtwRaster", "ANY", - function(x) is(x, "twdtwRaster")) - -#' @aliases projecttwdtwRaster -#' @inheritParams twdtwRaster-class -#' @describeIn twdtwRaster project twdtwRaster object. -#' @param crs character or object of class 'CRS'. PROJ.4 description of -#' the coordinate reference system. For other arguments and more details see -#' \code{\link[raster]{projectRaster}}. -#' -#' @export -setMethod("projecttwdtwRaster", "twdtwRaster", - function(x, crs, ...) projecttwdtwRaster.twdtwRaster(x, crs, ...)) - - - - - - diff --git a/R/miscellaneous.R b/R/miscellaneous.R deleted file mode 100644 index ab90d65..0000000 --- a/R/miscellaneous.R +++ /dev/null @@ -1,199 +0,0 @@ - -#' @title Get dates from year and day of the year -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This function retrieves the date corresponding to the given -#' year and day of the year. -#' -#' @param year A vector with the years. -#' @param doy A vector with the day of the year. -#' It must have the same length as \code{year}. -#' -#' @docType methods -#' -#' @return A \code{\link[base]{Dates}} object. -#' -#' @seealso \link[dtwSat]{shiftDates} -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' year = c(2000, 2001) -#' doy = c(366, 365) -#' dates = getDatesFromDOY(year, doy) -#' dates -#' -#' @export -getDatesFromDOY = function(year, doy){ - res = as.Date(paste(as.numeric(year), as.numeric(doy)), format="%Y %j", origin="1970-01-01") - I = which(diff(res)<0)+1 - res[I] = as.Date(paste0(as.numeric(format(res[I],"%Y"))+1, format(res[I], "-%m-%d"))) - res -} - - - -#' @title Shift dates -#' @name shiftDates -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This function shifts the dates of the time series to a -#' given base year. -#' -#' @param object \code{\link[dtwSat]{twdtwTimeSeries}} objects, -#' \code{\link[zoo]{zoo}} objects or a list of \code{\link[zoo]{zoo}} objects. -#' -#' @param year the base year to shift the time series to. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwTimeSeries-class}} -#' -#' @return An object of the same class as the input \code{object}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @export -setGeneric("shiftDates", function(object, year=NULL) standardGeneric("shiftDates")) - -#' @rdname shiftDates -#' @aliases shiftDates-twdtwTimeSeries -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' npatt = shiftDates(patt, year=2005) -#' index(patt) -#' index(npatt) -#' -#' @export -setMethod("shiftDates", "twdtwTimeSeries", - function(object, year) - do.call("twdtwTimeSeries", lapply(as.list(object), FUN=shiftDates.twdtwTimeSeries, year=year))) - -#' @rdname shiftDates -#' @aliases shiftDates-list -#' @export -setMethod("shiftDates", "list", - function(object, year) - shiftDates(twdtwTimeSeries(object), year=year)[]) - -setOldClass("zoo") -#' @rdname shiftDates -#' @aliases shiftDates-zoo -#' @export -setMethod("shiftDates", "zoo", - function(object, year) - shiftDates(twdtwTimeSeries(object), year=year)[[1]]) - - -shiftDates.twdtwTimeSeries = function(x, year){ - labels = as.character(labels(x)) - x = x[[1]] - dates = index(x) - last_date = tail(dates, 1) - shift_days = as.numeric(last_date - as.Date(paste0(year,format(last_date, "-%m-%d")))) - d = as.numeric(dates) - shift_days - new("twdtwTimeSeries", timeseries=zoo(data.frame(x), as.Date(d)), labels=labels) -} - - -.adjustFactores = function(ref, pred, levels=NULL, labels=NULL){ - ref = as.character(ref) - pred = as.character(pred) - if(is.null(levels)) - levels = sort(unique(ref)) - if(is.null(labels)) - labels = levels - ref = factor(ref, levels, labels) - pred = factor(pred, levels, labels) - data = data.frame(Predicted=pred, Reference=ref) -} - -.adjustLabelID = function(y, labels, id.labels){ - if(!"label"%in%names(y)) y$label = paste0("ts",row.names(y)) - if(!is.null(id.labels)) y$label = as.character(y[[id.labels]]) - if(!is.null(id.labels) & !is.null(labels)){ - I = which(!is.na(match(as.character(y$label), as.character(labels)))) - if(length(I)<1) - stop("There are no matches between id.labels and labels") - } else if(!is.null(labels)) { - y$label = as.character(labels) - } - y -} - -.toSpatialPointsDataFrame = function(y, object, proj4string){ - if(is(y, "data.frame")){ - if(is.null(proj4string)){ - warning("Missing projection. Setting the same projection as the raster time series.", call. = FALSE) - proj4string = CRS(projection(object@timeseries[[1]])) - } - if(!is(proj4string, "CRS")) proj4string = try(CRS(proj4string)) - y = SpatialPointsDataFrame(y[,c("longitude","latitude")], y, proj4string = proj4string) - } - if(!(is(y, "SpatialPoints") | is(y, "SpatialPointsDataFrame"))) - stop("y is not SpatialPoints or SpatialPointsDataFrame") - row.names(y) = 1:nrow(y) - y -} - - -.getPredRefClasses = function(i, r_intervals, pred_classes, pred_distance, y, rlevels, rnames){ - i_leng = as.numeric(r_intervals$to[i] - r_intervals$from[i]) - from = as.Date(y$from) - to = as.Date(y$to) - # Select overlapping alignments - J = which(from <= r_intervals$to[i] & to >= r_intervals$from[i]) - # Adjust overlapping - from = sapply(from[J], function(x) ifelse(x < r_intervals$from[i], r_intervals$from[i], x)) - to = sapply(to[J], function(x) ifelse(x > r_intervals$to[i], r_intervals$to[i], x)) - # Compute overlapping proportion - if(length(to)<1) - return(NULL) - i_over = to - from - # print(i_leng) - # print(i_over) - prop_over = abs(i_over / i_leng) - # Select alignments - I = which(prop_over > .5) - # I = which((r_intervals$to[i] - as.Date(y$from) > 30) & (as.Date(y$to) - r_intervals$from[i] > 30) ) - if(length(J[I])<1) - return(NULL) - K = match(pred_classes[J[I],i], rlevels) - Predicted = factor(as.character(rnames[K]), levels = rnames, labels = rnames) - Reference = factor(as.character(y$label[J[I]]), levels = rnames, labels = rnames) - Distance = pred_distance[J[I],i] - data.frame(Sample.id = row.names(y)[J[I]], coordinates(y[J[I],]), Period=i, from=r_intervals$from[i], to=r_intervals$to[i], Predicted, Reference, Distance) -} - -.getAreaByClass = function(l, r, rlevels, rnames){ - r = raster(r, layer = l) - if(isLonLat(r)){ - warning("Computing the approximate surface area in km2 of cells in an unprojected (longitude/latitude) Raster object. See ?raster::area", call. = TRUE) - # r = projectRaster(from = r, crs = proj_str, method = 'ngb') - ra = area(r) - I = lapply(rlevels, function(i) r[]==i ) - out = sapply(I, function(i) sum(ra[i], na.rm = TRUE) ) - names(out) = rnames - } else { - npx = zonal(r, r, 'count') - I = match(npx[,'zone'], rlevels) - out = rep(0, length(rnames)) - names(out) = rnames - out[I] = npx[,'count'] * prod(res(r)) - names(out) = rnames - } - out -} - - diff --git a/R/plot.R b/R/plot.R deleted file mode 100644 index abf961b..0000000 --- a/R/plot.R +++ /dev/null @@ -1,231 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting twdtw* objects -#' @name plot -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Methods for plotting objects of class twdtw*. -#' -#' @param x An object of class twdtw*. -#' @param type A character for the plot type: ''paths'', ''matches'', -#' ''alignments'', ''classification'', ''cost'', ''patterns'', ''timeseries'', -#' ''maps'', ''area'', ''changes'', and ''distance''. -#' -#' @param ... additional arguments to pass to plotting functions. -#' \code{\link[dtwSat]{plotPaths}}, -#' \code{\link[dtwSat]{plotCostMatrix}}, -#' \code{\link[dtwSat]{plotAlignments}}, -#' \code{\link[dtwSat]{plotMatches}}, -#' \code{\link[dtwSat]{plotClassification}}, -#' \code{\link[dtwSat]{plotPatterns}}, -#' \code{\link[dtwSat]{plotTimeSeries}}, -#' \code{\link[dtwSat]{plotMaps}}, -#' \code{\link[dtwSat]{plotArea}}, or -#' \code{\link[dtwSat]{plotChanges}}. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @details -#' \describe{ -#' \item{Plot types}{: -#' \cr\code{paths}: Method for plotting the minimum paths in the cost matrix of TWDTW. -#' \cr\code{matches}: Method for plotting the matching points from TWDTW analysis. -#' \cr\code{alignments}: Method for plotting the alignments and respective TWDTW dissimilarity measures. -#' \cr\code{classification}: Method for plotting the classification of each subinterval of the time series based on TWDTW analysis. -#' \cr\code{cost}: Method for plotting the internal matrices used during the TWDTW computation. -#' \cr\code{patterns}: Method for plotting the temporal patterns. -#' \cr\code{timeseries}: Method for plotting the temporal patterns. -#' } -#' } -#' -#' @export -NULL - -#' @aliases plot-twdtwAssessment -#' @inheritParams plot -#' @rdname plot -#' @export -setMethod("plot", - signature(x = "twdtwAssessment"), - function(x, type="area", ...){ - pt = pmatch(type, c("area","accuracy","map")) - switch(pt, - plotAdjustedArea(x, ...), - plotAccuracy(x, ...), - plotMapSamples(x, ...) - ) - } -) - -#' @aliases plot-twdtwTimeSeries -#' @inheritParams plot -#' @rdname plot -#' @export -setMethod("plot", - signature(x = "twdtwCrossValidation"), - function(x, type="crossvalidation", ...){ - pt = pmatch(type, c("crossvalidation")) - switch(pt, - plotAccuracy(x, ...) - ) - } -) - -#' @aliases plot-twdtwTimeSeries -#' @inheritParams plot -#' @rdname plot -#' @export -setMethod("plot", - signature(x = "twdtwTimeSeries"), - function(x, type="timeseries", ...){ - pt = pmatch(type,c("patterns","timeseries")) - switch(pt, - plotPatterns(x, ...), - plotTimeSeries(x, ...) - ) - } -) - - -#' @aliases plot-twdtwMatches -#' @inheritParams plot -#' @rdname plot -#' @export -setMethod("plot", - signature(x = "twdtwMatches"), - function(x, type="alignments", ...){ - pt = pmatch(type,c("paths","matches","alignments","classification","cost")) - switch(pt, - plotPaths(x, ...), - plotMatches(x, ...), - plotAlignments(x, ...), - plotClassification(x, ...), - plotCostMatrix(x, ...) - ) - } -) - - - -#' @aliases plot-twdtwRaster -#' @inheritParams plot -#' @rdname plot -#' @export -setMethod("plot", signature(x = "twdtwRaster"), function(x, type="maps", ...) .PlotRaster(x, type=type, ...)) - -.PlotRaster = function(x, type, time.levels=NULL, time.labels=NULL, class.levels=NULL, class.labels=NULL, class.colors=NULL, layers=NULL, perc=TRUE, ...){ - - if(type=="distance") { - - if( is.null(time.levels)) - time.levels = names(x) - - if(is(time.levels, "numeric")) - time.levels = names(x)[time.levels] - - if( is.null(time.labels)) - time.labels = format(as.Date(time.levels, "date.%Y.%m.%d"), "%Y") - - if(length(time.levels)!=length(time.labels)) - stop("time.levels and time.labels have different lengths") - - if(is.null(layers)) { - if(any(coverages(x)=="Distance")){ - layers = "Distance" - time.levels = time.levels - labels = time.labels - time.labels=NULL - } - else { - layers = coverages(x) - layers = layers[!layers%in%"doy"] - time.levels = time.levels[1] - time.labels = time.labels[1] - labels = layers - } - } else { - if(is(layers, "numeric")) layers = coverages(x)[layers] - time.levels = time.levels[1] - time.labels = time.labels[1] - labels = layers - } - - x = lapply(as.list(x)[layers], FUN=subset, subset=time.levels) - gp = .plotDistance(brick(x), layers, labels, time.labels) - - } else { - - if( is.null(time.levels)) - time.levels = seq_along(index(x)) - - if(is.null(time.labels)) - time.labels = format(index(x), "%Y") - - if(is(time.levels, "numeric")){ - time.levels = names(x)[time.levels] - time.labels = time.labels[time.levels] - } - - - if(length(time.levels)!=length(time.labels)) - stop("time.levels and time.labels have different lengths") - - # if(length(time.levels)>16){ - # time.levels = time.levels[1:16] - # time.labels = time.labels[1:16] - # } - - if( is.null(class.levels)) - class.levels = levels(x) - - if(length(class.levels)<1) - class.levels = sort(unique(as.numeric(x[["Class"]][]))) - - if( is.null(class.labels)) - class.labels = labels(x) - - if(length(class.labels)<1) - class.labels = as.character(class.levels) - - if( is.null(class.colors) ) - class.colors = brewer.pal(length(class.levels), "Set3") - - if( length(class.colors) # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting alignments -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting the alignments and TWDTW -#' dissimilarity measures. -#' -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwMatches}}. -#' @param timeseries.labels the label or index of the time series. -#' Default is 1. -#' @param patterns.labels a vector with labels of the patterns. If not -#' declared the function will plot the alignments for all patterns in \code{x}. -#' @param attr An \link[base]{integer} or \link[base]{character} vector -#' indicating the attribute for plotting. Default is 1. -#' @param threshold A number. The TWDTW dissimilarity threshold, \emph{i.e.} the -#' maximum TWDTW cost for consideration. Default is \code{Inf}. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotPaths}}, -#' \code{\link[dtwSat]{plotCostMatrix}}, -#' \code{\link[dtwSat]{plotMatches}}, and -#' \code{\link[dtwSat]{plotClassification}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' log_fun = logisticWeight(-0.1, 100) -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) -#' -#' plotAlignments(mat1) -#' -#' plotAlignments(mat1, attr=c("evi","ndvi")) -#' -#' @export -plotAlignments = function(x, timeseries.labels=NULL, patterns.labels=NULL, attr=1, threshold=Inf){ - - x = subset(x, timeseries.labels[1], patterns.labels) - - ## Get data - ts = getTimeSeries(x)[[1]] - alignments = x[[1]] - - # Get time series - df.x = data.frame(ts[,attr,drop=FALSE]) - df.x$Time = as.Date(rownames(df.x)) - df.alignments = melt(df.x, id="Time") - df.alignments$distance = NA - df.alignments$variable = as.character(df.alignments$variable) - df.alignments$Variable = df.alignments$variable - df.alignments$Pattern = NA - df.alignments$group = df.alignments$variable - df.alignments$facets = 1 - df.alignments$facets = factor(df.alignments$facets, levels = c(1,2), labels = c("Time series","TWDTW dissimilarity measure")) - - # Get matching points - df.matches = list() - df.matches$Time = c(alignments$from, alignments$to) - df.matches$variable = rep(alignments$label, 2) - df.matches$value = rep(alignments$distance, 2) - df.matches$distance = df.matches$value - df.matches$Variable = NA - df.matches$Pattern = df.matches$variable - df.matches$group = as.character(rep(1:length(alignments$label), 2)) - df.matches$facets = 2 - df.matches = data.frame(df.matches, stringsAsFactors = FALSE) - df.matches$facets = factor(df.matches$facets, levels = c(1,2), labels = c("Time series","TWDTW dissimilarity measure")) - - I = which(df.matches$value>threshold) - if(length(I)>0) - df.matches = df.matches[-I,] - - df.all = rbind(df.alignments, df.matches) - - gp = ggplot(data=df.all) + - geom_line(data=df.alignments, aes_string(x='Time', y='value', group='group', linetype='Variable')) + - guides(linetype = guide_legend(title = "Bands")) + - facet_wrap(~facets, ncol = 1, scales = "free_y") + - geom_path(data=df.matches, aes_string(x='Time', y='distance', group='group', colour='Pattern')) + - geom_point(data=df.matches, aes_string(x='Time', y='distance', group='group', colour='Pattern')) + - ylab("Value") - gp -} - diff --git a/R/plotArea.R b/R/plotArea.R deleted file mode 100644 index 9b904ff..0000000 --- a/R/plotArea.R +++ /dev/null @@ -1,134 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting accumulated area -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting time series of accumulated area. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwRaster}}. -#' @param time.levels A \link[base]{character} or \link[base]{numeric} -#' vector with the layers to plot. For plot type ''change'' the minimum length -#' is two. -#' @param time.labels A \link[base]{character} or \link[base]{numeric} -#' vector with the labels of the layers. It must have the same -#' length as time.levels. Default is NULL. -#' @param class.levels A \link[base]{character} or \link[base]{numeric} -#' vector with the levels of the raster values. Default is NULL. -#' @param class.labels A \link[base]{character} or \link[base]{numeric} -#' vector with the labels of the raster values. It must have the same -#' length as class.levels. Default is NULL. -#' @param class.colors a set of aesthetic values. It must have the same -#' length as class.levels. Default is NULL. See -#' \link[ggplot2]{scale_fill_manual} for details. -#' @param perc if TRUE shows the results in percent of area. Otherwise shows the -#' area in the map units or km2 for no project raster. Default is TRUE. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotMaps}}, -#' \code{\link[dtwSat]{plotChanges}}, and -#' \code{\link[dtwSat]{plotDistance}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' \dontrun{ -#' -#' # Create raster time series -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -#' blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -#' nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -#' mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -#' doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) -#' -#' # Read field samples -#' field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -#' proj_str = scan(system.file("lucc_MT/data/samples_projection", -#' package="dtwSat"), what = "character") -#' -#' # Split samples for training (10%) and validation (90%) using stratified sampling -#' library(caret) -#' set.seed(1) -#' I = unlist(createDataPartition(field_samples$label, p = 0.1)) -#' training_samples = field_samples[I,] -#' validation_samples = field_samples[-I,] -#' -#' # Create temporal patterns -#' training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) -#' temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) -#' -#' # Run TWDTW analysis for raster time series -#' log_fun = weight.fun=logisticWeight(-0.1,50) -#' r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", -#' overwrite=TRUE) -#' -#' # Classify raster based on the TWDTW analysis -#' r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) -#' -#' plotArea(r_lucc) -#' -#' plotArea(r_lucc, perc=FALSE) -#' -#' } -#' @export -plotArea = function(x, time.levels=NULL, time.labels=NULL, class.levels=NULL, class.labels=NULL, class.colors=NULL, perc=TRUE){ - plot(x, type="area", time.levels=time.levels, time.labels=time.labels, class.levels=class.levels, class.labels=class.labels, class.colors=class.colors, perc=perc) -} - -.plotArea = function(x, time.levels, time.labels, class.levels, class.labels, class.colors, perc){ - - df.area = do.call("rbind", lapply(time.levels, .getAreaByClass, x, class.levels, class.labels)) - df.area = data.frame(variable = as.numeric(time.labels), df.area, stringsAsFactors = FALSE) - names(class.colors) = names(df.area)[-1] - df.area = melt(df.area, "variable", value.name = "Freq", variable.name = "value") - df.area$Time = as.numeric(df.area$variable) - df.area$variable = factor(df.area$variable) - - if(perc) - df.area$Freq = df.area$Freq / (sum(df.area$Freq) / length(time.levels)) - - x.breaks = pretty_breaks()(range(df.area$Time)) - - gp = ggplot(data=df.area, aes_string(x="Time", y="Freq", fill="value")) + - geom_area(position = 'stack') + - scale_fill_manual(name="Legend", values = class.colors) + - scale_x_continuous(expand = c(0.01, 0), breaks = x.breaks) + - theme(legend.position = "bottom", - panel.background = element_blank()) + - ylab("Area") - - if(perc){ - gp = gp + scale_y_continuous(expand = c(0, 0), labels = percent) - } else { - gp = gp + scale_y_continuous(expand = c(0, 0)) - } - - gp - -} - - - diff --git a/R/plotChanges.R b/R/plotChanges.R deleted file mode 100644 index eb21d4f..0000000 --- a/R/plotChanges.R +++ /dev/null @@ -1,121 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting changes -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting changes over time. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwRaster}}. -#' @param time.levels A \link[base]{character} or \link[base]{numeric} -#' vector with the layers to plot. For plot type ''change'' the minimum length -#' is two. -#' @param time.labels A \link[base]{character} or \link[base]{numeric} -#' vector with the labels of the layers. It must have the same -#' length as time.levels. Default is NULL. -#' @param class.levels A \link[base]{character} or \link[base]{numeric} -#' vector with the levels of the raster values. Default is NULL. -#' @param class.labels A \link[base]{character} or \link[base]{numeric} -#' vector with the labels of the raster values. It must have the same -#' length as class.levels. Default is NULL. -#' @param class.colors A set of aesthetic values. It must have the same -#' length as class.levels. Default is NULL. See -#' \link[ggplot2]{scale_fill_manual} for details. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotArea}}, -#' \code{\link[dtwSat]{plotMaps}}, and -#' \code{\link[dtwSat]{plotDistance}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' \dontrun{ -#' # Run TWDTW analysis for raster time series -#' patt = MOD13Q1.MT.yearly.patterns -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -#' blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -#' nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -#' mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -#' doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) -#' -#' time_interval = seq(from=as.Date("2007-09-01"), to=as.Date("2013-09-01"), -#' by="12 month") -#' log_fun = weight.fun=logisticWeight(-0.1,50) -#' -#' r_twdtw = twdtwApply(x=rts, y=patt, weight.fun=log_fun, breaks=time_interval, -#' filepath="~/test_twdtw", overwrite=TRUE, format="GTiff") -#' -#' r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) -#' -#' plotChanges(r_lucc) -#' -#' } -#' @export -plotChanges = function(x, time.levels=NULL, time.labels=NULL, class.levels=NULL, class.labels=NULL, class.colors=NULL){ - plot(x, type="changes", time.levels=time.levels, time.labels=time.labels, class.levels=class.levels, class.labels=class.labels, class.colors=class.colors) -} - -.plotChanges = function(x, time.levels, time.labels, class.levels, class.labels, class.colors){ - - if(length(time.levels)<2) - stop("The length of time.levels is shorter than two") - - df = do.call("rbind", lapply(seq_along(time.levels)[-1], function(l){ - from = raster::subset(x=x, subset=time.levels[l-1])[] - to = raster::subset(x=x, subset=time.levels[l] )[] - res = data.frame(from, to) - res = data.frame(xtabs(~ from + to, res) / nrow(res)) - res$layer = paste0(time.labels[l-1],"-",time.labels[l]) - res - })) - - df$from = factor(df$from, levels = class.levels, labels = class.labels) - df$to = factor(df$to, levels = class.levels, labels = class.labels) - df$from = factor(df$from) - df$to = factor(df$to) - I = df$from!=df$to - - # Plot change - gp = ggplot() + - geom_bar(data=df[I,], position = "stack", aes_string(x="to", y="Freq", fill="from"), stat="identity") + - geom_bar(data=df[I,], position = "stack", aes_string(x="from", y="-Freq", fill="to"), stat="identity") + - facet_wrap(~layer) + - scale_fill_manual(name = "Legend", values = class.colors) + - scale_y_continuous(labels = percent) + - xlab("") + - geom_hline(yintercept = 0) + - coord_flip() + - theme(legend.position = "bottom") + - ylab("Percentage of land changes") - - gp - - -} - - - diff --git a/R/plotClassification.R b/R/plotClassification.R deleted file mode 100644 index 61a6b37..0000000 --- a/R/plotClassification.R +++ /dev/null @@ -1,114 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting subintervals classification -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting the classification of each -#' subinterval of the time series based on TWDTW analysis. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwMatches}}. -#' @param timeseries.labels The label or index of the time series. -#' Default is 1. -#' @param patterns.labels A vector with labels of the patterns. If not -#' declared the function will plot one alignment for each pattern. -#' -#' @param attr An \link[base]{integer} vector or \link[base]{character} vector -#' indicating the attribute for plotting. If not declared the function will plot -#' all attributes. -#' @param ... Additional arguments passed to \code{\link[dtwSat]{twdtwClassify}}. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{twdtwClassify}}, -#' \code{\link[dtwSat]{plotAlignments}}, -#' \code{\link[dtwSat]{plotPaths}}, -#' \code{\link[dtwSat]{plotMatches}}, and -#' \code{\link[dtwSat]{plotCostMatrix}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' log_fun = logisticWeight(-0.1, 100) -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) -#' -#' # Classify interval -#' from = as.Date("2007-09-01") -#' to = as.Date("2013-09-01") -#' by = "6 month" -#' gp = plotClassification(x=mat1, from=from, to=to, by=by, overlap=.5) -#' gp -#' -#' -#' @export -plotClassification = function(x, timeseries.labels=NULL, patterns.labels=NULL, attr, ...){ - - if(length(timeseries.labels)>6) timeseries.labels = timeseries.labels[1:6] - x = subset(x, timeseries.labels, patterns.labels) - if(length(list(...))>0) x = twdtwClassify(x, ...) - - ## Get data - if(missing(attr)) attr = names(getTimeSeries(x,1)[[1]]) - df.x = do.call("rbind", lapply(as.list(x), function(xx){ - ts = getTimeSeries(xx)[[1]][,attr,drop=FALSE] - data.frame(Time=index(ts), ts, Series=labels(xx)$timeseries) - })) - df.x = melt(df.x, id.vars=c("Time","Series")) - - y.labels = pretty_breaks()(range(df.x$value, na.rm = TRUE)) - y.breaks = y.labels - - df.pol = do.call("rbind", lapply(as.list(x), function(xx){ - best_class = xx[[1]] - df.pol = do.call("rbind", lapply(1:nrow(best_class), function(i){ - data.frame( - Time = c(best_class$from[i], best_class$to[i], best_class$to[i], best_class$from[i]), - Group = rep(i, 4), - Class = rep(as.character(best_class$label[i]), 4), - value = rep(range(y.breaks, na.rm = TRUE), each=2)) - })) - df.pol$Group = factor(df.pol$Group) - df.pol$Class = factor(df.pol$Class) - df.pol$Series = rep(as.character(labels(xx)$timeseries), length(df.pol$Time)) - df.pol - })) - - I = min(df.pol$Time, na.rm = TRUE)-30 <= df.x$Time & - df.x$Time <= max(df.pol$Time, na.rm = TRUE)+30 - - df.x = df.x[I,,drop=FALSE] - - gp = ggplot() + - facet_wrap(~Series, scales = "free_x", ncol=1) + - geom_polygon(data=df.pol, aes_string(x='Time', y='value', group='Group', fill='Class'), alpha=.7) + - scale_fill_brewer(palette="Set3") + - geom_line(data=df.x, aes_string(x='Time', y='value', colour='variable')) + - scale_y_continuous(expand = c(0, 0), breaks=y.breaks, labels=y.labels) + - scale_x_date(breaks=waiver(), labels=waiver()) + - theme(legend.position = "bottom") + - guides(colour = guide_legend(title = "Bands")) + - ylab("Value") + - xlab("Time") - gp -} - diff --git a/R/plotCostMatrix.R b/R/plotCostMatrix.R deleted file mode 100644 index 7476b38..0000000 --- a/R/plotCostMatrix.R +++ /dev/null @@ -1,124 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting paths -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting low cost paths in the TWDTW -#' cost matrix. -#' -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwMatches}}. -#' @param timeseries.labels The label or index of the time series. -#' Default is 1. -#' @param patterns.labels A vector with labels of the patterns. If not -#' declared the function will plot one alignment for each pattern. -#' @param matrix.name A character. The name of the matrix to plot, -#' "costMatrix" for accumulated cost, "localMatrix" for local cost, -#' or "timeWeight" for time-weight. Default is "costMatrix". -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotAlignments}}, -#' \code{\link[dtwSat]{plotPaths}}, -#' \code{\link[dtwSat]{plotMatches}}, and -#' \code{\link[dtwSat]{plotClassification}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' log_fun = logisticWeight(-0.1, 100) -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) -#' -#' plotCostMatrix(mat1, matrix.name="costMatrix") -#' -#' plotCostMatrix(mat1, matrix.name="localMatrix") -#' -#' plotCostMatrix(mat1, matrix.name="timeWeight") -#' -#' @export -plotCostMatrix = function(x, timeseries.labels=NULL, patterns.labels=NULL, matrix.name="costMatrix"){ - - pt = pmatch(matrix.name,c("costMatrix", "localMatrix", "timeWeight")) - if(is.na(pt)) - stop("matrix.name is not costMatrix, localMatrix, or timeWeight") - - legend_name = c("Accumulated cost", "Local cost", "Time weight")[pt] - - x = subset(x, timeseries.labels[1], patterns.labels) - y = as.character(labels(x)$patterns) - ## Get data - internals = getInternals(x)[[1]] - if(any(sapply(internals, function(x) length(x$internals))<1)) - stop("Plot methods requires internals, set keep=TRUE on twdtwApply() call") - ts = getTimeSeries(x)[[1]] - patterns = getPatterns(x) - - # Get cost matrix - df.m = do.call("rbind", lapply(y, function(p){ - tx = index(ts) - ty = index(shiftDates(patterns[[p]], year=2005)) - m = internals[[p]]$internals[[matrix.name]] - res = melt(m) - names(res) = c("Var1","Var2","value") - res$Pattern = p - res$tx = tx - res$ty = ty - res - })) - - ## Set axis breaks and labels - x.labels = pretty_breaks()(range(df.m$tx, na.rm = TRUE)) - timeline = unique( c(df.m$tx, x.labels) ) - x.breaks = zoo( c(unique(df.m$Var2), rep(NA, length(x.labels))), order.by = timeline ) - x.breaks = na.approx(x.breaks, rule = 2) - x.axis = data.frame(x.breaks=x.breaks[x.labels], x.labels = names(x.labels)) - - fact = 0 - for(i in seq_along(y)[-1]) fact[i] = fact[i-1] + max(df.m$Var1[df.m$Pattern==y[i]]) - df.m$Var3 = df.m$Var1 + unlist(lapply(seq_along(y), function(i) rep(fact[i], length(which(df.m$Pattern==y[i])) ))) - - y.axis = do.call("rbind", lapply(y, function(p){ - df = df.m[df.m$Pattern==p,] - y.labels = pretty_breaks()(range(df$ty, na.rm = TRUE)) - timeline <- unique(merge(unique(df[,c("ty","Var3")]), data.frame(ty = y.labels[drop = FALSE]), by.x = "ty", by.y = "ty", all.x = TRUE, all.y = TRUE)) - y.breaks <- zoo(timeline$Var3, order.by = timeline$ty) - y.breaks = na.approx(y.breaks, rule = 2) - y.breaks = y.breaks[y.labels] - data.frame(y.breaks, y.labels=names(y.labels)) - })) - - # Plot - gp = ggplot(data=df.m, aes_string(y='Var3', x='Var2')) + - facet_wrap(~Pattern, scales = "free", ncol=1) + - geom_raster(aes_string(fill='value')) + - scale_fill_gradientn(name = legend_name, colours = gray.colors(100, start = 0.1, end = 1)) + - scale_x_continuous(expand = c(0, 0), breaks=x.axis$x.breaks, labels=x.axis$x.labels) + - scale_y_continuous(expand = c(0, 0), breaks=y.axis$y.breaks, labels=y.axis$y.labels) + - xlab("Time series") + - ylab("Pattern") - - gp - -} - diff --git a/R/plotDistance.R b/R/plotDistance.R deleted file mode 100644 index 0fe7136..0000000 --- a/R/plotDistance.R +++ /dev/null @@ -1,97 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting distance maps -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting TWDTW distance maps. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwRaster}}. -#' @param time.levels A \link[base]{character} or \link[base]{numeric} -#' vector with the layers to plot. For plot type ''change'' the minimum length -#' is two. -#' @param time.labels A \link[base]{character} or \link[base]{numeric} -#' vector with the labels of the layers. It must have the same -#' length as time.levels. Default is NULL. -#' @param layers A \link[base]{character} or \link[base]{numeric} -#' vector with the layers/bands of the raster time series. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotArea}}, -#' \code{\link[dtwSat]{plotChanges}}, and -#' \code{\link[dtwSat]{plotDistance}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' \dontrun{ -#' # Run TWDTW analysis for raster time series -#' patt = MOD13Q1.MT.yearly.patterns -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -#' blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -#' nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -#' mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -#' doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) -#' -#' time_interval = seq(from=as.Date("2007-09-01"), to=as.Date("2013-09-01"), -#' by="12 month") -#' log_fun = weight.fun=logisticWeight(-0.1,50) -#' -#' r_twdtw = twdtwApply(x=rts, y=patt, weight.fun=log_fun, breaks=time_interval, -#' filepath="~/test_twdtw", overwrite=TRUE, format="GTiff", mc.cores=3) -#' -#' plotDistance(r_twdtw) -#' -#' } -#' @export -plotDistance = function(x, time.levels=1, time.labels=1, layers=NULL){ - plot(x, type="distance", time.levels=time.levels, time.labels=time.labels, layers=layers) -} - -.plotDistance = function(x, layers, labels, time.label){ - - df.map = data.frame(coordinates(x), x[], stringsAsFactors=FALSE) - df.map = melt(df.map, id.vars = c("x", "y")) - df.map$variable = labels[match(as.character(df.map$variable), names(x))] - - gp = ggplot(data=df.map, aes_string(x="x", y="y")) + - geom_raster(aes_string(fill="value")) + - scale_fill_gradient(name="TWDTW distance", low="blue", high="red") + - facet_wrap(~variable) + - scale_y_continuous(expand = c(0, 0), breaks = NULL) + - scale_x_continuous(expand = c(0, 0), breaks = NULL) + - theme(legend.position = "bottom") + - coord_fixed(ratio = 1) + - xlab("") + - ylab("") + - #xlab("Longitude") + - #ylab("Latitude") + - ggtitle(time.label) - gp - -} - - diff --git a/R/plotMapSamples.R b/R/plotMapSamples.R deleted file mode 100644 index dbf5aee..0000000 --- a/R/plotMapSamples.R +++ /dev/null @@ -1,48 +0,0 @@ - -#' @title Plotting maps -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting maps and samples. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwAssessment}}. -#' @param samples A character defining the samples to plot -#' "correct", "incorrect", "all". Default is "all". -#' @param ... Other arguments to pass to \code{\link[dtwSat]{twdtwRaster}} -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwAssessment}}, -#' \code{\link[dtwSat]{plotAccuracy}}, and -#' \code{\link[dtwSat]{plotAdjustedArea}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @example examples/test_twdtw_raster_analysis.R -#' @export -plotMapSamples = function(x, samples="all", ...){ - .plotMapSamples(x, samples, ...) -} - -.plotMapSamples = function(x, samples){ - - x.sp = switch(samples, - all = x@data, - correct = x@data[x@data$Predicted == x@data$Reference, ], - incorrect = x@data[x@data$Predicted != x@data$Reference, ]) - - gp = plot(x@map, type="maps") - - - df = data.frame(x.sp) - df$variable = gp$data[match(df$Period, gp$data$rast.layer),"variable"] - df$variable = as.numeric(format(as.Date(df$to), "%Y")) - - gp = gp + geom_point(shape = 1, data = df, aes_string(x = "longitude", y = "latitude")) + - scale_shape(solid = FALSE) - gp - -} diff --git a/R/plotMaps.R b/R/plotMaps.R deleted file mode 100644 index 9c69dc8..0000000 --- a/R/plotMaps.R +++ /dev/null @@ -1,103 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting maps -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting time series of maps. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwRaster}}. -#' @param time.levels A \link[base]{character} or \link[base]{numeric} -#' vector with the layers to plot. For plot type ''change'' the minimum length -#' is two. -#' @param time.labels A \link[base]{character} or \link[base]{numeric} -#' vector with the labels of the layers. It must have the same -#' length as time.levels. Default is NULL. -#' @param class.levels A \link[base]{character} or \link[base]{numeric} -#' vector with the levels of the raster values. Default is NULL. -#' @param class.labels A \link[base]{character} or \link[base]{numeric} -#' vector with the labels of the raster values. It must have the same -#' length as class.levels. Default is NULL. -#' @param class.colors A set of aesthetic values. It must have the same -#' length as class.levels. Default is NULL. See -#' \link[ggplot2]{scale_fill_manual} for details. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotArea}}, -#' \code{\link[dtwSat]{plotChanges}}, and -#' \code{\link[dtwSat]{plotDistance}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' \dontrun{ -#' # Run TWDTW analysis for raster time series -#' patt = MOD13Q1.MT.yearly.patterns -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -#' blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -#' nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -#' mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -#' doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) -#' -#' time_interval = seq(from=as.Date("2007-09-01"), to=as.Date("2013-09-01"), -#' by="12 month") -#' log_fun = weight.fun=logisticWeight(-0.1,50) -#' -#' r_twdtw = twdtwApply(x=rts, y=patt, weight.fun=log_fun, breaks=time_interval, -#' filepath="~/test_twdtw", overwrite=TRUE, format="GTiff", mc.cores=3) -#' -#' r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) -#' -#' plotMaps(r_lucc) -#' -#' } -#' @export -plotMaps = function(x, time.levels=NULL, time.labels=NULL, class.levels=NULL, class.labels=NULL, class.colors=NULL){ - plot(x, type="maps", time.levels=time.levels, time.labels=time.labels, class.levels=class.levels, class.labels=class.labels, class.colors=class.colors) -} - -.plotMaps = function(x, time.levels, time.labels, class.levels, class.labels, class.colors){ - - df.map = data.frame(coordinates(x), x[], stringsAsFactors=FALSE) - df.map = melt(df.map, id.vars = c("x", "y")) - df.map$value = factor(df.map$value, levels = class.levels, labels = class.labels) - df.map$rast.layer = seq_along(time.levels)[match(as.character(df.map$variable), time.levels)] - df.map$rast.level = time.levels[match(as.character(df.map$variable), time.levels)] - df.map$variable = time.labels[match(as.character(df.map$variable), time.levels)] - - gp = ggplot(data=df.map, aes_string(x="x", y="y")) + - geom_raster(aes_string(fill="value")) + - scale_fill_manual(name="Legend", values = class.colors) + - facet_wrap(~variable) + - scale_y_continuous(expand = c(0, 0), breaks = NULL) + - scale_x_continuous(expand = c(0, 0), breaks = NULL) + - theme(legend.position = "bottom") + - coord_fixed(ratio = 1) + - xlab("") + - ylab("") - gp - -} diff --git a/R/plotMatches.R b/R/plotMatches.R deleted file mode 100644 index 11a6825..0000000 --- a/R/plotMatches.R +++ /dev/null @@ -1,150 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting matching points -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting the matching points from -#' TWDTW analysis. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwMatches}}. -#' @param timeseries.labels The label or index of the time series. -#' Default is 1. -#' @param patterns.labels A vector with labels of the patterns. If not -#' declared the function will plot one alignment for each pattern. -#' @param k A positive integer. The index of the last alignment to include in -#' the plot. If not declared the function will plot the best match for -#' each pattern. -#' @param attr An \link[base]{integer} or \link[base]{character} vector -#' indicating the attribute for plotting. Default is 1. -#' @param shift A number that shifts the pattern position in the \code{x} -#' direction. Default is 0.5. -#' @param show.dist Show the distance for each alignment. Default is FALSE. -#' @docType methods -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotPaths}}, -#' \code{\link[dtwSat]{plotCostMatrix}}, -#' \code{\link[dtwSat]{plotAlignments}}, and -#' \code{\link[dtwSat]{plotClassification}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' log_fun = logisticWeight(-0.1, 100) -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) -#' -#' plotMatches(mat1) -#' -#' plotMatches(mat1, patterns.labels="Soybean", k=4) -#' -#' plotMatches(mat1, patterns.labels=c("Soybean","Maize"), k=4) -#' -#' plotMatches(mat1, patterns.labels=c("Soybean","Cotton"), k=c(3,1)) -#' -#' @export -plotMatches = function(x, timeseries.labels=1, patterns.labels=NULL, k=1, attr=1, shift=0.5, show.dist=FALSE){ - - x = subset(x, timeseries.labels[1], patterns.labels) - ## Get data - internals = getInternals(x)[[1]] - if(any(sapply(internals, function(x) length(x$internals))<1)) - stop("Plot methods requires internals, set keep=TRUE on twdtwApply() call") - matching = getMatches(x)[[1]] - alignments = getAlignments(x)[[1]] - ts = getTimeSeries(x)[[1]] - patterns = getPatterns(x) - - y = as.character(labels(x)$patterns) - if(length(k)==1){ - y = rep(y, each=k) - k = unlist(lapply(table(y), function(i) seq(from=1, to=i) )) - } - if(length(y)!=length(k)) - stop("If length of k greater than 1, then patterns.labels must have the same length as k.") - - xx = ts[,attr,drop=FALSE] - tx = index(xx) - - y.labels = pretty_breaks()(range(xx, na.rm = TRUE)) - y.breaks = y.labels - - # Get time series - df.x = data.frame(Time=tx, xx) - - # Build matching points data.frame - df.list = lapply(seq_along(y), function(i){ - p = y[i] - yy = patterns[[p]][,attr,drop=FALSE] - ty = index(yy) - - if(k[i]>alignments[[p]]$K){ - warning("Alignment index out of bounds", call. = TRUE) - return(NULL) - } - - map = data.frame(matching[[p]]$matching[[k[i]]]) - delay = tx[map$index2[1]]-ty[1] - if(delay>0) - delay = delay + diff(range(ty, na.rm = TRUE))*shift - if(delay<0) - delay = delay - diff(range(ty, na.rm = TRUE))*shift - - df.pt = data.frame(Time=ty[map$index1]+delay, yy[map$index1,,drop=FALSE]+max(xx, na.rm = TRUE)) - df.match.pt = df.pt - df.match.pt$alig = paste(1:nrow(map),p,k[i],sep="_") - df.match.x = df.x[map$index2,] - df.match.x$alig = paste(1:nrow(map),p,k[i],sep="_") - df.match = rbind(df.match.pt, df.match.x) - df.pt$Matches = paste(p,k[i]) - df.dist = data.frame(Time=max(ty[map$index1]+delay)+diff(range(df.pt$Time))/3, - max(df.pt[,names(yy)]),Dist=alignments[[p]]$distance[k[i]]) - names(df.dist) = c("Time", names(yy), "Dist") - list(match=df.match, pt=df.pt, dist=df.dist) - }) - - df.pt = do.call("rbind", lapply(df.list, function(df) df$pt)) - df.match = do.call("rbind", lapply(df.list, function(df) df$match)) - - attr_names = names(df.x)[2] - gp = ggplot(data=df.x, aes_string(x='Time', y=eval(attr_names))) + - geom_line() + - geom_line(data=df.pt, aes_string(x='Time', y=eval(attr_names), - group='Matches', colour='Matches')) + - geom_line(data=df.match, linetype = 2, colour = "grey", - aes_string(x='Time', y=eval(attr_names), group='alig')) + - scale_y_continuous(breaks=y.breaks, labels=y.labels) + - scale_x_date(breaks=waiver(), labels=waiver()) + - ylab(attr_names) - - if(show.dist){ - df.dist = do.call("rbind", lapply(df.list, function(df) df$dist)) - df.dist$Dist = paste("Distance:",round(df.dist$Dist,2)) - gp = gp + geom_text(data=df.dist, mapping = aes_string(x='Time', y=eval(attr_names), label='Dist')) - } - - gp -} - - diff --git a/R/plotPaths.R b/R/plotPaths.R deleted file mode 100644 index 00c3052..0000000 --- a/R/plotPaths.R +++ /dev/null @@ -1,129 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting paths -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting low cost paths in the TWDTW -#' cost matrix. -#' -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwMatches}}. -#' @param timeseries.labels The label or index of the time series. -#' Default is 1. -#' @param patterns.labels A vector with labels of the patterns. If not -#' declared the function will plot one alignment for each pattern. -#' @param k A positive integer. The index of the last alignment to include in -#' the plot. If not declared the function will plot all low cost paths. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{plotAlignments}}, -#' \code{\link[dtwSat]{plotCostMatrix}}, -#' \code{\link[dtwSat]{plotMatches}}, and -#' \code{\link[dtwSat]{plotClassification}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' log_fun = logisticWeight(-0.1, 100) -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) -#' -#' plotPaths(mat1) -#' -#' plotPaths(mat1, patterns.labels="Soybean", k=1:2) -#' -#' plotPaths(mat1, patterns.labels=c("Maize","Cotton"), k=2) -#' -#' @export -plotPaths = function(x, timeseries.labels=NULL, patterns.labels=NULL, k=NULL){ - - x = subset(x, timeseries.labels[1], patterns.labels, k) - y = as.character(labels(x)$patterns) - ## Get data - internals = getInternals(x)[[1]] - if(any(sapply(internals, function(x) length(x$internals))<1)) - stop("Plot methods requires internals, set keep=TRUE on twdtwApply() call") - matching = getMatches(x)[[1]] - ts = getTimeSeries(x)[[1]] - patterns = getPatterns(x) - - # Get cost matrix - df.m = do.call("rbind", lapply(y, function(p){ - tx = index(ts) - ty = index(shiftDates(patterns[[p]], year=2005)) - m = internals[[p]]$internals$costMatrix - res = melt(m) - names(res) = c("Var1","Var2","value") - res$Pattern = p - res$tx = tx - res$ty = ty - res - })) - - # Get minimun cost paths - df.path = do.call("rbind", lapply(y, function(p){ - res = do.call("rbind", lapply(seq_along(matching[[p]]$matching), function(i) - data.frame(matching[[p]]$matching[[i]], alignment=i) - )) - res$Pattern = p - res - })) - - ## Set axis breaks and labels - x.labels = pretty_breaks()(range(df.m$tx, na.rm = TRUE)) - timeline = unique( c(df.m$tx, x.labels) ) - x.breaks = zoo( c(unique(df.m$Var2), rep(NA, length(x.labels))), timeline ) - x.breaks = na.approx(x.breaks, rule = 2) - x.axis = data.frame(x.breaks=x.breaks[x.labels], x.labels = names(x.labels)) - - fact = 0 - for(i in seq_along(y)[-1]) fact[i] = fact[i-1] + max(df.m$Var1[df.m$Pattern==y[i]]) - df.m$Var3 = df.m$Var1 + unlist(lapply(seq_along(y), function(i) rep(fact[i], length(which(df.m$Pattern==y[i])) ))) - df.path$Var3 = df.path$index1 + unlist(lapply(seq_along(y), function(i) rep(fact[i], length(which(df.path$Pattern==y[i])) ))) - - y.axis = do.call("rbind", lapply(y, function(p){ - df = df.m[df.m$Pattern==p,] - y.labels = pretty_breaks()(range(df$ty, na.rm = TRUE)) - timeline <- unique(merge(unique(df[,c("ty","Var3")]), data.frame(ty = y.labels[drop = FALSE]), by.x = "ty", by.y = "ty", all.x = TRUE, all.y = TRUE)) - y.breaks <- zoo(timeline$Var3, order.by = timeline$ty) - y.breaks = na.approx(y.breaks, rule = 2) - y.breaks = y.breaks[y.labels] - data.frame(y.breaks, y.labels=names(y.labels)) - })) - - # Plot - gp = ggplot(data=df.m, aes_string(y='Var3', x='Var2')) + - facet_wrap(~Pattern, scales = "free", ncol=1) + - geom_raster(aes_string(fill='value')) + - scale_fill_gradientn(name = 'Warping cost', colours = terrain.colors(100)) + - geom_path(data=df.path, aes_string(y='Var3', x='index2', group='alignment')) + - scale_x_continuous(expand = c(0, 0), breaks=x.axis$x.breaks, labels=x.axis$x.labels) + - scale_y_continuous(expand = c(0, 0), breaks=y.axis$y.breaks, labels=y.axis$y.labels) + - xlab("Time series") + - ylab("Pattern") - - gp - -} - diff --git a/R/plotPatterns.R b/R/plotPatterns.R deleted file mode 100644 index 5bb6bd6..0000000 --- a/R/plotPatterns.R +++ /dev/null @@ -1,78 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting temporal patterns -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting the temporal patterns. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwTimeSeries}}, -#' \code{\link[zoo]{zoo}}, or list of \code{\link[zoo]{zoo}}. -#' @param labels A vector with labels of the time series. If not declared -#' the function will plot all time series. -#' @param year An integer. The base year to shift the dates of the time series to. -#' If NULL then the time series is not shifted. Default is 2005. -#' @param attr An \link[base]{integer} vector or \link[base]{character} vector -#' indicating the attribute for plotting. If not declared the function will plot -#' all attributes. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwTimeSeries-class}} and -#' \code{\link[dtwSat]{plotTimeSeries}} -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' plotPatterns(patt) -#' plotPatterns(patt, attr="evi") -#' -#' @export -plotPatterns = function(x, labels=NULL, attr, year=2005){ - - if(is(x, "twdtwMatches")) x = x@patterns - if(is(x, "twdtwTimeSeries")) x = subset(x, labels) - x = twdtwTimeSeries(x, labels) - labels = labels(x) - - # Shift dates - if(!is.null(year)) x = shiftDates(x, year=year) - - # Build data.frame - if(missing(attr)) attr = names(x[[1]]) - df.p = do.call("rbind", lapply(labels, function(p){ - ts = x[[p]][,attr,drop=FALSE] - data.frame(Time=index(ts), ts, Pattern=p) - })) - df.p = melt(df.p, id.vars=c("Time","Pattern")) - - # Plot temporal patterns - gp = ggplot(df.p, aes_string(x="Time", y="value", colour="variable") ) + - geom_line() + - facet_wrap(~Pattern) + - theme(legend.position = "bottom") + - scale_x_date(labels = date_format("%b")) + - guides(colour = guide_legend(title = "Bands")) + - ylab("Value") - - gp - -} - diff --git a/R/plotTimeSeries.R b/R/plotTimeSeries.R deleted file mode 100644 index f8f05cf..0000000 --- a/R/plotTimeSeries.R +++ /dev/null @@ -1,82 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @title Plotting time series -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Method for plotting the temporal patterns. -#' -#' @param x An object of class \code{\link[dtwSat]{twdtwTimeSeries}}, -#' \code{\link[zoo]{zoo}}, or list of class \code{\link[zoo]{zoo}}. -#' @param labels A vector with labels of the time series. If missing, all -#' elements in the list will be plotted (up to a maximum of 16). -#' @param attr An \link[base]{integer} vector or \link[base]{character} vector -#' indicating the attribute for plotting. If not declared the function will plot -#' all attributes. -#' -#' @return A \link[ggplot2]{ggplot} object. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwTimeSeries-class}} and -#' \code{\link[dtwSat]{plotPatterns}} -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' plotTimeSeries(ts) -#' plotTimeSeries(ts, attr="evi") -#' -#' @export -plotTimeSeries = function(x, labels=NULL, attr){ - - if(is(x, "twdtwMatches")) x = subset(x@timeseries, labels) - if(is(x, "twdtwTimeSeries")) x = subset(x, labels) - if(is.null(labels)) labels = labels(x) - new_labels = labels(x) - labels_tabel = table(new_labels) - if(any(labels_tabel>1)) - for(p in names(labels_tabel)){ - i = p==labels(x) - new_labels[i] = paste(new_labels[i], 1:labels_tabel[p]) - } - x = twdtwTimeSeries(x@timeseries, labels=new_labels) - labels = new_labels - if(length(labels)>16) labels = labels[1:16] - - # Build data.frame - if(missing(attr)) attr = names(x[[1]]) - df.p = do.call("rbind", lapply(as.list(x), function(xx){ - ts = xx[[1]][,attr,drop=FALSE] - data.frame(Time=index(ts), ts, Series=labels(xx)[1]) - })) - df.p = melt(df.p, id.vars=c("Time","Series")) - - # Plot time series - gp = ggplot(df.p, aes_string(x="Time", y="value", colour="variable") ) + - geom_line() + - theme(legend.position = "bottom") + - facet_wrap(~Series, scales = "free_x", ncol=1) + - guides(colour = guide_legend(title = "Bands")) + - ylab("Value") - - gp - -} - - diff --git a/R/plot_patterns.R b/R/plot_patterns.R new file mode 100644 index 0000000..dd983b8 --- /dev/null +++ b/R/plot_patterns.R @@ -0,0 +1,41 @@ +#' Plot Patterns from Time Series Data +#' +#' This function takes a list of time series data and creates a multi-faceted plot +#' where each facet corresponds to a different time series from the list. +#' Within each facet, different attributes (columns of the time series) are +#' plotted as lines with different colors. +#' +#' @param x A list where each element is a data.frame representing a time series. +#' Each data.frame should have the same number of rows and columns, +#' with columns representing different attributes (e.g., bands or indices) +#' and rows representing time points. +#' The name of each element in the list will be used as the facet title. +#' +#' @param ... Not used. +#' +#' @return A ggplot object displaying the time series patterns. +#' +#' @export +plot_patterns = function(x, ...) { + + # Convert the list of time series data into a long-format data.frame + df.p = do.call("rbind", lapply(names(x), function(p) { + ts = x[[p]] + # Create a new data.frame with a 'Time' column and a 'Pattern' column + # representing the name of the current time series (facet name). + data.frame(Time = 1:nrow(ts), ts, Pattern = p) # Assuming the time series are evenly spaced + })) + + # Melt the data into long format suitable for ggplot2 + df.p = melt(df.p, id.vars = c("Time", "Pattern")) + + # Construct the ggplot + gp = ggplot(df.p, aes(x = .data$Time, y = .data$value, colour = .data$variable)) + + geom_line() + + facet_wrap(~Pattern) + + theme(legend.position = "bottom") + + guides(colour = guide_legend(title = "Bands")) + + ylab("Value") + + return(gp) +} \ No newline at end of file diff --git a/R/resampleTimeSeries.R b/R/resampleTimeSeries.R deleted file mode 100644 index d310a9f..0000000 --- a/R/resampleTimeSeries.R +++ /dev/null @@ -1,64 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-22 # -# # -############################################################### - - -#' @title Resample time series -#' @name resampleTimeSeries -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Resample time series in the object to have the same length. -#' -#' @inheritParams twdtwTimeSeries-class -#' @param length An integer. The number of samples to resample the time series to. -#' If not declared the length is set to the length of the longest time series. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwTimeSeries-class}}, and -#' \code{\link[dtwSat]{twdtwApply}} -#' -#' @return An object of class \code{\link[dtwSat]{twdtwTimeSeries}} whose -#' time series have the same number of samples (points). -#' -#' @export -setGeneric("resampleTimeSeries", function(object, length=NULL) standardGeneric("resampleTimeSeries")) - -#' @rdname resampleTimeSeries -#' @aliases resampleTimeSeries-twdtwMatches -#' @examples -#' # Resampling time series from objects of class twdtwTimeSeries -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' npatt = resampleTimeSeries(patt, length=46) -#' nrow(patt) -#' nrow(npatt) -#' -#' @export -setMethod("resampleTimeSeries", "twdtwTimeSeries", - function(object, length) { - if(is.null(length)) length = max(nrow(object), na.rm=TRUE) - twdtwTimeSeries(lapply(object[], resampleTimeSeries.twdtwTimeSeries, length=length), labels=labels(object)) - }) - -resampleTimeSeries.twdtwTimeSeries = function(x, length){ - #labels = as.character(labels(x)) - dates = index(x) - freq = trunc(as.numeric(diff(range(dates)))/(length-1)) - timeline = seq(min(dates, na.rm = TRUE), max(dates, na.rm = TRUE), by=freq) - zoo(data.frame(na.spline(x, xout = timeline)), timeline) -} - - - - - - diff --git a/R/subset.R b/R/subset.R deleted file mode 100644 index f834e33..0000000 --- a/R/subset.R +++ /dev/null @@ -1,171 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-18 # -# # -############################################################### - -#' @title Subset time series -#' @name subset -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Get subsets from objects of class twdtw*. -#' -#' @inheritParams get -#' @param x An objects of class twdtw*. -#' -#' @param k A positive integer. The index of the last alignment to include in -#' the subset. -#' -#' @param e An extent object, or any object from which an Extent object can -#' be extracted. See \link[raster]{crop} for details. -#' -#' @param layers A vector with the names of the \code{twdtwRaster} object to include in -#' the subset. -#' -#' @param labels A character vector with time series labels. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{twdtwTimeSeries-class}}, and -#' \code{\link[dtwSat]{twdtwMatches-class}} -#' -#' @return An object of class twdtw*. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' # Getting time series from objects of class twdtwTimeSeries -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' ts = subset(ts, 2) -#' ts -#' # Getting time series from objects of class twdtwTimeSeries -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat = twdtwApply(x=ts, y=patt, weight.fun=logisticWeight(-0.1,100), -#' keep=TRUE, legacy=TRUE) -#' mat = subset(mat, k=4) -#' -#' ## This example creates a twdtwRaster object and extracts time series from it. -#' -#' # Creating objects of class twdtwRaster with evi and ndvi time series -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, timeline=timeline) -#' -#' rts_evi = subset(rts, layers="evi") -#' -#' field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -#' prj_string = scan(system.file("lucc_MT/data/samples_projection", package="dtwSat"), -#' what = "character") -#' -#' # Extract time series -#' ts_evi = getTimeSeries(rts_evi, y = field_samples, proj4string = prj_string) -#' -#' # Subset all labels = "Forest" -#' ts_forest = subset(ts_evi, labels="Forest") -#' -NULL - -#' @aliases subset-twdtwTimeSeries -#' @inheritParams subset -#' @rdname subset -#' @export -setMethod("subset", "twdtwTimeSeries", function(x, labels=NULL) - subset.twdtwTimeSeries(x=x, labels=labels)) - - -subset.twdtwTimeSeries = function(x, labels){ - if(is.null(labels)) labels = labels(x) - if(is.numeric(labels)) return(twdtwTimeSeries(x@timeseries[labels], labels=x@labels[labels])) - I = which(!is.na(match(x@labels, labels))) - if(length(I)<1) return(new("twdtwTimeSeries")) - twdtwTimeSeries(x@timeseries[I], labels=x@labels[I]) -} - - -#' @aliases subset-twdtwMatches -#' @inheritParams subset -#' @rdname subset -#' @export -setMethod("subset", "twdtwMatches", function(x, timeseries.labels=NULL, patterns.labels=NULL, k=NULL) - subset.twdtwMatches(x=x, timeseries.labels=timeseries.labels, patterns.labels=patterns.labels, k=k) ) - - -subset.twdtwMatches = function(x, timeseries.labels, patterns.labels, k){ - if(is.null(timeseries.labels)) timeseries.labels = as.character(labels(x@timeseries)) - if(is.null(patterns.labels)) patterns.labels = as.character(labels(x@patterns)) - if(is.null(k)) k = 1:length(x) - k = unique(k) - I = timeseries.labels - J = patterns.labels - if(is.character(I)) I = which(!is.na(match(x@timeseries@labels, timeseries.labels))) - if(is.character(J)) J = which(!is.na(match(x@patterns@labels, patterns.labels))) - timeseries = subset(x@timeseries, labels=I) - patterns = subset(x@patterns, labels=J) - names(J) = labels(patterns) - alignments = lapply(I, function(i){ - out = lapply(J, function(j){ - res = x@alignments[[i]][[j]] - k = k[ k<=res$K ] - res$K = length(k) - res$from = res$from[k] - res$to = res$to[k] - res$distance = res$distance[k] - if(length(k)<1) res$label = numeric(0) - if(length(res$matching)>length(k)) res$matching = res$matching[k] - res - }) - # names(out) = patterns.labels - out - }) - twdtwMatches(timeseries=timeseries, patterns=patterns, alignments=alignments) -} - -#' @aliases subset-twdtwRaster -#' @inheritParams subset -#' @rdname subset -#' @export -setMethod("subset", "twdtwRaster", function(x, e=NULL, layers=NULL) - subset.twdtwRaster(x=x, e=e, layers=layers) ) - -subset.twdtwRaster = function(x, e, layers){ - if(is.null(layers)) - layers = names(x) - if(is.null(e)) - e = extent(x) - res = x - res@layers = layers - res@timeseries = res@timeseries[layers] - res@timeseries = lapply(res@timeseries, crop, y=e) - res -} - - - - - - - - - - - - - - - - - - - \ No newline at end of file diff --git a/R/twdtw.R b/R/twdtw.R deleted file mode 100644 index daa97f4..0000000 --- a/R/twdtw.R +++ /dev/null @@ -1,164 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-02-22 # -# # -############################################################### - -.twdtw = function(x, y, weight.fun, dist.method, step.matrix, - n, span, min.length, keep){ - labels = as.character(labels(y)) - names(labels) = labels - timeseries = x[[1]] - # Remove possible NA values - timeseries = timeseries[!apply(is.na(timeseries), 1, all),,drop=FALSE] - - fun = function(l){ - pattern = y[[l]] - # Adjust columns by name if possible - #pattern = pattern[,!is.na(match(names(pattern), names(timeseries)))] - #timeseries = timeseries[,!is.na(match(names(timeseries), names(pattern)))] - - # Get day of the year - ty = index(pattern) - tx = index(timeseries) - doyy = as.numeric(format(index(pattern), "%j")) - doyx = as.numeric(format(index(timeseries), "%j")) - - - # Compute local cost matrix - phi = dist(pattern, timeseries, method=dist.method) - # Time cost matrix - psi = .g(dist(doyy, doyx, method=dist.method)) - # Weighted local cost matrix - cm = weight.fun(phi, psi) - # Compute cost matris - # xm = na.omit(cbind(doyx, as.matrix(timeseries))) - # ym = na.omit(cbind(doyy, as.matrix(pattern))) - # internals = .computecost_fast(xm, ym, step.matrix) - internals = .computecost(cm, step.matrix) - internals$timeWeight = matrix(psi, nrow = nrow(psi)) - internals$localMatrix = matrix(cm, nrow = nrow(cm)) - - # Find low cost candidates - d = internals$costMatrix[internals$N,1:internals$M] - a = internals$startingMatrix[internals$N,1:internals$M] - if(is.null(span)){ - candidates = data.frame(a, d) - candidates = candidates[ candidates$d==ave(candidates$d, candidates$a, FUN=min), ] - candidates$b = as.numeric(row.names(candidates)) - } - else { - b = .findMin(d, tx, span = span) - candidates = data.frame(a[b], d[b], b) - } - - # Order maches by similarity - I = order(candidates$d) - if(length(I)<1) return(NULL) - - # Select alignments - if(is.null(n)) n = length(I) - if(length(I) > n) I = I[1:n] - - # Remove overfit - I = I[diff(range(ty))*min.length <= tx[candidates$b[I]] - tx[candidates$a[I]]] - - alignments = initAlignments() - if(length(I)<1) return(alignments) - - alignments$label = labels[l] - alignments$from = tx[candidates$a[I]] # This is a vector of Dates - alignments$to = tx[candidates$b[I]] # This is a vector of Dates - alignments$distance = candidates$d[I] # This is a numeric vector - alignments$K = length(I) # This is an integer - alignments$matching = list() # This is a list of data.frames with the matching points - alignments$internals = list() # These is a list variables used in the TWDTW computation - if(alignments$K<1) alignments$label = numeric(0) - - if(keep){ - # Trace low cost paths (k-th paths) - alignments$matching = .tracepath(dm=internals$directionMatrix, step.matrix=step.matrix, jmin=candidates$b[I]) - alignments$internals = internals - } - alignments - } - - res = NULL - - if(length(timeseries)>3) - res = try(lapply(seq_along(labels), FUN=fun)) - - if(is(res, "try-error") | is.null(res)) - res = lapply(labels, function(l) list(label = numeric(0), from = numeric(0), to = numeric(0), distance = numeric(0), K = numeric(0), matching = list(), internals = list())) - - names(res) = labels - res -} - -initAlignments = function(...){ - list( - label = numeric(0), - from = numeric(0), - to = numeric(0), - distance = numeric(0), - K = 0, - matching = list(), - internals = list() - ) -} - -.findMin = function(x, timeline, span){ - NonNA = which(!is.na(x)) - dx = diff(x[NonNA]) - index_min = NonNA[which(dx[-length(dx)] < 0 & dx[-1] >= 0)] + 1 - if(tail(dx,1) < 0) - index_min = c(index_min,length(x)) - order_min = index_min[order(x[index_min])] - min_out = array() - for(i in seq_along(index_min)){ - min_out[i] = order_min[i] - lower_bound = timeline[order_min[i]] - span - upper_bound = timeline[order_min[i]] + span - in_span = lower_bound <= timeline[order_min] & timeline[order_min] <= upper_bound - order_min[in_span] = NA - } - res = min_out[!is.na(min_out)] - res -} - -.removeConcurrent = function(I, startPoints, endPoints, d){ - res = !(I | duplicated(startPoints, fromLast = TRUE)) - J = unlist(lapply(unique(startPoints[!res]), function(i){ - J = which(startPoints==i) - min_j = rep(FALSE, length(J)) - min_j[which.min(d[endPoints[J]])] = TRUE - min_j - })) - res[!res] = J - res -} - -# @useDynLib dtwSat g -.g = function(phi, step.matrix){ - - if(!is.loaded("g", PACKAGE = "dtwSat", type = "Fortran")) - stop("Fortran lib is not loaded") - - n = nrow(phi) - m = ncol(phi) - res = .Fortran(g, - TM = matrix(as.double(phi), n, m), - N = as.integer(n), - M = as.integer(m), - PC = as.double(366)) - res$TM -} - diff --git a/R/twdtwApply.R b/R/twdtwApply.R deleted file mode 100644 index b27e4ae..0000000 --- a/R/twdtwApply.R +++ /dev/null @@ -1,513 +0,0 @@ -#' @include methods.R -#' @title Apply TWDTW analysis -#' @name twdtwApply -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This function performs a multidimensional Time-Weighted DTW -#' analysis and retrieves the matches between the temporal patterns and -#' a set of time series \insertCite{Maus:2019}{dtwSat}. -#' -#' @inheritParams twdtwClassify -#' -#' @param x An object of class twdtw*. This is the target time series. -#' Usually, it is a set of unclassified time series. -#' -#' @param y An object of class \link[dtwSat]{twdtwTimeSeries}. -#' The temporal patterns. -#' -#' @param ... Arguments to pass to \code{\link[raster]{writeRaster}} and -#' \code{\link[raster]{pbCreate}} -#' -#' @param resample Resample the patterns to have the same length. Default is TRUE. -#' See \link[dtwSat]{resampleTimeSeries} for details. -#' -#' @param length An integer. Length of patterns used with \code{patterns.length}. -#' If not declared the length of the output patterns will be the length of -#' the longest pattern. -#' -#' @param weight.fun A function. Any function that receives two matrices and -#' performs a computation on them, returning a single matrix with the same -#' dimensions. The first matrix is the DTW local cost matrix and the -#' second a matrix of the time differences in days. The function should return a -#' matrix of DTW local cost weighted by the time differences. If not declared -#' the time-weight is zero. In this case the function runs the standard version -#' of the dynamic time warping. See details. -#' -#' @param dist.method A character. Method to derive the local cost matrix. -#' Default is ''Euclidean'' see \code{\link[proxy]{dist}} in package -#' \pkg{proxy}. -#' -#' @param step.matrix See \code{\link[dtw]{stepPattern}} in package \pkg{dtw} -#' \insertCite{Giorgino:2009}{dtwSat}. -#' -#' @param n An integer. The maximun number of matches to perform. -#' NULL will return all matches. -#' -#' @param keep Preserves the cost matrix, inputs, and other internal structures. -#' Default is FALSE. For plot methods use \code{keep=TRUE}. -#' -#' @param span A number. Span between two matches, \emph{i.e.} the minimum -#' interval between two matches; for details see \insertCite{Muller:2007}{dtwSat}. -#' If not declared it removes all overlapping matches of the same pattern. To include -#' overlapping matches of the same pattern use \code{span=0}. -#' -#' @param min.length A number between 0 an 1. This argument removes overfittings. -#' Minimum length after warping. Percentage of the original pattern length. Default is 0.5, -#' meaning that the matching cannot be shorter than half of the pattern length. -#' -#' @param filepath A character. The path at which to save the raster with results. If not provided the -#' function saves in the current work directory. -#' -#' @param minrows Integer. Minimum number of rows in each block -#' -#' @param progress character. 'text' or 'window'. -#' -#' @param legacy logical. If FALSE, runs a faster new TWDTW implementation. Default FLASE -#' -#' @param alpha Numeric. The steepness of TWDTW logistic weight. -#' -#' @param beta Numeric. The midpoint of TWDTW logistic weight. -#' -#' @references -#' \insertAllCited{} -#' -#' @details The linear \code{linearWeight} and \code{logisticWeight} weight functions -#' can be passed to \code{twdtwApply} through the argument \code{weight.fun}. This will -#' add a time-weight to the dynamic time warping analysis. The time weight -#' creates a global constraint useful for analyzing time series with phenological cycles -#' of vegetation that are usually bound to seasons. In previous studies by -#' \insertCite{Maus:2016}{dtwSat} the logistic weight had better results than the -#' linear for land cover classification. -#' See \insertCite{Maus:2016,Maus:2019}{dtwSat} for details about the method. -#' -#' @return An object of class twdtw*. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwTimeSeries-class}}, -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' \code{\link[dtwSat]{getTimeSeries}}, and -#' \code{\link[dtwSat]{createPatterns}} -#' -#' @export -setGeneric(name = "twdtwApply", - def = function(x, y, resample=TRUE, length=NULL, weight.fun=function(phi, psi) phi, - dist.method="Euclidean", step.matrix = symmetric1, n=NULL, - span=NULL, min.length=0, ...) standardGeneric("twdtwApply")) - -#' @rdname twdtwApply -#' @aliases twdtwApply-twdtwTimeSeries -#' @examples -#' # Applying TWDTW analysis to objects of class twdtwTimeSeries -#' log_fun = logisticWeight(-0.1, 100) -#' ts = twdtwTimeSeries(MOD13Q1.ts.list) -#' patt = twdtwTimeSeries(MOD13Q1.patterns.list) -#' mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) -#' mat1 -#' -#' \dontrun{ -#' # Parallel processin -#' require(parallel) -#' mat_list = mclapply(as.list(ts), mc.cores=2, FUN=twdtwApply, y=patt, weight.fun=log_fun) -#' mat2 = twdtwMatches(alignments=mat_list) -#' } -#' @export -setMethod(f = "twdtwApply", "twdtwTimeSeries", - def = function(x, y, resample, length, weight.fun, dist.method, step.matrix, n, span, min.length, legacy=FALSE, keep=FALSE, ...){ - if(!is(y, "twdtwTimeSeries")) - stop("y is not of class twdtwTimeSeries") - if(!is(step.matrix, "stepPattern")) - stop("step.matrix is not of class stepPattern") - if(is.null(weight.fun)) - weight.fun = function(psi) 0 - if(!is(weight.fun, "function")) - stop("weight.fun is not a function") - if(resample) - y = resampleTimeSeries(object=y, length=length) - if(legacy){ - twdtwApply.twdtwTimeSeries(x, y, weight.fun, dist.method, step.matrix, n, span, min.length, keep) - } else { - twdtwApply.twdtwTimeSeries.fast(x, y, ...) - } - - }) - -twdtwApply.twdtwTimeSeries.fast = function(x, y, ...){ - yy = lapply(y@timeseries, function(ts)cbind(data.frame(date = index(ts)), as.data.frame(ts))) - xm = lapply(x@timeseries, function(ts)twdtwReduceTime(cbind(data.frame(date = index(ts)), as.data.frame(ts)), keep = FALSE, y = yy, ...)) - lb = as.numeric(labels(y@labels)) - lv = levels(y) - names(lb) = lv - list(x = x, y = y, aligs = lapply(xm, function(al) lapply(lb, function(i){ - bm = list(label = numeric(), - from = numeric(), - to = numeric(), - distance = numeric(), - K = 0, - matching = list(), - internals = list()) - if(!any(al$label == i)){ - return(bm) - } - bm$label = lv[i] - bm$from = al$from[al$label == i] - bm$to = al$to[al$label == i] - bm$distance = al$distance[al$label == i] - bm$K = length(bm$distance) - return(bm) - }))) -} - -twdtwApply.twdtwTimeSeries = function(x, y, weight.fun, dist.method, step.matrix, n, span, min.length, keep){ - res = lapply(as.list(x), FUN = .twdtw, y, weight.fun, dist.method, step.matrix, n, span, min.length, keep) - new("twdtwMatches", timeseries=x, patterns=y, alignments=res) -} - -#' @rdname twdtwApply -#' @aliases twdtwApply-twdtwRaster -#' @example examples/test_twdtw_raster_analysis.R -#' @export -setMethod(f = "twdtwApply", "twdtwRaster", - def = function(x, y, resample, length, weight.fun, dist.method, step.matrix, n, span, min.length, - breaks=NULL, from=NULL, to=NULL, by=NULL, overlap=0.5, filepath="", fill=NULL, - legacy=FALSE, progress = "text", minrows=1, alpha = -0.1, beta = 50, ...){ - if(!is(step.matrix, "stepPattern")) - stop("step.matrix is not of class stepPattern") - if(is.null(weight.fun)) - weight.fun = function(psi) 0 - if(!is(weight.fun, "function")) - stop("weight.fun is not a function") - if( overlap < 0 & 1 < overlap ) - stop("overlap out of range, it must be a number between 0 and 1") - if(is.null(breaks)) - if( !is.null(from) & !is.null(to) ){ - breaks = seq(as.Date(from), as.Date(to), by=by) - } else { - patt_range = lapply(index(y), range) - patt_diff = trunc(sapply(patt_range, diff)/30)+1 - min_range = which.min(patt_diff) - by = patt_diff[[min_range]] - from = patt_range[[min_range]][1] - to = from - month(to) = month(to) + by - year(from) = year(range(index(x))[1]) - year(to) = year(range(index(x))[2]) - if(to0) datasets = lapply(datasets, function(x) x[-k] ) - - # Build multi-band zoo object - zoo(data.frame(datasets[-idoy]), order.by = datasets$doy) -} - -# Match and set a list of arguments to a function -.setFunArgs = function(fun, ..., args = list(...)){ - base_formals = formals(fun) - base_formals_names = names(base_formals) - given_formals = args[names(args) %in% base_formals_names] - missing_formals_names = setdiff(base_formals_names, names(args)) - new_formals = c(base_formals[missing_formals_names], given_formals) - new_formals = new_formals[base_formals_names] - formals(fun) = new_formals - fun -} diff --git a/R/twdtwAssess.R b/R/twdtwAssess.R deleted file mode 100644 index 8799427..0000000 --- a/R/twdtwAssess.R +++ /dev/null @@ -1,359 +0,0 @@ - -setGeneric("twdtwAssess", - def = function(object, ...) standardGeneric("twdtwAssess") -) - -#' @title Assess TWDTW classification -#' @name twdtwAssess -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Performs an accuracy assessment -#' of the classified maps. The function returns Overall Accuracy, -#' User's Accuracy, Produce's Accuracy, error matrix (confusion matrix), -#' and estimated area according to \insertCite{Olofsson:2013,Olofsson:2014;textual}{dtwSat}. -#' The function returns the metrics for each time interval and a summary considering all -#' classified intervals. -#' -#' @param object An object of class \code{\link[dtwSat]{twdtwRaster}} resulting from -#' the classification, i.e. \code{\link[dtwSat]{twdtwClassify}}. -#' The argument can also receive an error matrix (confusion matrix) using the classes -#' \code{\link[base]{data.frame}} or \code{\link[base]{table}}. In this case the user -#' must provide the area for each class to the argument \code{area}. -#' -#' @param area A numeric vector with the area for each class if the argument \code{object} -#' is an error matrix (confusion matrix). If \code{object} is \code{\link[dtwSat]{twdtwMatches}} -#' area can be either a vector with the area of each classified object, or a single number -#' if the objects are single pixels. - -#' @param y A \code{\link[base]{data.frame}} whose attributes are: longitude, -#' latitude, the start ''from'' and the end ''to'' of the time interval -#' for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} -#' whose attributes are the start ''from'' and the end ''to'' of the time interval. -#' If missing ''from'' and/or ''to'', they are set to the time range of the -#' \code{object}. -#' -#' @param id.labels A numeric or character with an column name from \code{y} to -#' be used as samples labels. Optional. -#' -#' @param labels Character vector with time series labels. For signature -#' \code{\link[dtwSat]{twdtwRaster}} this argument can be used to set the -#' labels for each sample in \code{y}, or it can be combined with \code{id.labels} -#' to select samples with a specific label. -#' -#' @param proj4string Projection string, see \code{\link[sp]{CRS-class}}. Used -#' if \code{y} is a \code{\link[base]{data.frame}}. -#' -#' @param conf.int Specifies the confidence level (0-1). -#' -#' @param rm.nosample If sum of columns and sum of rows of the error matrix are zero -#' then remove class. Default is TRUE. -#' -#' @param start_date A date. Required if there is only one map to be assessed. Usually this is the -#' first date of the timeline from satellite images. -#' -#' @references -#' \insertAllCited{} -#' -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @seealso \code{\link[dtwSat]{twdtwClassify}}, -#' \code{\link[dtwSat]{twdtwAssessment}}, and -#' \code{\link[dtwSat]{twdtwXtable}}. -#' -NULL - -#' @aliases twdtwAssess-twdtwRaster -#' @inheritParams twdtwAssess -#' @rdname twdtwAssess -#' @example examples/test_twdtw_raster_analysis.R -#' @export -setMethod(f = "twdtwAssess", signature = "twdtwRaster", - definition = function(object, y, labels=NULL, id.labels=NULL, proj4string=NULL, conf.int=.95, rm.nosample=FALSE, start_date=NULL) - twdtwAssess.twdtwRaster(object, y, labels, id.labels, proj4string, conf.int, rm.nosample, start_date)) - -#' @aliases twdtwAssess-data.frame -#' @inheritParams twdtwAssess -#' @rdname twdtwAssess -#' @export -setMethod(f = "twdtwAssess", signature = "data.frame", - definition = function(object, area, conf.int=.95, rm.nosample=TRUE) - twdtwAssess.table(object, area, conf.int, rm.nosample)) - -#' @aliases twdtwAssess-table -#' @inheritParams twdtwAssess -#' @rdname twdtwAssess -#' @export -setMethod(f = "twdtwAssess", signature = "table", - definition = function(object, area, conf.int=.95, rm.nosample=TRUE) - twdtwAssess(as.data.frame.matrix(object), area, conf.int, rm.nosample)) - -#' @aliases twdtwAssess-matrix -#' @inheritParams twdtwAssess -#' @rdname twdtwAssess -#' -#' @examples -#' -#' # Total mapped area by class. Data from [1] -#' area = c(A = 22353, B = 1122543, C = 610228) -#' -#' # Error matrix, columns (Reference) rows (Map) -#' x = -#' rbind( -#' c( 97, 0, 3), -#' c( 3, 279, 18), -#' c( 2, 1, 97) -#' ) -#' -#' table_assess = twdtwAssess(x, area, conf.int = .95) -#' -#' table_assess -#' -#' plot(table_assess, type="area", perc=FALSE) -#' -#' plot(table_assess, type="accuracy") -#' -#' @export -setMethod(f = "twdtwAssess", signature = "matrix", - definition = function(object, area, conf.int=.95, rm.nosample=TRUE) - twdtwAssess(as.data.frame.matrix(object), area, conf.int, rm.nosample)) - -#' @aliases twdtwAssess-twdtwMatches -#' @inheritParams twdtwAssess -#' @rdname twdtwAssess -#' @example examples/test_twdtw_raster_analysis.R -#' @export -setMethod(f = "twdtwAssess", signature = "twdtwMatches", - definition = function(object, area, conf.int=.95, rm.nosample=TRUE) - twdtwAssess.twdtwTimeSeries(object, area, conf.int, rm.nosample)) - -twdtwAssess.twdtwTimeSeries = function(object, area, conf.int, rm.nosample){ - - df = do.call("rbind", lapply(object[], function(xx) xx[which.min(xx$distance),]) ) - - ref = labels(object)$timeseries - - pred = as.character(df$label) - - data = data.frame(.adjustFactores(ref, pred, levels=NULL, labels=NULL), df[,!names(df)%in%"labels"]) - - error_matrix = table(Predicted=data$Predicted, Reference=data$Reference) - - if(length(area)==1) - a = rep(area, length(object@timeseries)) - - a = aggregate(x = a, by = list(pred), FUN = sum) - - area = a$x - - names(area) = a$Group.1 - - res = .twdtwAssess(error_matrix, area, conf.int, rm.nosample) - - new("twdtwAssessment", accuracySummary=res) -} - -twdtwAssess.table = function(object, area, conf.int, rm.nosample){ - - if(ncol(object)!=nrow(object)) - stop("object has have the same number of rows and columns") - - if(nrow(object)!=length(area)) - stop("area must have length equal to the number of rows in object") - - accuracy = .twdtwAssess(object, area, conf.int, rm.nosample) - - new("twdtwAssessment", accuracySummary=accuracy, accuracyByPeriod=accuracy) -} - -twdtwAssess.twdtwRaster = function(object, y, labels, id.labels, proj4string, conf.int, rm.nosample, start_date){ - - if(rm.nosample) - warning("The argument rm.nosample is obsolete and will be removed in the next package release") - - # Check control points - y = .adjustLabelID(y, labels, id.labels) - if(!"from"%in%names(y) || !"to"%in%names(y)) - stop("Argument 'y' must contain columns called 'to' and 'from' to locate start and end dates") - y = .toSpatialPointsDataFrame(y, object, proj4string) - - # Get classified raster - x = object@timeseries$Class - x_twdtw = object@timeseries$Distance - - # Reproject points to raster projection - y = spTransform(y, CRS(projection(object@timeseries[[1]]))) - - # Remove samples outside raster bbox - n_s <- length(y) - y <- intersect(y, x) - if(n_s > length(y)){ - warning(cat(n_s - length(y), "samples out of bounds removed")) - } - if(length(y) < 1){ - stop(cat(n_s - length(y), "samples out of bounds removed. There are no samples intersecting the study area")) - } - - # Get time intervals - timeline = index(object) - if(length(timeline) < 2){ - if(is.null(start_date)){ - stop("The classification assessment requires matching time intervals. - If there is only one map please provide the starting date of the map interval - using the argument 'start_date'") - } - timeline = c(as.Date(start_date), timeline) - } else { - timeline = c(timeline[1] - diff(timeline[1:2]) - 1, timeline) - } - - r_intervals = data.frame(from=timeline[-length(timeline)], to=timeline[-1]) - - # Get land use/cover classes - rnames = labels(object) - rlevels = levels(object) - - # Compute mapped area of each class by classification interval - a_by_interval = lapply(1:nlayers(x), FUN = .getAreaByClass, x, rlevels, rnames) - - # Compute total mapped area by class - area_by_class = do.call("rbind", a_by_interval) - area_by_class = colSums(area_by_class) - - # Get classified and predicted land cover/use classes for each control point - pred_classes = extract(x, y) - pred_distance = extract(x_twdtw, y) - samples_by_period = lapply(1:nrow(r_intervals), FUN = .getPredRefClasses, r_intervals, pred_classes, pred_distance, y, rlevels, rnames) - samples_all = do.call("rbind", samples_by_period) - - # Compute error matrix - error_matrix_by_period = lapply(1:nrow(r_intervals), function(i) table(samples_by_period[[i]][,c("Predicted","Reference")])) - error_matrix_summary = table(samples_all[,c("Predicted","Reference")]) - - # Compute accuracy assessment - accuracy_by_period = lapply(seq_along(error_matrix_by_period), function(i) - .twdtwAssess(x = error_matrix_by_period[[i]], a_by_interval[[i]], conf.int=conf.int, rm.nosample=FALSE)) - names(accuracy_by_period) = index(object) - accuracy_summary = .twdtwAssess(error_matrix_summary, area_by_class, conf.int=conf.int, rm.nosample=FALSE) - - sp.data = SpatialPointsDataFrame(coords = samples_all[,c("longitude", "latitude")], - data = samples_all[,!names(samples_all)%in%c("longitude", "latitude")], - proj4string = CRS(projection(object@timeseries[[1]]))) - - new("twdtwAssessment", accuracySummary = accuracy_summary, - accuracyByPeriod = accuracy_by_period, - data = sp.data, - map = object) - -} - -.twdtwAssess = function(x, mapped_area, conf.int, rm.nosample){ - - if(nrow(x)<1) - return(NULL) - - mult = qnorm(1-(1-conf.int)/2, mean = 0, sd = 1) - - cnames = names(mapped_area) - rownames(x) = cnames - names(x) = cnames - - total_map = rowSums(x) - total_ref = colSums(x) - total_area = sum(mapped_area) - total_samples = sum(total_ref) - - if(rm.nosample){ - I = total_ref>0 | total_map>0 - x = x[I,I] - cnames = cnames[I] - total_map = total_map[I] - total_ref = total_ref[I] - mapped_area = mapped_area[I] - total_area = sum(mapped_area) - total_samples = sum(total_ref) - } - - # Weight - w = mapped_area / total_area - - # Error matrix - error_matrix = cbind(x, Total=total_map, Area=mapped_area, w=w) - error_matrix = rbind(error_matrix, Total = colSums(error_matrix)) - - # Proportions - y = t(apply(error_matrix[!rownames(error_matrix)%in%"Total",], 1, function(x) (x[cnames] / x["Total"]) * x["w"])) - y[total_map==0,] = 0 - total_prop_map = rowSums(y, na.rm = TRUE) - total_prop_ref = colSums(y, na.rm = TRUE) - - # Proportions matrix - prop_matrix = cbind(y, Total = total_prop_map, Area = mapped_area, w = w) - prop_matrix = rbind(prop_matrix, Total = colSums(prop_matrix, na.rm = TRUE)) - - # Accuracy - UA = as.numeric(diag(as.matrix(prop_matrix[cnames,cnames])) / prop_matrix[cnames,"Total"]) - UA[total_map==0] = 1 - names(UA) = cnames - - PA = as.numeric(diag(as.matrix(prop_matrix[cnames,cnames])) / prop_matrix["Total",cnames]) - PA[total_ref==0] = 1 - names(PA) = cnames - OA = sum(diag(as.matrix(prop_matrix[cnames,cnames])), na.rm = TRUE) - - temp = w^2*UA*(1-UA)/(total_map-1) - - VO = sum(temp, na.rm = TRUE) - SO = sqrt(VO) - OCI = SO * mult - - VU = UA*(1-UA)/(total_map-1) - SU = sqrt(VU) - UCI = SU * mult - - fun1 = function(x, xt, Area){ - sum(Area*x/xt, na.rm = TRUE) - } - - fun2 = function(i, x, xt, Area, PA){ - x = as.numeric(x[,i]) - x = x[-i] - xt = xt[-i] - Area = Area[-i] - PA = PA[i] - PA^2*sum(Area^2*x/xt*(1-x/xt)/(xt-1), na.rm = TRUE) - } - - Nj = apply(x, 2, fun1, total_map, mapped_area) - expr1 = mapped_area^2*(1-PA)^2*UA*(1-UA)/(total_map-1) - expr2 = sapply(1:nrow(x), fun2, x=x, xt=total_map, Area=mapped_area, PA=PA) - VP = (1/sapply(Nj, function(x) ifelse(x==0, 1, x))^2)*(expr1+expr2) - SP = sapply(VP, function(x) ifelse(x==0, 0, sqrt(x))) - PCI = SP * mult - - # Compute adjusted area - estimated_area = prop_matrix["Total",cnames] * prop_matrix["Total","Area"] - sd_error = apply(prop_matrix[cnames,cnames], 2, function(x) sqrt(sum( (prop_matrix[cnames,"w"]*x[cnames]-x[cnames]^2)/(error_matrix[cnames,"Total"]-1) )) ) - sd_error_estimated_area = sd_error * prop_matrix["Total","Area"] - CI_estimated_area = sd_error_estimated_area * mult - - res = list(OverallAccuracy = c(Accuracy=OA, Var=VO, sd=SO, ci=OCI), - UsersAccuracy = cbind(Accuracy=UA, Var=VU, sd=SU, ci=UCI), - ProducersAccuracy = cbind(Accuracy=PA, Var=VP, sd=SP, ci=PCI), - AreaUncertainty = cbind(Mapped=c(prop_matrix[cnames,"Area"]), - Adjusted=c(estimated_area), - ci=c(CI_estimated_area)), - ErrorMatrix = error_matrix, - ProportionMatrix = prop_matrix, - conf.int = conf.int - ) - - res - -} - - - - - diff --git a/R/twdtwClassify.R b/R/twdtwClassify.R deleted file mode 100644 index 7c47619..0000000 --- a/R/twdtwClassify.R +++ /dev/null @@ -1,281 +0,0 @@ -############################################################### -# # -# (c) Victor Maus # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2016-01-16 # -# # -############################################################### - - -#' @include methods.R -#' @title Classify time series -#' @name twdtwClassify -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description This function classifies the intervals of a time series -#' based on the TWDTW results. -#' -#' @inheritParams twdtwReduceTime -#' -#' @param x An object of class twdtw*. This is the target time series. -#' Usually, it is a set of unclassified time series. -#' -#' @param from A character or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd". -#' -#' @param to A \code{\link[base]{character}} or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd". -#' -#' @param by A \code{\link[base]{character}} with the interval size, \emph{e.g.} "6 month". -#' -#' @param breaks A vector of class \code{\link[base]{Dates}}. This replaces the arguments \code{from}, -#' \code{to}, and \code{by}. -#' -#' @param overlap A number between 0 and 1. The minimum overlapping -#' between one match and the interval of classification. Default is 0.5, -#' \emph{i.e.} an overlap minimum of 50\%. -#' -#' @param patterns.labels a vector with labels of the patterns. -#' -#' @param thresholds A numeric vector the same length as \code{patterns.labels}. -#' The TWDTW dissimilarity thresholds, i.e. the maximum TWDTW cost for consideration -#' in the classification. Default is \code{Inf} for all \code{patterns.labels}. -#' -#' @param fill A character to fill the classification gaps. -#' For signature \code{twdtwTimeSeries} the default is \code{fill="unclassified"}, -#' for signature \code{twdtwRaster} the default is \code{fill="unclassified"}. -#' -#' @param filepath A character. The path at which to save the raster with results. -#' If not provided the function saves in the same directory as the input time series raster. -#' -#' @param ... Arguments to pass to specific methods for each twdtw* class -#' and other arguments to pass to \code{\link[raster]{writeRaster}} and -#' \code{\link[raster]{pbCreate}}. If \code{x} of -#' \code{\link[dtwSat]{twdtwTimeSeries-class}} additional arguments passed to -#' \code{\link[dtwSat]{twdtwApply}}. -#' -#' @return An object of class twdtw*. -#' -#' @seealso -#' \code{\link[dtwSat]{twdtwApply}}, -#' \code{\link[dtwSat]{twdtwMatches-class}}, -#' \code{\link[dtwSat]{twdtwTimeSeries-class}}, and -#' \code{\link[dtwSat]{twdtwRaster-class}}, -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @export -setGeneric(name = "twdtwClassify", - def = function(x, ...) standardGeneric("twdtwClassify")) - - -#' @rdname twdtwClassify -#' @aliases twdtwClassify-data.frame -#' @example examples/test_twdtw_raster_analysis.R -#' @export -setMethod(f = "twdtwClassify", "data.frame", - def = function(x, y, step.matrix=symmetric1, breaks=NULL, from=NULL, to=NULL, by=NULL, - overlap=0.5,fill=length(y),alpha=-0.1,beta=50,time.window=FALSE, keep=FALSE, ...){ - twdtwReduceTime(x=x, y=y, step.matrix=step.matrix, breaks=breaks, from=from, to=to, by=by, - overlap=overlap,fill=fill,alpha=alpha,beta=beta,time.window=time.window,keep=keep, ...) - }) - -#' @rdname twdtwClassify -#' @aliases twdtwClassify-list -#' @example examples/test_twdtw_raster_analysis.R -#' @export -setMethod(f = "twdtwClassify", "list", - def = function(x, y, step.matrix=symmetric1, breaks=NULL, from=NULL, to=NULL, by=NULL, - overlap=0.5,fill=length(y),alpha=-0.1,beta=50,time.window=FALSE, keep=FALSE, ...){ - lapply(x, FUN = twdtwReduceTime, y=y, step.matrix=step.matrix, breaks=breaks, from=from, to=to, by=by, - overlap=overlap,fill=fill,alpha=alpha,beta=beta,time.window=time.window,keep=keep, ...) - }) - -#' @rdname twdtwClassify -#' @aliases twdtwClassify-twdtwTimeSeries -#' @example examples/test_twdtw_raster_analysis.R -#' @export -setMethod("twdtwClassify", "twdtwTimeSeries", - function(x, patterns.labels=NULL, from=NULL, to=NULL, by=NULL, breaks=NULL, - overlap=.5, thresholds=Inf, fill="unclassified", ...){ - xm = twdtwApply(x = x, from = from, to = to, by = by, breaks = breaks, ...) - if(is(xm, "twdtwMatches")){ - x = xm - if(is.null(patterns.labels)) patterns.labels = labels(x@patterns) - if( overlap < 0 & 1 < overlap ) - stop("overlap out of range, it must be a number between 0 and 1") - if(is.null(breaks)) - if( !is.null(from) & !is.null(to) ){ - breaks = seq(as.Date(from), as.Date(to), by=by) - } else { - # These automatic breaks needs to be improved - y = x@patterns - patt_range = lapply(index(y), range) - patt_diff = trunc(sapply(patt_range, diff)/30)+1 - min_range = which.min(patt_diff) - by = patt_diff[[min_range]] - cycles = c(18,12,6,4,3,2) - by = cycles[which.min(abs(by-cycles))] - from = patt_range[[min_range]][1] - to = from - month(to) = month(to) + by - dates = as.Date(unlist(index(x@timeseries))) - year(from) = year(min(dates)) - year(to) = year(max(dates)) - breaks = seq(from, to, paste(by,"month")) - } - breaks = as.Date(breaks) - twdtwClassify.twdtwMatches(x, patterns.labels=patterns.labels, breaks=breaks, - overlap=overlap, thresholds=thresholds, fill=fill) - } else { - new("twdtwMatches", timeseries=xm$x, patterns=xm$y, alignments=xm$aligs) - } - }) - -#' @rdname twdtwClassify -#' @aliases twdtwClassify-twdtwTimeSeries -#' @example examples/test_twdtw_raster_analysis.R -#' @export -setMethod("twdtwClassify", "twdtwMatches", - function(x, patterns.labels=NULL, from=NULL, to=NULL, by=NULL, breaks=NULL, - overlap=.5, thresholds=Inf, fill="unclassified"){ - if(is.null(patterns.labels)) patterns.labels = labels(x@patterns) - if( overlap < 0 & 1 < overlap ) - stop("overlap out of range, it must be a number between 0 and 1") - if(is.null(breaks)) - if( !is.null(from) & !is.null(to) ){ - breaks = seq(as.Date(from), as.Date(to), by=by) - } else { - # These automatic breaks needs to be improved - y = x@patterns - patt_range = lapply(index(y), range) - patt_diff = trunc(sapply(patt_range, diff)/30)+1 - min_range = which.min(patt_diff) - by = patt_diff[[min_range]] - cycles = c(18,12,6,4,3,2) - by = cycles[which.min(abs(by-cycles))] - from = patt_range[[min_range]][1] - to = from - month(to) = month(to) + by - dates = as.Date(unlist(index(x@timeseries))) - year(from) = year(min(dates)) - year(to) = year(max(dates)) - breaks = seq(from, to, paste(by,"month")) - } - breaks = as.Date(breaks) - twdtwClassify.twdtwMatches(x, patterns.labels=patterns.labels, breaks=breaks, - overlap=overlap, thresholds=thresholds, fill=fill) - }) - -#' @rdname twdtwClassify -#' @aliases twdtwClassify-twdtwRaster -#' @example examples/test_twdtw_raster_analysis.R -setMethod("twdtwClassify", "twdtwRaster", - function(x, patterns.labels=NULL, thresholds=Inf, fill=255, filepath="", ...){ - if(is.null(patterns.labels)) patterns.labels = coverages(x) - patterns.labels = patterns.labels[!patterns.labels%in%"doy"] - twdtwClassify.twdtwRaster(x, patterns.labels=patterns.labels, thresholds=thresholds, fill=fill, filepath=filepath, ...) - }) - -twdtwClassify.twdtwRaster = function(x, patterns.labels, thresholds, fill, filepath, ...){ - - if(thresholds == Inf) { - thresholds = 9999 - } - - levels = c(seq_along(patterns.labels), fill) - labels = c(patterns.labels, "unclassified") - - # Create output raster objects - class_b <- brick(x@timeseries[[1]], nl = length(index(x)), values = FALSE) - distance_b <- brick(x@timeseries[[1]], nl = length(index(x)), values = FALSE) - class_vv <- matrix(class_b, ncol = nlayers(class_b)) - distance_vv <- matrix(distance_b, ncol = nlayers(distance_b)) - names(class_b) = paste0("date.",index(x)) - names(distance_b) = paste0("date.",index(x)) - - filepath <- trim(filepath) - filename <- NULL - if (filepath != "") { - dir.create(path = filepath, showWarnings = TRUE, recursive = TRUE) - filename <- paste0(filepath, "/", c("Class", "Distance"), ".grd") - names(filename) <- c("Class", "Distance") - } else if (!canProcessInMemory(class_b, n = length(x@timeseries) + 2)) { - filename <- c(rasterTmpFile("Class"), rasterTmpFile("Distance")) - } - - if (!is.null(filename)) { - class_b <- writeStart(class_b, filename = filename[1], ...) - distance_b <- writeStart(distance_b, filename = filename[2], ...) - } - - bs <- blockSize(x@timeseries[[1]]) - bs$array_rows <- cumsum(c(1, bs$nrows * class_b@ncols)) - pb <- pbCreate(bs$n, ...) - - for(k in 1:bs$n){ - - v <- lapply(x@timeseries[patterns.labels], getValues, row = bs$row[k], nrows = bs$nrows[k]) - rows <- seq(from = bs$array_rows[k], by = 1, length.out = bs$nrows[k]*class_b@ncols) - - for(i in seq_along(index(x))) { - - r <- sapply(v, function(vv) vv[, i]) - d <- apply(r, 1, min) - dc <- apply(r, 1, which.min) - dc[which(d[]>=thresholds)] = fill - class_vv[rows, i] <- dc - distance_vv[rows, i] <- d - } - - if (!is.null(filename)) { - writeValues(class_b, class_vv[rows, ], bs$row[k]) - writeValues(distance_b, distance_vv[rows, ], bs$row[k]) - } - - pbStep(pb, k) - - } - - if (!is.null(filename)) { - class_b <- writeStop(class_b) - distance_b <- writeStop(distance_b) - } else { - class_b <- setValues(class_b, values = class_vv) - distance_b <- setValues(distance_b, values = distance_vv) - } - - pbClose(pb) - - twdtwRaster(Class = class_b, Distance = distance_b, ..., timeline = index(x), - labels = labels, levels = levels, filepath = filepath) - -} - -twdtwClassify.twdtwMatches = function(x, patterns.labels, breaks, overlap, thresholds, fill){ - levels = as.character(patterns.labels) - names(levels) = levels - m = length(levels) - n = length(breaks)-1 - aligs = lapply(as.list(x), FUN=.bestIntervals, m=m, n=n, levels=levels, breaks=breaks, overlap=overlap) - twdtwMatches(x@timeseries, patterns=x@patterns, alignments=aligs) -} - -.bestIntervals = function(x, m, n, levels, breaks, overlap) -{ - best_matches = .bestmatches(x, m, n, levels, breaks, overlap)$IM - IL = best_matches[,1] - I = unique(best_matches[,1]) - I = I[I>0] - names(I) = levels[I] - aligs = lapply(levels, initAlignments) - aligs[names(I)] = lapply(I, function(i) subset(x, timeseries.labels = 1, patterns.labels = i, k = best_matches[IL==i,3])@alignments[[1]][[1]] ) - new("twdtwMatches", x@timeseries, x@patterns, alignments=list(aligs)) -} diff --git a/R/twdtwCrossValidate.R b/R/twdtwCrossValidate.R deleted file mode 100644 index bb91e93..0000000 --- a/R/twdtwCrossValidate.R +++ /dev/null @@ -1,117 +0,0 @@ - -setGeneric("twdtwCrossValidate", - def = function(object, ...) standardGeneric("twdtwCrossValidate") -) - -#' @title Cross Validate temporal patterns -#' @name twdtwCrossValidate -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Splits the set of time series into training and validation and -#' computes accuracy metrics. The function uses stratified sampling and a simple -#' random sampling for each stratum. For each data partition this function -#' performs a TWDTW analysis and returns the Overall Accuracy, User's Accuracy, -#' Produce's Accuracy, error matrix (confusion matrix), and a \code{\link[base]{data.frame}} -#' with the classification (Predicted), the reference classes (Reference), -#' and the results of the TWDTW analysis. -#' -#' @param object An object of class \code{\link[dtwSat]{twdtwTimeSeries}}. -#' -#' @param times Number of partitions to create. -#' -#' @param p The percentage of data that goes to training. -#' See \code{\link[caret]{createDataPartition}} for details. -#' -#' @param ... Other arguments to be passed to \code{\link[dtwSat]{createPatterns}} and -#' to \code{\link[dtwSat]{twdtwApply}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' \dontrun{ -#' # Data folder -#' data_folder = system.file("lucc_MT/data", package = "dtwSat") -#' -#' # Read dates -#' dates = scan(paste(data_folder,"timeline", sep = "/"), what = "dates") -#' -#' # Read raster time series -#' evi = brick(paste(data_folder,"evi.tif", sep = "/")) -#' raster_timeseries = twdtwRaster(evi, timeline = dates) -#' -#' # Read field samples -#' field_samples = read.csv(paste(data_folder,"samples.csv", sep = "/")) -#' table(field_samples[["label"]]) -#' -#' # Read field samples projection -#' proj_str = scan(paste(data_folder,"samples_projection", sep = "/"), -#' what = "character") -#' -#' # Get sample time series from raster time series -#' field_samples_ts = getTimeSeries(raster_timeseries, -#' y = field_samples, proj4string = proj_str) -#' field_samples_ts -#' -#' # Run cross validation -#' set.seed(1) -#' # Define TWDTW weight function -#' log_fun = logisticWeight(alpha=-0.1, beta=50) -#' cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, -#' freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) -#' cross_validation -#' -#' summary(cross_validation) -#' -#' plot(cross_validation) -#' -#' twdtwXtable(cross_validation) -#' -#' twdtwXtable(cross_validation, show.overall=FALSE) -#' -#' } -NULL - -#' @aliases twdtwCrossValidate-twdtwTimeSeries -#' @inheritParams twdtwCrossValidate -#' @rdname twdtwCrossValidate -#' @export -setMethod(f = "twdtwCrossValidate", signature = "twdtwTimeSeries", - definition = function(object, times, p, ...) twdtwCrossValidate.twdtwTimeSeries(object, times, p, ...)) - -twdtwCrossValidate.twdtwTimeSeries = function(object, times, p, ...){ - - partitions = createDataPartition(y = labels(object), times, p, list = TRUE) - - res = lapply(partitions, function(I){ - training_ts = subset(object, I) - validation_ts = subset(object, -I) - patt = createPatterns(training_ts, ...) - twdtw_res = twdtwApply(x = validation_ts, y = patt, n=1, ...) - df = do.call("rbind", lapply(twdtw_res[], function(xx) { - i = which.min(xx$distance) - if(length(i)<1) - return(data.frame(Alig.N=NA, from=NA, to=NA, distance=NA, label = "Unclassified")) - xx[i,] - })) - ref = labels(twdtw_res)$timeseries - pred = df$label - data = data.frame(.adjustFactores(ref, pred, levels=NULL, labels=NULL), df[,!names(df)%in%"labels"]) - error.matrix = table(Predicted=data$Predicted, Reference=data$Reference) - UA = diag(error.matrix) / rowSums(error.matrix) - PA = diag(error.matrix) / colSums(error.matrix) - O = sum(diag(error.matrix)) / sum(rowSums(error.matrix)) - list(OverallAccuracy=O, UsersAccuracy=UA, ProducersAccuracy=PA, ErrorMatrix=error.matrix, data=data) - }) - - new("twdtwCrossValidation", partitions=partitions, accuracy=res) - -} - - - - - - diff --git a/R/twdtwDist.R b/R/twdtwDist.R deleted file mode 100644 index 187c399..0000000 --- a/R/twdtwDist.R +++ /dev/null @@ -1,11 +0,0 @@ - -.twdtwDist = function (x, y, ...) { - d = do.call("rbind", lapply(x, function (xx) { - sapply(y, function (yy) { - res = twdtwApply(twdtwTimeSeries(xx), twdtwTimeSeries(yy), n=1, ...) - res[[1]]$distance[1] - }) - })) - as.matrix(d) -} - diff --git a/R/twdtwXtable.R b/R/twdtwXtable.R deleted file mode 100644 index fb1c98f..0000000 --- a/R/twdtwXtable.R +++ /dev/null @@ -1,302 +0,0 @@ -setGeneric("twdtwXtable", - def = function(object, ...) standardGeneric("twdtwXtable") -) - -#' @title LaTeX table from accuracy metrics -#' @name twdtwXtable -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' -#' @description Creates LaTeX table from accuracy metrics -#' -#' @inheritParams twdtwAssessment-class -#' -#' @param table.type Table type, 'accuracy' for User's and Producer's Accuracy, -#' 'errormatrix' for error matrix, and 'area' for area and uncertainty. -#' Default is 'accuracy'. -#' -#' @param time.labels A character or numeric for the time period or NULL to -#' include all classified periods. Default is NULL. -#' -#' @param category.name A character vector defining the class names. If NULL -#' the class names in the object \code{x} are used. Default is NULL. -#' -#' @param category.type A character defining the categories type "numeric" -#' or "letter", if NULL the class names are used. Default is NULL. -#' -#' @param show.prop If TRUE shows the estimated proportion of area. -#' Used with \code{table.type='accuracy'}. Default is TRUE. -#' -#' @param show.overall If TRUE shows the overall accuracy of the cross-validation. -#' Default is TRUE. -#' -#' @param rotate.col Rotate class column names in latex table. Default is FALSE. -#' -#' @param caption The table caption. -#' -#' @param digits Number of digits to show. -#' -#' @param conf.int Specifies the confidence level (0-1). -#' -#' @param show.footnote Show confidence interval in the footnote. -#' -#' @param ... Other arguments to pass to \code{\link[xtable]{print.xtable}}. -#' -#' @seealso \code{\link[dtwSat]{twdtwAssess}} and -#' \code{\link[dtwSat]{twdtwAssessment}}. -#' -#' @references -#' \insertRef{Maus:2019}{dtwSat} -#' -#' \insertRef{Maus:2016}{dtwSat} -#' -#' @examples -#' \dontrun{ -#' -#' # Create raster time series -#' evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -#' ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -#' red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -#' blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -#' nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -#' mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -#' doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -#' timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -#' rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) -#' -#' # Read field samples -#' field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -#' proj_str = scan(system.file("lucc_MT/data/samples_projection", -#' package="dtwSat"), what = "character") -#' -#' # Split samples for training (10%) and validation (90%) using stratified sampling -#' library(caret) -#' set.seed(1) -#' I = unlist(createDataPartition(field_samples$label, p = 0.1)) -#' training_samples = field_samples[I,] -#' validation_samples = field_samples[-I,] -#' -#' # Create temporal patterns -#' training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) -#' temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) -#' -#' # Run TWDTW analysis for raster time series -#' log_fun = weight.fun=logisticWeight(-0.1,50) -#' r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", -#' overwrite=TRUE) -#' -#' # Classify raster based on the TWDTW analysis -#' r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) -#' plot(r_lucc) -#' -#' # Assess classification -#' twdtw_assess = twdtwAssess(object = r_lucc, y = validation_samples, -#' proj4string = proj_str, conf.int=.95) -#' twdtw_assess -#' -#' # Create latex tables -#' twdtwXtable(twdtw_assess, table.type="errormatrix", rotate.col=TRUE, -#' caption="Error matrix", digits=2, comment=FALSE) -#' twdtwXtable(twdtw_assess, table.type="accuracy", category.type="letter", -#' caption="Accuracy metrics.") -#' twdtwXtable(twdtw_assess, table.type="area", category.type="letter", -#' digits = 0, caption="Area and uncertainty") -#' -#' } -NULL - -#' @aliases twdtwXtable-twdtwAssessment -#' @inheritParams twdtwXtable -#' @rdname twdtwXtable -#' @export -setMethod("twdtwXtable", - signature = signature(object = "twdtwAssessment"), - definition = function(object, table.type="accuracy", show.prop=TRUE, category.name=NULL, - category.type=NULL, rotate.col=FALSE, time.labels=NULL, - caption = NULL, digits = 2, show.footnote=TRUE, ...){ - y = object@accuracySummary - if(!is.null(time.labels)) - y = object@accuracyByPeriod[[time.labels]] - if(is.null(y)) - stop("time.labels out of bounds", call. = TRUE) - n = nrow(object@accuracySummary$ProportionMatrix) - 1 - if(is.null(category.name)) - category.name = rownames(object@accuracySummary$ProportionMatrix)[-(n+1)] - if(!is.null(category.type)) - category.name = switch(pmatch(category.type,c("numeric","letter")), - as.character(seq(1:n)), - LETTERS[1:n] - ) - category.colname = category.name - if(rotate.col) - category.colname = paste0("\\rotatebox[origin=l]{90}{",category.colname,"}") - pt = pmatch(table.type,c("accuracy","matrix","area","errormatrix")) - switch(pt, - .xtable.accuracy(x=y, category.name, category.colname, show.prop, caption, digits, show.footnote, ...), - .xtable.matrix(x=y, category.name, category.colname, caption, digits, ...), - .xtable.area(x=y, category.name, caption, digits, show.footnote, ...), - .xtable.matrix(x=y, category.name, category.colname, caption, digits, ...) - ) - } -) - -#' @aliases twdtwXtable-twdtwCrossValidation -#' @inheritParams twdtwXtable -#' @rdname twdtwXtable -#' @export -setMethod("twdtwXtable", - signature = signature(object = "twdtwCrossValidation"), - definition = function(object, conf.int=.95, show.overall=TRUE, - category.name=NULL, category.type=NULL, caption = NULL, digits = 2, show.footnote=TRUE, ...){ - y = summary(object, conf.int = conf.int) - n = nrow(y$Users) - if(is.null(category.name)) - category.name = rownames(y$Users) - if(!is.null(category.type)) - category.name = switch(pmatch(category.type,c("numeric","letter")), - as.character(seq(1:n)), - LETTERS[1:n] - ) - .xtable.crossvalidation(x=y, category.name, show.overall, conf.int, caption, digits, show.footnote, ...) - } -) - -.xtable.crossvalidation = function(x, category.name, show.overall, conf.int, caption, digits, show.footnote, ...){ - - ua = sprintf(paste0("%.",digits,"f"), round(x$Users[["Accuracy"]],digits)) - ua_sd = sprintf(paste0("(%.",digits,"f)"), round(x$Users[["sd"]],digits)) - ua_ci = sprintf(paste0("[%.",digits,"f-%.",digits,"f]"), round(x$Users[["CImin"]],digits), round(x$Users[["CImax"]],digits)) - - pa = sprintf(paste0("%.",digits,"f"), round(x$Producers[["Accuracy"]],digits)) - pa_sd = sprintf(paste0("(%.",digits,"f)"), round(x$Producers[["sd"]],digits)) - pa_ci = sprintf(paste0("[%.",digits,"f-%.",digits,"f]"), round(x$Producers[["CImin"]],digits), round(x$Producers[["CImax"]],digits)) - - tbl = data.frame(ua, ua_sd, ua_ci, pa, pa_sd, pa_ci) - table_columns = " & \\multicolumn{3}{c}{User's} & \\multicolumn{3}{c}{Producer's}" - n = 2 - - if(show.overall){ - oa = sprintf(paste0("%.",digits,"f"), round(x$Overall[["Accuracy"]],digits)) - oa_sd = sprintf(paste0("(%.",digits,"f)"), round(x$Overall[["sd"]],digits)) - oa_ci = sprintf(paste0("[%.",digits,"f-%.",digits,"f]"), round(x$Overall[["CImin"]],digits), round(x$Overall[["CImax"]],digits)) - - tbl$oa = "" - tbl$oa_sd = "" - tbl$oa_ci = "" - - tbl$oa[1] = oa - tbl$oa_sd[1] = oa_sd - tbl$oa_ci[1] = oa_ci - - table_columns = paste0(table_columns, " & \\multicolumn{3}{c}{Overall}") - n = 3 - } - - comment = list() - comment$pos = list() - comment$pos[[1]] = c(0) - comment$pos[[2]] = c(nrow(tbl)) - comment$command = c(paste0(table_columns, "\\\\\n", - "\\multicolumn{1}{c}{Class}", paste(rep(" & \\multicolumn{1}{c}{$\\mu$} & \\multicolumn{1}{c}{$\\sigma$} & \\multicolumn{1}{c}{ci*}", n),collapse = ""),"\\\\\n"), - paste("\\hline \n", ifelse(show.footnote, paste0("\\multicolumn{",ncol(tbl)+1,"}{l}{* ",conf.int*100,"\\% confidence interval.}\n"), ""), sep = "")) - - rownames(tbl) = category.name - - tbl = xtable(tbl, caption) - - print.xtable(tbl, add.to.row = comment, include.rownames=TRUE, include.colnames = FALSE, - hline.after = c(-1, 0), sanitize.text.function = function(x) x, ...) - -} - - -.xtable.accuracy = function(x, category.name, category.colname, show.prop, caption, digits, show.footnote, ...){ - - ua = sprintf(paste0("%.",digits,"f$\\pm$%.",digits,"f"), round(x$UsersAccuracy[,"Accuracy"],digits), round(x$UsersAccuracy[,"ci"], digits)) - pa = sprintf(paste0("%.",digits,"f$\\pm$%.",digits,"f"), round(x$ProducersAccuracy[,"Accuracy"],digits), round(x$ProducersAccuracy[,"ci"], digits)) - oa = c(sprintf(paste0("%.",digits,"f$\\pm$%.",digits,"f"), round(x$OverallAccuracy["Accuracy"],digits), round(x$OverallAccuracy["ci"], digits)), rep("", length(pa)-1)) - - prop = data.frame(ua, pa, oa) - names(prop) = c("User's*", "Producers's*", "Overall*") - - if(show.prop){ - prop = data.frame(`User's*` = "", `Producers's*` = "", `Overall*` = "") - prop = as.data.frame.matrix(x$ProportionMatrix) - prop = data.frame(apply(prop[,!names(prop)%in%c("Area","w")], 1, FUN = sprintf, fmt=paste0(paste0("%.",digits,"f"))), stringsAsFactors = FALSE) - rownames(prop) = names(prop) - prop$`User's*` = "" - prop$`Producers's*` = "" - prop$`Overall*` = "" - names(prop)[1:length(category.name)] = category.colname - prop$`User's*`[1:length(ua)] = ua - prop$`Producers's*`[1:length(pa)] = pa - prop$`Overall*`[1:length(oa)] = oa - } - - rownames(prop)[1:length(category.name)] = category.name - tbl = xtable(prop, caption) - - comment = list() - comment$pos = list() - comment$pos[[1]] = c(0) - comment$pos[[2]] = c(nrow(tbl)) - if(show.prop){ - comment$command = c(paste0("&\\multicolumn{",length(category.name),"}{c}{Reference class}&&&&\\\\\n", - paste(c("\\multicolumn{1}{c}{Map class}",names(tbl)), collapse = " & "),"\\\\\n"), - paste("\\hline \n", ifelse(show.footnote, paste0("\\multicolumn{",ncol(tbl),"}{l}{* ",x$conf.int*100,"\\% confidence interval.}\n"), ""), sep = "")) - } else { - comment$command = c(paste0(paste(c("\\multicolumn{1}{c}{Class}",names(tbl)), collapse = " & "),"\\\\\n"), - paste("\\hline \n", ifelse(show.footnote, paste0("\\multicolumn{",ncol(tbl),"}{l}{* ",x$conf.int*100,"\\% confidence interval.}\n"), ""), sep = "")) - } - - - print.xtable(tbl, add.to.row = comment, include.rownames=TRUE, include.colnames = FALSE, - hline.after = c(-1, 0), sanitize.text.function = function(x) x, ...) -} - -.xtable.matrix = function(x, category.name, category.colname, caption, digits, ...){ - m = as.data.frame.matrix(x$ErrorMatrix) - # names(m)[ncol(m)] = "Estimation weight" - names(m)[1:length(category.name)] = category.colname - rownames(m)[1:length(category.name)] = category.name - - tbl = xtable(m, caption, digits = c(rep(0, ncol(m)-1), digits, 3)) - - comment = list() - comment$pos = list() - comment$pos[[1]] = c(0) - comment$command = c(paste0("&\\multicolumn{",length(category.name),"}{c}{Reference class}&&\\\\\n", - paste(c("\\multicolumn{1}{c}{Map class}",names(tbl)), collapse = " & "),"\\\\\n")) - - print.xtable(tbl, add.to.row = comment, include.rownames=TRUE, include.colnames = FALSE, - hline.after = c(-1, 0, nrow(tbl)), sanitize.text.function = function(x) x, ...) - -} - -.xtable.area = function(x, category.name, caption, digits, show.footnote, ...){ - - a = x$AreaUncertainty - a = data.frame(a) - - mp = sprintf(paste0("%.",digits,"f"), round(unlist(a$Mapped),digits)) - ad = sprintf(paste0("%.",digits,"f"), round(unlist(a$Adjusted),digits)) - ci = sprintf(paste0("$\\pm$%.",digits,"f"), round(unlist(a$ci),digits)) - - tbl = data.frame(mp, ad, ci) - rownames(tbl) = category.name - names(tbl) = c("Mapped area", "Adjusted area", "Margin of error*") - tbl = xtable(tbl, caption) - - comment = list() - comment$pos = list() - comment$pos[[1]] = c(0) - comment$pos[[2]] = c(nrow(tbl)) - comment$command = c(paste0(paste(c("\\multicolumn{1}{c}{Class}",names(tbl)), collapse = " & "), "\\\\\n"), - paste("\\hline \n", ifelse(show.footnote, paste0("\\multicolumn{",ncol(tbl),"}{l}{* ",x$conf.int*100,"\\% confidence interval.}\n"), ""), sep = "")) - - print.xtable(tbl, add.to.row = comment, include.rownames=TRUE, include.colnames = FALSE, - hline.after = c(-1, 0), sanitize.text.function = function(x) x, ...) - -} - - - diff --git a/R/twdtw_reduce_time.R b/R/twdtw_reduce_time.R deleted file mode 100644 index db1fbe7..0000000 --- a/R/twdtw_reduce_time.R +++ /dev/null @@ -1,263 +0,0 @@ -#' @include methods.R -#' @title Faster version of TWDTW apply -#' @name twdtwReduceTime -#' @author Victor Maus, \email{vwmaus1@@gmail.com} -#' @rdname twdtwReduceTime -#' -#' @description This function is a faster implementation of -#' \link[dtwSat]{twdtwApply} that is in average 4x faster. The time weight function -#' is coded in Fortran. It does not keep any intermediate data. -#' It performs a multidimensional TWDTW analysis -#' \insertCite{Maus:2019}{dtwSat} and retrieves only the best matches between -#' the unclassified time series and the patterns for each defined time interval. -#' -#' @inheritParams twdtwApply -#' @inheritParams twdtwClassify -#' -#' @param x a data.frame with the target time series. Usually, it is an -#' unclassified time series. It must contain two or more columns, one column -#' called \code{date} with dates in the format "YYYY-MM-DD". The other columns -#' can have any names (e.g., red, blue, nir, evi, ndvi) as long as they match -#' the column names in the temporal patterns \code{y}. -#' -#' @param y a list of data.frame objects similar to \code{x}. -#' The temporal patterns used to classify the time series in \code{x}. -#' -#' @param time.window logical. TRUE will constrain the TWDTW computation to the -#' value of the parameter \code{beta} defined in the logistic weight function. -#' Default is FALSE. -#' -#' @param fill An integer to fill the classification gaps. -#' -#' @examples -#' \dontrun{ -#' -#' library(dtwSat) -#' from = "2009-09-01" -#' to = "2017-09-01" -#' by = "12 month" -#' -#' # S4 objects for original implementation -#' tw_patt = readRDS(system.file("lucc_MT/patterns/patt.rds", package = "dtwSat")) -#' tw_ts = twdtwTimeSeries(MOD13Q1.ts) -#' -#' # Table from csv for faster version -#' mn_patt <- lapply(dir(system.file("lucc_MT/patterns", package = "dtwSat"), -#' pattern = ".csv$", full.names = TRUE), read.csv, stringsAsFactors = FALSE) -#' mn_ts <- read.csv(system.file("reduce_time/ts_MODIS13Q1.csv", package = "dtwSat"), -#' stringsAsFactors = FALSE) -#' -#' # Benchtmark -#' rbenchmark::benchmark( -#' legacy_twdtw = twdtwClassify(twdtwApply(x = tw_ts, y = tw_patt, weight.fun = log_fun), -#' from = from, to = to, by = by)[[1]], -#' fast_twdtw = twdtwReduceTime(x = mn_ts, y = mn_patt, from = from, to = to, by = by) -#' ) -#' } -#' -#' @export -twdtwReduceTime = function(x, - y, - alpha = -0.1, - beta = 50, - time.window = FALSE, - dist.method = "Euclidean", - step.matrix = symmetric1, - from = NULL, - to = NULL, - by = NULL, - breaks = NULL, - overlap = .5, - fill = length(y) + 1, - keep = FALSE, ...){ - - # Split time series from dates - px <- x[,names(x)!="date",drop=FALSE] - tx <- as.Date(x$date) - - # Compute TWDTW alignments for all patterns - twdtw_data <- lapply(seq_along(y), function(l){ - - # Split pattern time series from dates - py <- y[[l]][,names(y[[l]])!="date",drop=FALSE] - ty <- as.Date(y[[l]]$date) - - # Match bands and remove bands that are not in both time series - names(py) <- tolower(names(py)) - names(px) <- tolower(names(px)) - px <- px[,names(py),drop=FALSE] - py <- py[,names(px),drop=FALSE] - - # Get day of the year for pattern and time series - doyy <- as.numeric(format(ty, "%j")) - doyx <- as.numeric(format(tx, "%j")) - - # Compute accumulated DTW cost matrix - xm = na.omit(cbind(doyx, as.matrix(px))) - ym = na.omit(cbind(doyy, as.matrix(py))) - internals = .fast_twdtw(xm, ym, alpha, beta, step.matrix, time.window) - - # Find all low cost candidates - b <- internals$JB[internals$JB!=0] - a <- internals$VM[-1,][internals$N,b] - d <- internals$CM[-1,][internals$N,b] - # View(internals$VM[-1,]) - # CM <- internals$CM[-1,]; CM[CM>10000] <- NA; CM |> t() |> image() - candidates <- matrix(c(a, d, b, b, rep(l, length(b))), ncol = 5, byrow = F) - - # Order matches by minimum TWDTW distance - I <- order(candidates[,3]) - if(length(I)<1) return(NULL) - - # Build alignments table table - candidates[,4] <- I - - if(!keep){ - internals = NULL - } else { - internals$tsDates <- tx - internals$patternDates <- ty - } - - return(list(candidates = candidates, internals = internals)) - - }) - - aligs <- do.call("rbind", lapply(twdtw_data, function(x) x$candidates)) - il <- order(aligs[,1], aligs[,2]) - - # Create classification intervals - # if(is.null(breaks)){ - # breaks <- seq(as.Date(from), as.Date(to), by = by) - # } - if(is.null(breaks)) - if( !is.null(from) & !is.null(to) ){ - breaks = seq(as.Date(from), as.Date(to), by = by) - } else { - patt_range = lapply(y, function(yy) range(yy$date)) - patt_diff = trunc(sapply(patt_range, diff)/30)+1 - min_range = which.min(patt_diff) - by = patt_diff[[min_range]] - from = patt_range[[min_range]][1] - to = from - month(to) = month(to) + by - year(from) = year(range(x$date)[1]) - year(to) = year(range(x$date)[2]) - if(to # -# Institute for Geoinformatics (IFGI) # -# University of Muenster (WWU), Germany # -# # -# Earth System Science Center (CCST) # -# National Institute for Space Research (INPE), Brazil # -# # -# # -# R Package dtwSat - 2015-09-01 # -# # -############################################################### - -.onAttach = function(lib, pkg){ - packageStartupMessage( - sprintf("Loaded dtwSat v%s. See ?dtwSat for help; citation(\"dtwSat\") for use in publications.\n", - utils::packageDescription("dtwSat")$Version) ) - - ## Register TWDTW as a distance function into package proxy - is_there <- c("TWDTW","twdtw") %in% proxy::pr_DB$get_entry_names() - sapply(c("TWDTW","twdtw")[is_there], proxy::pr_DB$delete_entry) - - proxy::pr_DB$set_entry(FUN = .twdtwDist, - names = c("TWDTW","twdtw"), - loop = FALSE, - type = "metric", - description = "Time-Weighted Dynamic Time Warping", - reference = "Maus V, Camara G, Cartaxo R, Sanchez A, Ramos FM, de Queiroz GR (2016). A Time-Weighted Dynamic Time Warping method for land use and land cover mapping. IEEE Journal of Selected Topics in Applied Earth Observations and Remote Sensing, 9 (8), pp. 3729--3739. ." ) -} - -#' @import zoo -#' @import raster +#' @import twdtw +#' @import sf +#' @import stars #' @import ggplot2 -#' @import methods -#' @import rgdal -#' @importFrom foreach foreach %dopar% -#' @importFrom proxy dist pr_DB -#' @importFrom reshape2 melt +#' @importFrom stats as.formula predict setNames +#' @importFrom mgcv gam s predict.gam #' @importFrom scales pretty_breaks date_format percent -#' @importFrom grDevices terrain.colors gray.colors -#' @importFrom plyr alply -#' @importFrom sp Polygon Polygons SpatialPoints SpatialPolygons SpatialPointsDataFrame over CRS spTransform coordinates bbox -#' @importFrom mgcv gam predict.gam -#' @importFrom RColorBrewer brewer.pal -#' @importFrom stats xtabs ave window na.omit sd qnorm -#' @importFrom lubridate month month<- day day<- year year<- -#' @importFrom caret createDataPartition -#' @importFrom xtable xtable print.xtable -#' @importFrom utils packageDescription flush.console globalVariables -#' @importFrom Rdpack reprompt -#' @importFrom data.table rbindlist -#' @useDynLib dtwSat, .registration = TRUE +#' @importFrom reshape2 melt +#' @importFrom rlang .data #' NULL - -if(getRversion() >= "2.15.1") utils::globalVariables("tsidopar") - -### Import and export functions from other packages - -#' @importFrom dtw symmetric1 -#' @export -dtw::symmetric1 - -#' @importFrom dtw symmetric2 -#' @export -dtw::symmetric2 - -#' @importFrom dtw asymmetric -#' @export -dtw::asymmetric - -#' @importFrom dtw rabinerJuangStepPattern -#' @export -dtw::rabinerJuangStepPattern diff --git a/README.Rmd b/README.Rmd deleted file mode 100644 index a15fd28..0000000 --- a/README.Rmd +++ /dev/null @@ -1,46 +0,0 @@ ---- -title: "dtwSat" -author: "Victor Maus" -date: "`r Sys.Date()`" -output: - md_document: - variant: markdown_github -bibliography: ./inst/REFERENCES.bib ---- - -```{r, echo=FALSE} -knitr::opts_chunk$set( - warning = FALSE, - message = FALSE, - error = FALSE, - cache = FALSE, - results = "hide" -) -``` - -dtwSat -===== - -[![Build Status](https://travis-ci.org/vwmaus/dtwSat.png?branch=master)](https://travis-ci.org/vwmaus/dtwSat) [![License](http://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-2.0.html) [![CRAN](http://www.r-pkg.org/badges/version/dtwSat)](http://cran.r-project.org/package=dtwSat) [![month](http://cranlogs.r-pkg.org/badges/dtwSat)](http://www.r-pkg.org/pkg/dtwSat) [![total](http://cranlogs.r-pkg.org/badges/grand-total/dtwSat)](http://www.r-pkg.org/pkg/dtwSat) - -### Time-Weighted Dynamic Time Warping for satellite image time series analysis - -The \proglang{R} package *dtwSat* provides an implementation of the Time-Weighted Dynamic Time Warping (TWDTW) method for land cover mapping using multi-band satellite image time series [@Maus:2016; @Maus:2019]. *dtwSat* provides full cycle of land cover classification using image time series, ranging from selecting temporal patterns to visualizing, and assessing the results. - -## Installing - -Install either from CRAN - -```{r, eval = FALSE} -install.packages("dtwSat") -``` - -or install the development versions from GitHub - -```{r, eval = FALSE} -library(devtools) -devtools::install_github("vwmaus/dtwSat") -``` - -## References - diff --git a/README.md b/README.md index 9ad5ec5..4db524f 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,14 @@ # dtwSat -[![Build -Status](https://travis-ci.org/vwmaus/dtwSat.png?branch=master)](https://travis-ci.org/vwmaus/dtwSat) -[![License](http://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-2.0.html) -[![CRAN](http://www.r-pkg.org/badges/version/dtwSat)](http://cran.r-project.org/package=dtwSat) -[![month](http://cranlogs.r-pkg.org/badges/dtwSat)](http://www.r-pkg.org/pkg/dtwSat) + +[![License](https://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](https://www.gnu.org/licenses/gpl-3.0.html) +[![R-CMD-check](https://github.com/vwmaus/dtwSat/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/vwmaus/dtwSat/actions/workflows/R-CMD-check.yaml) +[![Coverage Status](https://img.shields.io/codecov/c/github/vwmaus/dtwSat/main.svg)](https://app.codecov.io/gh/vwmaus/dtwSat) +[![CRAN](https://www.r-pkg.org/badges/version/dtwSat)](https://cran.r-project.org/package=dtwSat) +[![Downloads](https://cranlogs.r-pkg.org/badges/dtwSat?color=brightgreen)](https://www.r-pkg.org/pkg/dtwSat) [![total](http://cranlogs.r-pkg.org/badges/grand-total/dtwSat)](http://www.r-pkg.org/pkg/dtwSat) + + ### Time-Weighted Dynamic Time Warping for satellite image time series analysis diff --git a/_config.yml b/_config.yml deleted file mode 100644 index 2f7efbe..0000000 --- a/_config.yml +++ /dev/null @@ -1 +0,0 @@ -theme: jekyll-theme-minimal \ No newline at end of file diff --git a/data/.gitignore b/data/.gitignore deleted file mode 100644 index 4b02b56..0000000 --- a/data/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -mod13q1 -mod13q1.db diff --git a/data/MOD13Q1.MT.yearly.patterns.RData b/data/MOD13Q1.MT.yearly.patterns.RData deleted file mode 100644 index 372833d..0000000 Binary files a/data/MOD13Q1.MT.yearly.patterns.RData and /dev/null differ diff --git a/data/MOD13Q1.patterns.list.RData b/data/MOD13Q1.patterns.list.RData deleted file mode 100644 index d5fcb4a..0000000 Binary files a/data/MOD13Q1.patterns.list.RData and /dev/null differ diff --git a/data/MOD13Q1.ts.RData b/data/MOD13Q1.ts.RData deleted file mode 100644 index 55d0f35..0000000 Binary files a/data/MOD13Q1.ts.RData and /dev/null differ diff --git a/data/MOD13Q1.ts.labels.RData b/data/MOD13Q1.ts.labels.RData deleted file mode 100644 index 81770c1..0000000 Binary files a/data/MOD13Q1.ts.labels.RData and /dev/null differ diff --git a/data/MOD13Q1.ts.list.RData b/data/MOD13Q1.ts.list.RData deleted file mode 100644 index 71c39c5..0000000 Binary files a/data/MOD13Q1.ts.list.RData and /dev/null differ diff --git a/examples/reshape_modis_files.R b/examples/reshape_modis_files.R new file mode 100644 index 0000000..b503fc9 --- /dev/null +++ b/examples/reshape_modis_files.R @@ -0,0 +1,31 @@ +library(stars) +library(stringr) +library(dplyr) + +sf_use_s2(FALSE) + +# Data extracted from MOD13Q1 tile h12v10 + +sd <- sf::gdal_subdatasets(hdf_file) + + +samples <- st_read("inst/mato_grosso_brazil/samples.gpkg") +table(samples$label) + +modis_dates <- scan("inst/lucc_MT/data/timeline", what = "character") + +evi <- raster::brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) +ndvi <- raster::brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) +red <- raster::brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) +blue <- raster::brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) +nir <- raster::brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) +mir <- raster::brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) +doy <- raster::brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) + +# filter modis dates between 2011-09-01 and 2012-08-31 +for (i in which(modis_dates >= "2011-09-01" & modis_dates <= "2012-08-31")){ + r <- stack(subset(evi, i), subset(ndvi, i), subset(red, i), subset(blue, i), subset(nir, i), subset(mir, i), subset(doy, i)) + names(r) <- c("EVI", "NDVI", "RED", "BLUE", "NIR", "MIR", "DOY") + writeRaster(r, filename = paste0("inst/mato_grosso_brazil/MOD13Q1_", str_remove_all(modis_dates[i], "-"), "_subset_from_h12v10.tif"), + overwrite = TRUE, wopt= list(gdal=c("COMPRESS=DEFLATE", "TFW=YES"))) +} diff --git a/figure/plot-MOD13Q1.ts-ts-1.png b/figure/plot-MOD13Q1.ts-ts-1.png deleted file mode 100644 index 9a49f82..0000000 Binary files a/figure/plot-MOD13Q1.ts-ts-1.png and /dev/null differ diff --git a/figure/plot-alignment-1.png b/figure/plot-alignment-1.png deleted file mode 100644 index 7795dc1..0000000 Binary files a/figure/plot-alignment-1.png and /dev/null differ diff --git a/figure/plot-area-1.png b/figure/plot-area-1.png deleted file mode 100644 index 393913e..0000000 Binary files a/figure/plot-area-1.png and /dev/null differ diff --git a/figure/plot-area-uncertainty-1.png b/figure/plot-area-uncertainty-1.png deleted file mode 100644 index a603199..0000000 Binary files a/figure/plot-area-uncertainty-1.png and /dev/null differ diff --git a/figure/plot-changes-1.png b/figure/plot-changes-1.png deleted file mode 100644 index 73c2c02..0000000 Binary files a/figure/plot-changes-1.png and /dev/null differ diff --git a/figure/plot-group-1.png b/figure/plot-group-1.png deleted file mode 100644 index 6ac7fb9..0000000 Binary files a/figure/plot-group-1.png and /dev/null differ diff --git a/figure/plot-maps-1.png b/figure/plot-maps-1.png deleted file mode 100644 index 29cefd3..0000000 Binary files a/figure/plot-maps-1.png and /dev/null differ diff --git a/figure/plot-match-1.png b/figure/plot-match-1.png deleted file mode 100644 index 5d49f58..0000000 Binary files a/figure/plot-match-1.png and /dev/null differ diff --git a/figure/plot-path-1.png b/figure/plot-path-1.png deleted file mode 100644 index e80f495..0000000 Binary files a/figure/plot-path-1.png and /dev/null differ diff --git a/figure/plot-patterns-1.png b/figure/plot-patterns-1.png deleted file mode 100644 index a5b704f..0000000 Binary files a/figure/plot-patterns-1.png and /dev/null differ diff --git a/figure/plot-patterns-map-1.png b/figure/plot-patterns-map-1.png deleted file mode 100644 index d42098c..0000000 Binary files a/figure/plot-patterns-map-1.png and /dev/null differ diff --git a/figure/plot-users-prodcucers-1.png b/figure/plot-users-prodcucers-1.png deleted file mode 100644 index 18f207c..0000000 Binary files a/figure/plot-users-prodcucers-1.png and /dev/null differ diff --git a/inst/.gitignore b/inst/.gitignore new file mode 100644 index 0000000..b81c795 --- /dev/null +++ b/inst/.gitignore @@ -0,0 +1 @@ +*.xml \ No newline at end of file diff --git a/inst/mato_grosso_brazil/MOD13Q1_20110914_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20110914_subset_from_h12v10.tif new file mode 100644 index 0000000..ae7dac4 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20110914_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20110930_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20110930_subset_from_h12v10.tif new file mode 100644 index 0000000..2a2e244 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20110930_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20111016_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20111016_subset_from_h12v10.tif new file mode 100644 index 0000000..b79f2d4 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20111016_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20111101_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20111101_subset_from_h12v10.tif new file mode 100644 index 0000000..4a696d8 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20111101_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20111117_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20111117_subset_from_h12v10.tif new file mode 100644 index 0000000..b66c8c0 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20111117_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20111203_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20111203_subset_from_h12v10.tif new file mode 100644 index 0000000..66c3b6b Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20111203_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20111219_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20111219_subset_from_h12v10.tif new file mode 100644 index 0000000..93d85ae Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20111219_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120101_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120101_subset_from_h12v10.tif new file mode 100644 index 0000000..d64155b Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120101_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120117_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120117_subset_from_h12v10.tif new file mode 100644 index 0000000..55418c1 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120117_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120202_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120202_subset_from_h12v10.tif new file mode 100644 index 0000000..d8e447e Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120202_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120218_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120218_subset_from_h12v10.tif new file mode 100644 index 0000000..a54ed61 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120218_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120305_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120305_subset_from_h12v10.tif new file mode 100644 index 0000000..ea72004 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120305_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120321_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120321_subset_from_h12v10.tif new file mode 100644 index 0000000..79b6b42 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120321_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120406_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120406_subset_from_h12v10.tif new file mode 100644 index 0000000..0e9af7c Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120406_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120422_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120422_subset_from_h12v10.tif new file mode 100644 index 0000000..a7dae1d Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120422_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120508_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120508_subset_from_h12v10.tif new file mode 100644 index 0000000..3fef7f8 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120508_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120524_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120524_subset_from_h12v10.tif new file mode 100644 index 0000000..9a5b03d Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120524_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120609_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120609_subset_from_h12v10.tif new file mode 100644 index 0000000..19bca35 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120609_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120625_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120625_subset_from_h12v10.tif new file mode 100644 index 0000000..5332230 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120625_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120711_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120711_subset_from_h12v10.tif new file mode 100644 index 0000000..8ee57b1 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120711_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120727_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120727_subset_from_h12v10.tif new file mode 100644 index 0000000..531641e Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120727_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120812_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120812_subset_from_h12v10.tif new file mode 100644 index 0000000..b6061b0 Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120812_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/MOD13Q1_20120828_subset_from_h12v10.tif b/inst/mato_grosso_brazil/MOD13Q1_20120828_subset_from_h12v10.tif new file mode 100644 index 0000000..6de99df Binary files /dev/null and b/inst/mato_grosso_brazil/MOD13Q1_20120828_subset_from_h12v10.tif differ diff --git a/inst/mato_grosso_brazil/samples.gpkg b/inst/mato_grosso_brazil/samples.gpkg new file mode 100644 index 0000000..2fa2e37 Binary files /dev/null and b/inst/mato_grosso_brazil/samples.gpkg differ diff --git a/man/MOD13Q1.MT.yearly.patterns.Rd b/man/MOD13Q1.MT.yearly.patterns.Rd deleted file mode 100644 index ca1ab92..0000000 --- a/man/MOD13Q1.MT.yearly.patterns.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{MOD13Q1.MT.yearly.patterns} -\alias{MOD13Q1.MT.yearly.patterns} -\title{Data: Pattern time series} -\format{ -A \link[dtwSat]{twdtwTimeSeries} object. -} -\usage{ -MOD13Q1.MT.yearly.patterns -} -\description{ -This dataset has a list of patterns with the phenological cycle of: Water, -Cotton-Fallow, Forest, Low vegetation, Pasture, Soybean-Cotton, Soybean-Maize, Soybean-Millet, -Soybean-Sunflower, and Wetland. These time series are based on the MODIS product -MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. -The patterns were built from ground truth samples of each -crop using Generalized Additive Models (GAM), see \link[dtwSat]{createPatterns}. -} -\references{ -\insertAllCited{} - - \insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} -\keyword{datasets} diff --git a/man/MOD13Q1.patterns.list.Rd b/man/MOD13Q1.patterns.list.Rd deleted file mode 100644 index 1a84770..0000000 --- a/man/MOD13Q1.patterns.list.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{MOD13Q1.patterns.list} -\alias{MOD13Q1.patterns.list} -\title{Data: patterns time series} -\format{ -A named \code{list} of three \link[zoo]{zoo} objects, ''Soybean'', ''Cotton'', -and ''Maize'', whose indices are \code{\link[base]{Dates}} in the format ''yyyy-mm-dd''. -Each node has 6 attributes: ''ndvi'', ''evi'', ''red'', ''nir'', ''blue'', -and ''mir''. -} -\usage{ -MOD13Q1.patterns.list -} -\description{ -This dataset has a list of patterns with the phenological cycle of: Soybean, -Cotton, and Maize. These time series are based on the MODIS product -MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. The patterns were built -from ground truth samples of each -crop using Generalized Additive Models (GAM), see \link[dtwSat]{createPatterns}. -} -\references{ -\insertAllCited{} - - \insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\link[dtwSat]{MOD13Q1.ts}, -\link[dtwSat]{MOD13Q1.ts.list}, and -\link[dtwSat]{createPatterns}. - -For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} -\keyword{datasets} diff --git a/man/MOD13Q1.ts.Rd b/man/MOD13Q1.ts.Rd deleted file mode 100644 index e1969fc..0000000 --- a/man/MOD13Q1.ts.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{MOD13Q1.ts} -\alias{MOD13Q1.ts} -\title{Data: An example of satellite time series} -\format{ -A \link[zoo]{zoo} object, whose indices are \code{\link[base]{Dates}} -in the format ''yyyy-mm-dd''. Each node has 6 attributes: ''ndvi'', -''evi'', ''red'', ''nir'', ''blue'', and ''mir''. -} -\usage{ -MOD13Q1.ts -} -\description{ -This dataset has a time series based on the -MODIS product MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. -It is an irregularly sampled time series -using the real date of each pixel from ''2009-08-05'' to ''2013-07-31''. -} -\references{ -\insertAllCited{} - - \insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\link[dtwSat]{MOD13Q1.ts.list}, -\link[dtwSat]{MOD13Q1.patterns.list}. - -For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} -\keyword{datasets} diff --git a/man/MOD13Q1.ts.labels.Rd b/man/MOD13Q1.ts.labels.Rd deleted file mode 100644 index ab2fcec..0000000 --- a/man/MOD13Q1.ts.labels.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{MOD13Q1.ts.labels} -\alias{MOD13Q1.ts.labels} -\title{Data: Labels of the satellite time series in MOD13Q1.ts} -\format{ -An object of class \link[base]{data.frame}, whose attributes are: -the label of the crop class ''label'', the start of the crop period ''from'', -and the end of the crop period ''to''. The dates are in the format ''yyyy-mm-dd''. -} -\usage{ -MOD13Q1.ts.labels -} -\description{ -These labels are based on field work. -} -\seealso{ -\link[dtwSat]{MOD13Q1.ts}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} -\keyword{datasets} diff --git a/man/MOD13Q1.ts.list.Rd b/man/MOD13Q1.ts.list.Rd deleted file mode 100644 index b78f8ef..0000000 --- a/man/MOD13Q1.ts.list.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data.R -\docType{data} -\name{MOD13Q1.ts.list} -\alias{MOD13Q1.ts.list} -\title{Data: A list of satellite time series} -\format{ -A \link[zoo]{zoo} object, whose indices are \code{\link[base]{Dates}} -in the format ''yyyy-mm-dd''. Each node has 6 attributes: ''ndvi'', -''evi'', ''red'', ''nir'', ''blue'', and ''mir''. -} -\usage{ -MOD13Q1.ts.list -} -\description{ -This dataset has a list of time series based on the -MODIS product MOD13Q1 250 m 16 days \insertCite{Didan:2015}{dtwSat}. -It is an irregularly sampled time series -using the real date of each pixel from ''2009-08-05'' to ''2013-07-31''. -} -\references{ -\insertAllCited{} - - \insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\link[dtwSat]{MOD13Q1.ts}, and -\link[dtwSat]{MOD13Q1.patterns.list}. - -For details about MOD13Q1 see \insertCite{Didan:2015}{dtwSat}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} -\keyword{datasets} diff --git a/man/createPatterns.Rd b/man/createPatterns.Rd deleted file mode 100644 index 0bf8fbf..0000000 --- a/man/createPatterns.Rd +++ /dev/null @@ -1,104 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/createPatterns.R -\name{createPatterns} -\alias{createPatterns} -\alias{createPatterns,twdtwTimeSeries-method} -\alias{createPatterns-twdtwMatches} -\title{Create patterns} -\usage{ -createPatterns( - x, - from = NULL, - to = NULL, - freq = 1, - attr = NULL, - split = TRUE, - formula, - ... -) - -\S4method{createPatterns}{twdtwTimeSeries}( - x, - from = NULL, - to = NULL, - freq = 1, - attr = NULL, - split = TRUE, - formula, - ... -) -} -\arguments{ -\item{x}{an object of class \code{\link[dtwSat]{twdtwTimeSeries}}.} - -\item{from}{A character or \code{\link[base]{Dates}} object in the format -"yyyy-mm-dd". If not provided it is equal to the smallest date of the -first element in x. See details.} - -\item{to}{A \code{\link[base]{character}} or \code{\link[base]{Dates}} -object in the format "yyyy-mm-dd". If not provided it is equal to the -greatest date of the first element in x. See details.} - -\item{freq}{An integer. The sampling frequency of the output patterns.} - -\item{attr}{A vector character or numeric. The attributes in \code{x} to be used. -If not declared the function uses all attributes.} - -\item{split}{A logical. If TRUE the samples are split by label. If FALSE -all samples are set to the same label.} - -\item{formula}{A formula. Argument to pass to \code{\link[mgcv]{gam}}.} - -\item{...}{other arguments to pass to the function \code{\link[mgcv]{gam}} in the -package \pkg{mgcv}.} -} -\value{ -an object of class \code{\link[dtwSat]{twdtwTimeSeries}} -} -\description{ -Create temporal patterns from objects of class twdtwTimeSeries. -} -\details{ -The hidden assumption is that the temporal pattern is a cycle the repeats itself -within a given time interval. Therefore, all time series samples in \code{x} are aligned -with each other, keeping their respective sequence of days of the year. The function fits a -Generalized Additive Model (GAM) to the aligned set of samples. -} -\examples{ -# Creating patterns from objects of class twdtwTimeSeries -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, timeline=timeline) - -# Read field samples -\dontrun{ -field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -prj_string = scan(system.file("lucc_MT/data/samples_projection", package="dtwSat"), - what = "character") - -# Extract time series -ts = getTimeSeries(rts, y = field_samples, proj4string = prj_string) - -# Create temporal patterns -patt = createPatterns(x=ts, from="2005-09-01", to="2006-09-01", freq=8, formula = y~s(x)) - -# Plot patterns -autoplot(patt[[1]], facets = NULL) + xlab("Time") + ylab("Value") - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwTimeSeries-class}}, -\code{\link[dtwSat]{getTimeSeries}}, and -\code{\link[dtwSat]{twdtwApply}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/create_patterns.Rd b/man/create_patterns.Rd new file mode 100644 index 0000000..0ff9bd5 --- /dev/null +++ b/man/create_patterns.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_patterns.R +\name{create_patterns} +\alias{create_patterns} +\title{Create a Pattern Using GAM} +\usage{ +create_patterns( + x, + y, + formula = band ~ s(time), + start_column = "start_date", + end_column = "end_date", + label_colum = "label", + sampling_freq = NULL, + ... +) +} +\arguments{ +\item{x}{A three dimensions stars object (x, y, time) with the satellite image time series.} + +\item{y}{An sf object with the coordinates of the training points.} + +\item{formula}{A formula for the GAM. Default is \code{band ~ \link[mgcv]{s}(time)}.} + +\item{start_column}{Name of the column in y that indicates the start date. Default is 'start_date'.} + +\item{end_column}{Name of the column in y that indicates the end date. Default is 'end_date'.} + +\item{label_colum}{Name of the column in y that contains land use labels. Default is 'label'.} + +\item{sampling_freq}{The time frequency for sampling including unit, e.g '16 day'. If NULL, the function will infer it.} + +\item{...}{Additional arguments passed to the GAM function.} +} +\value{ +A list containing the predicted values for each label. +} +\description{ +This function creates a pattern based on Generalized Additive Models (GAM). +It uses the specified formula to fit the model and predict values. +} diff --git a/man/dtwSat.Rd b/man/dtwSat.Rd deleted file mode 100644 index ebbd846..0000000 --- a/man/dtwSat.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dwtSat.R -\name{dtwSat} -\alias{dtwSat} -\title{Time-Weighted Dynamic Time Warping for Satellite Image Time Series} -\description{ -Provides an implementation of the Time-Weighted Dynamic Time Warping -(TWDTW) method for land use and land cover mapping using satellite image time series -\insertCite{Maus:2016,Maus:2019}{dtwSat}. -TWDTW is based on the Dynamic Time Warping technique and has achieved high accuracy -for land use and land cover classification using satellite data. The method is based -on comparing unclassified satellite image time series with a set of known temporal -patterns (e.g. phenological cycles associated with the vegetation). Using 'dtwSat' -the user can build temporal patterns for land cover types, apply the TWDTW analysis -for satellite datasets, visualize the results of the time series analysis, produce -land cover maps, and create temporal plots for land cover change analysis. -} -\references{ -\insertAllCited{} -} -\seealso{ -\code{\link[dtwSat]{twdtwApply}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/extract_time_series.Rd b/man/extract_time_series.Rd new file mode 100644 index 0000000..c4aebe3 --- /dev/null +++ b/man/extract_time_series.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_patterns.R +\name{extract_time_series} +\alias{extract_time_series} +\title{Extract Time Series from a Stars Object for Specified Points} +\usage{ +extract_time_series(x, y) +} +\arguments{ +\item{x}{A stars object containing the raster time series data.} + +\item{y}{An sf object containing the point geometries and their associated labels.} +} +\value{ +A data.frame with the extracted time series for each point in the sf object, +with additional columns for the ID and label of each sample. +} +\description{ +This function extracts a time series from a stars object for each specified point in the sf object. +Each extracted sample is then labeled with an ID and the label from the sf object. +} diff --git a/man/get.Rd b/man/get.Rd deleted file mode 100644 index a0aabd3..0000000 --- a/man/get.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/getInternals.R -\name{get} -\alias{get} -\alias{getAlignments,twdtwMatches-method} -\alias{getAlignments} -\alias{getInternals,twdtwMatches-method} -\alias{getInternals} -\alias{getMatches,twdtwMatches-method} -\alias{getMatches} -\title{Get elements from twdtwMatches objects} -\usage{ -\S4method{getAlignments}{twdtwMatches}(object, timeseries.labels = NULL, patterns.labels = NULL) - -\S4method{getInternals}{twdtwMatches}(object, timeseries.labels = NULL, patterns.labels = NULL) - -\S4method{getMatches}{twdtwMatches}(object, timeseries.labels = NULL, patterns.labels = NULL) -} -\arguments{ -\item{object}{an object of class twdtwMatches.} - -\item{timeseries.labels}{a vector with labels of the time series.} - -\item{patterns.labels}{a vector with labels of the patterns.} -} -\value{ -a list with TWDTW results or an object \code{\link[dtwSat]{twdtwTimeSeries-class}}. -} -\description{ -Get elements from \code{\link[dtwSat]{twdtwMatches-class}} objects. -} -\examples{ -# Getting patterns from objects of class twdtwMatches -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -ts = twdtwTimeSeries(MOD13Q1.ts.list) -mat = twdtwApply(x=ts, y=patt, weight.fun=logisticWeight(-0.1,100), - keep=TRUE, legacy = TRUE) -getPatterns(mat) -getTimeSeries(mat) -getAlignments(mat) -getMatches(mat) -getInternals(mat) - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, and -\code{\link[dtwSat]{twdtwApply}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/getDatesFromDOY.Rd b/man/getDatesFromDOY.Rd deleted file mode 100644 index 9d5e676..0000000 --- a/man/getDatesFromDOY.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/miscellaneous.R -\docType{methods} -\name{getDatesFromDOY} -\alias{getDatesFromDOY} -\title{Get dates from year and day of the year} -\usage{ -getDatesFromDOY(year, doy) -} -\arguments{ -\item{year}{A vector with the years.} - -\item{doy}{A vector with the day of the year. -It must have the same length as \code{year}.} -} -\value{ -A \code{\link[base]{Dates}} object. -} -\description{ -This function retrieves the date corresponding to the given -year and day of the year. -} -\examples{ -year = c(2000, 2001) -doy = c(366, 365) -dates = getDatesFromDOY(year, doy) -dates - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\link[dtwSat]{shiftDates} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/getTimeSeries.Rd b/man/getTimeSeries.Rd deleted file mode 100644 index 2a0a834..0000000 --- a/man/getTimeSeries.Rd +++ /dev/null @@ -1,94 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/getTimeSeries.R -\name{getTimeSeries} -\alias{getTimeSeries} -\alias{getPatterns} -\alias{getTimeSeries,twdtwTimeSeries-method} -\alias{getTimeSeries-twdtwTimeSeries} -\alias{getTimeSeries,twdtwMatches-method} -\alias{getTimeSeries-twdtwMatches} -\alias{getPatterns,twdtwMatches-method} -\alias{getPatterns-twdtwMatches} -\alias{getTimeSeries,twdtwRaster-method} -\alias{getTimeSeries-twdtwRaster} -\title{Get time series from twdtw* objects} -\usage{ -\S4method{getTimeSeries}{twdtwTimeSeries}(object, labels = NULL) - -\S4method{getTimeSeries}{twdtwMatches}(object, labels = NULL) - -\S4method{getPatterns}{twdtwMatches}(object, labels = NULL) - -\S4method{getTimeSeries}{twdtwRaster}(object, y, labels = NULL, proj4string = NULL, id.labels = NULL) -} -\arguments{ -\item{object}{an object of class twdtw*.} - -\item{labels}{character vector with time series labels. For signature -\code{\link[dtwSat]{twdtwRaster}} this argument can be used to set the -labels for each sample in \code{y}, or it can be combined with \code{id.labels} -to select samples with a specific label.} - -\item{y}{a \code{\link[base]{data.frame}} whose attributes are: longitude, -latitude, the start ''from'' and the end ''to'' of the time interval -for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} -whose attributes are the start ''from'' and the end ''to'' of the time interval. -If missing ''from'' and/or ''to'', they are set to the time range of the -\code{object}.} - -\item{proj4string}{projection string, see \code{\link[sp]{CRS-class}}. Used -if \code{y} is a \code{\link[base]{data.frame}}.} - -\item{id.labels}{a numeric or character with an column name from \code{y} to -be used as sample labels. Optional.} -} -\value{ -An object of class \code{\link[dtwSat]{twdtwTimeSeries}}. - -a list with TWDTW results or an object \code{\link[dtwSat]{twdtwTimeSeries-class}}. -} -\description{ -Get time series from objects of class twdtw*. -} -\examples{ -# Getting time series from objects of class twdtwTimeSeries -ts = twdtwTimeSeries(MOD13Q1.ts.list) -getTimeSeries(ts, 2) -# Getting time series from objects of class twdtwTimeSeries -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat = twdtwApply(x=ts, y=patt, keep=TRUE, legacy=TRUE) -getTimeSeries(mat, 2) - -## This example creates a twdtwRaster object and extract time series from it. - -# Creating objects of class twdtwRaster with evi and ndvi time series -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, timeline=timeline) - -# Location and time range -ts_location = data.frame(longitude = -55.96957, latitude = -12.03864, - from = "2007-09-01", to = "2013-09-01") -prj_string = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0" - -# Extract time series -ts = getTimeSeries(rts, y = ts_location, proj4string = prj_string) - -autoplot(ts[[1]], facets = NULL) + xlab("Time") + ylab("Value") - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{twdtwTimeSeries-class}}, and -\code{\link[dtwSat]{twdtwMatches-class}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/get_stars_time_freq.Rd b/man/get_stars_time_freq.Rd new file mode 100644 index 0000000..47d90c4 --- /dev/null +++ b/man/get_stars_time_freq.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_patterns.R +\name{get_stars_time_freq} +\alias{get_stars_time_freq} +\title{Compute the Most Common Sampling Frequency in a Stars Object} +\usage{ +get_stars_time_freq(x) +} +\arguments{ +\item{x}{A stars object containing time series data.} +} +\value{ +A difftime object representing the most common time difference between consecutive samples. +} +\description{ +This function calculates the most common difference between consecutive time points in a stars object. +This can be useful for determining the sampling frequency of the time series data. +} diff --git a/man/linearWeight.Rd b/man/linearWeight.Rd deleted file mode 100644 index f4fdb4a..0000000 --- a/man/linearWeight.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/linearWeight.R -\docType{methods} -\name{linearWeight} -\alias{linearWeight} -\title{Linear weight function} -\usage{ -linearWeight(a, b = 0) -} -\arguments{ -\item{a}{numeric. The slop of the line.} - -\item{b}{numeric. The intercept of the line.} -} -\value{ -A \code{\link[base]{function}} object. -} -\description{ -Builds a linear time weight -function to compute the TWDTW local cost matrix [1]. -} -\details{ -The linear \code{linearWeight} and \code{logisticWeight} weight functions -can be passed to \code{\link[dtwSat]{twdtwApply}} through the argument \code{weight.fun}. -This will add a time-weight to the dynamic time warping analysis. The time weight -creates a global constraint useful to analyse time series with phenological cycles -of vegetation that are usually bound to seasons. In previous studies by -\insertCite{Maus:2016;textual}{dtwSat} the logistic weight had better results than the -linear for land cover classification. See \insertCite{Maus:2016;textual}{dtwSat} and -\insertCite{Maus:2019;textual}{dtwSat}. -} -\examples{ -lin_fun = linearWeight(a=0.1) -lin_fun - -} -\references{ -\insertAllCited{} -} -\seealso{ -\code{\link[dtwSat]{twdtwApply}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/logisticWeight.Rd b/man/logisticWeight.Rd deleted file mode 100644 index df44b49..0000000 --- a/man/logisticWeight.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/logisticWeight.R -\docType{methods} -\name{logisticWeight} -\alias{logisticWeight} -\title{Logistic weight function} -\usage{ -logisticWeight(alpha, beta) -} -\arguments{ -\item{alpha}{numeric. The steepness of logistic weight.} - -\item{beta}{numeric. The midpoint of logistic weight.} -} -\value{ -A \code{\link[base]{function}} object. -} -\description{ -Builds a logistic time weight -function to compute the TWDTW local cost matrix [1]. -} -\details{ -The linear \code{linearWeight} and \code{logisticWeight} weight functions -can be passed to \code{\link[dtwSat]{twdtwApply}} through the argument \code{weight.fun}. -This will add a time-weight to the dynamic time warping analysis. The time weight -creates a global constraint useful to analyze time series with phenological cycles -of vegetation that are usually bound to seasons. In previous studies by -\insertCite{Maus:2016;textual}{dtwSat} the logistic weight had better results than the -linear for land cover classification. See \insertCite{Maus:2016;textual}{dtwSat} and -\insertCite{Maus:2019;textual}{dtwSat}. -} -\examples{ -log_fun = logisticWeight(alpha=-0.1, beta=100) -log_fun - -} -\references{ -\insertAllCited{} -} -\seealso{ -\code{\link[dtwSat]{twdtwApply}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plot.Rd b/man/plot.Rd deleted file mode 100644 index 9651a23..0000000 --- a/man/plot.Rd +++ /dev/null @@ -1,66 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plot.R -\name{plot} -\alias{plot} -\alias{plot,twdtwAssessment,ANY-method} -\alias{plot-twdtwAssessment} -\alias{plot,twdtwCrossValidation,ANY-method} -\alias{plot-twdtwTimeSeries} -\alias{plot,twdtwTimeSeries,ANY-method} -\alias{plot,twdtwMatches,ANY-method} -\alias{plot-twdtwMatches} -\alias{plot,twdtwRaster,ANY-method} -\alias{plot-twdtwRaster} -\title{Plotting twdtw* objects} -\usage{ -\S4method{plot}{twdtwAssessment,ANY}(x, type = "area", ...) - -\S4method{plot}{twdtwCrossValidation,ANY}(x, type = "crossvalidation", ...) - -\S4method{plot}{twdtwTimeSeries,ANY}(x, type = "timeseries", ...) - -\S4method{plot}{twdtwMatches,ANY}(x, type = "alignments", ...) - -\S4method{plot}{twdtwRaster,ANY}(x, type = "maps", ...) -} -\arguments{ -\item{x}{An object of class twdtw*.} - -\item{type}{A character for the plot type: ''paths'', ''matches'', -''alignments'', ''classification'', ''cost'', ''patterns'', ''timeseries'', -''maps'', ''area'', ''changes'', and ''distance''.} - -\item{...}{additional arguments to pass to plotting functions. -\code{\link[dtwSat]{plotPaths}}, -\code{\link[dtwSat]{plotCostMatrix}}, -\code{\link[dtwSat]{plotAlignments}}, -\code{\link[dtwSat]{plotMatches}}, -\code{\link[dtwSat]{plotClassification}}, -\code{\link[dtwSat]{plotPatterns}}, -\code{\link[dtwSat]{plotTimeSeries}}, -\code{\link[dtwSat]{plotMaps}}, -\code{\link[dtwSat]{plotArea}}, or -\code{\link[dtwSat]{plotChanges}}.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Methods for plotting objects of class twdtw*. -} -\details{ -\describe{ - \item{Plot types}{: - \cr\code{paths}: Method for plotting the minimum paths in the cost matrix of TWDTW. - \cr\code{matches}: Method for plotting the matching points from TWDTW analysis. - \cr\code{alignments}: Method for plotting the alignments and respective TWDTW dissimilarity measures. - \cr\code{classification}: Method for plotting the classification of each subinterval of the time series based on TWDTW analysis. - \cr\code{cost}: Method for plotting the internal matrices used during the TWDTW computation. - \cr\code{patterns}: Method for plotting the temporal patterns. - \cr\code{timeseries}: Method for plotting the temporal patterns. - } -} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotAccuracy.Rd b/man/plotAccuracy.Rd deleted file mode 100644 index d0a1570..0000000 --- a/man/plotAccuracy.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotAccuracy.R -\name{plotAccuracy} -\alias{plotAccuracy} -\title{Plotting accuracy assessment} -\usage{ -plotAccuracy( - x, - perc = TRUE, - conf.int = 0.95, - time.labels = NULL, - category.name = NULL, - category.type = NULL -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwAssessment}} or -\code{\link[dtwSat]{twdtwCrossValidation}}.} - -\item{perc}{if TRUE shows the results in percent of area. Otherwise shows the -area in the map units or km2 for no project raster. Default is TRUE.} - -\item{conf.int}{confidence level (0-1) for interval estimation of the population mean. -For details see \code{\link[Hmisc]{smean.cl.normal}}. Used if \code{x} is -\code{\link[dtwSat]{twdtwCrossValidation}}.} - -\item{time.labels}{a character or numeric for the time periods or NULL to -aggregate all classified periods in the same plot. Default is NULL. Used -if \code{x} is \code{\link[dtwSat]{twdtwAssessment}}.} - -\item{category.name}{a character vector defining the class names. If NULL -the class names in the object \code{x} are used. Default is NULL.} - -\item{category.type}{a character defining the categories type "numeric" -or "letter", if NULL the class names are used. Default is NULL.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting accuracy assessment results. -} -\examples{ -\dontrun{ - -# See ?twdtwAssess and ?twdtwCrosValidate - -plotAccuracy(x) - -plotAccuracy(x, category.type="letter") - -} - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwAssessment}} and \code{\link[dtwSat]{twdtwAssess}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotAdjustedArea.Rd b/man/plotAdjustedArea.Rd deleted file mode 100644 index 5b3f680..0000000 --- a/man/plotAdjustedArea.Rd +++ /dev/null @@ -1,60 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotAdjustedArea.R -\name{plotAdjustedArea} -\alias{plotAdjustedArea} -\title{Plotting area and uncertainty} -\usage{ -plotAdjustedArea( - x, - perc = TRUE, - time.labels = NULL, - category.name = NULL, - category.type = NULL -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwAssessment}} or -\code{\link[dtwSat]{twdtwCrossValidation}}.} - -\item{perc}{if TRUE shows the results in percent of area. Otherwise shows the -area in the map units or km2 for no project raster. Default is TRUE.} - -\item{time.labels}{a character or numeric for the time periods or NULL to -aggregate all classified periods in the same plot. Default is NULL. Used -if \code{x} is \code{\link[dtwSat]{twdtwAssessment}}.} - -\item{category.name}{a character vector defining the class names. If NULL -the class names in the object \code{x} are used. Default is NULL.} - -\item{category.type}{a character defining the categories type "numeric" -or "letter", if NULL the class names are used. Default is NULL.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting area and uncertainty. -} -\examples{ -\dontrun{ - -# See ?twdtwAssess - -plotAdjustedArea(twdtw_assess) - -plotAdjustedArea(twdtw_assess, category.type="letter") - -} - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwAssessment}} and \code{\link[dtwSat]{twdtwAssess}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotAlignments.Rd b/man/plotAlignments.Rd deleted file mode 100644 index d050cdb..0000000 --- a/man/plotAlignments.Rd +++ /dev/null @@ -1,63 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotAlignments.R -\name{plotAlignments} -\alias{plotAlignments} -\title{Plotting alignments} -\usage{ -plotAlignments( - x, - timeseries.labels = NULL, - patterns.labels = NULL, - attr = 1, - threshold = Inf -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwMatches}}.} - -\item{timeseries.labels}{the label or index of the time series. -Default is 1.} - -\item{patterns.labels}{a vector with labels of the patterns. If not -declared the function will plot the alignments for all patterns in \code{x}.} - -\item{attr}{An \link[base]{integer} or \link[base]{character} vector -indicating the attribute for plotting. Default is 1.} - -\item{threshold}{A number. The TWDTW dissimilarity threshold, \emph{i.e.} the -maximum TWDTW cost for consideration. Default is \code{Inf}.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting the alignments and TWDTW -dissimilarity measures. -} -\examples{ -log_fun = logisticWeight(-0.1, 100) -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) - -plotAlignments(mat1) - -plotAlignments(mat1, attr=c("evi","ndvi")) - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotPaths}}, -\code{\link[dtwSat]{plotCostMatrix}}, -\code{\link[dtwSat]{plotMatches}}, and -\code{\link[dtwSat]{plotClassification}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotArea.Rd b/man/plotArea.Rd deleted file mode 100644 index 3becab5..0000000 --- a/man/plotArea.Rd +++ /dev/null @@ -1,106 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotArea.R -\name{plotArea} -\alias{plotArea} -\title{Plotting accumulated area} -\usage{ -plotArea( - x, - time.levels = NULL, - time.labels = NULL, - class.levels = NULL, - class.labels = NULL, - class.colors = NULL, - perc = TRUE -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwRaster}}.} - -\item{time.levels}{A \link[base]{character} or \link[base]{numeric} -vector with the layers to plot. For plot type ''change'' the minimum length -is two.} - -\item{time.labels}{A \link[base]{character} or \link[base]{numeric} -vector with the labels of the layers. It must have the same -length as time.levels. Default is NULL.} - -\item{class.levels}{A \link[base]{character} or \link[base]{numeric} -vector with the levels of the raster values. Default is NULL.} - -\item{class.labels}{A \link[base]{character} or \link[base]{numeric} -vector with the labels of the raster values. It must have the same -length as class.levels. Default is NULL.} - -\item{class.colors}{a set of aesthetic values. It must have the same -length as class.levels. Default is NULL. See -\link[ggplot2]{scale_fill_manual} for details.} - -\item{perc}{if TRUE shows the results in percent of area. Otherwise shows the -area in the map units or km2 for no project raster. Default is TRUE.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting time series of accumulated area. -} -\examples{ -\dontrun{ - -# Create raster time series -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Read field samples -field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -proj_str = scan(system.file("lucc_MT/data/samples_projection", - package="dtwSat"), what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -library(caret) -set.seed(1) -I = unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples = field_samples[I,] -validation_samples = field_samples[-I,] - -# Create temporal patterns -training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) -temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Run TWDTW analysis for raster time series -log_fun = weight.fun=logisticWeight(-0.1,50) -r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", - overwrite=TRUE) - -# Classify raster based on the TWDTW analysis -r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) - -plotArea(r_lucc) - -plotArea(r_lucc, perc=FALSE) - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotMaps}}, -\code{\link[dtwSat]{plotChanges}}, and -\code{\link[dtwSat]{plotDistance}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotChanges.Rd b/man/plotChanges.Rd deleted file mode 100644 index 898d2ea..0000000 --- a/man/plotChanges.Rd +++ /dev/null @@ -1,85 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotChanges.R -\name{plotChanges} -\alias{plotChanges} -\title{Plotting changes} -\usage{ -plotChanges( - x, - time.levels = NULL, - time.labels = NULL, - class.levels = NULL, - class.labels = NULL, - class.colors = NULL -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwRaster}}.} - -\item{time.levels}{A \link[base]{character} or \link[base]{numeric} -vector with the layers to plot. For plot type ''change'' the minimum length -is two.} - -\item{time.labels}{A \link[base]{character} or \link[base]{numeric} -vector with the labels of the layers. It must have the same -length as time.levels. Default is NULL.} - -\item{class.levels}{A \link[base]{character} or \link[base]{numeric} -vector with the levels of the raster values. Default is NULL.} - -\item{class.labels}{A \link[base]{character} or \link[base]{numeric} -vector with the labels of the raster values. It must have the same -length as class.levels. Default is NULL.} - -\item{class.colors}{A set of aesthetic values. It must have the same -length as class.levels. Default is NULL. See -\link[ggplot2]{scale_fill_manual} for details.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting changes over time. -} -\examples{ -\dontrun{ -# Run TWDTW analysis for raster time series -patt = MOD13Q1.MT.yearly.patterns -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -time_interval = seq(from=as.Date("2007-09-01"), to=as.Date("2013-09-01"), - by="12 month") -log_fun = weight.fun=logisticWeight(-0.1,50) - -r_twdtw = twdtwApply(x=rts, y=patt, weight.fun=log_fun, breaks=time_interval, - filepath="~/test_twdtw", overwrite=TRUE, format="GTiff") - -r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) - -plotChanges(r_lucc) - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotArea}}, -\code{\link[dtwSat]{plotMaps}}, and -\code{\link[dtwSat]{plotDistance}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotClassification.Rd b/man/plotClassification.Rd deleted file mode 100644 index eee6911..0000000 --- a/man/plotClassification.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotClassification.R -\name{plotClassification} -\alias{plotClassification} -\title{Plotting subintervals classification} -\usage{ -plotClassification( - x, - timeseries.labels = NULL, - patterns.labels = NULL, - attr, - ... -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwMatches}}.} - -\item{timeseries.labels}{The label or index of the time series. -Default is 1.} - -\item{patterns.labels}{A vector with labels of the patterns. If not -declared the function will plot one alignment for each pattern.} - -\item{attr}{An \link[base]{integer} vector or \link[base]{character} vector -indicating the attribute for plotting. If not declared the function will plot -all attributes.} - -\item{...}{Additional arguments passed to \code{\link[dtwSat]{twdtwClassify}}.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting the classification of each -subinterval of the time series based on TWDTW analysis. -} -\examples{ -log_fun = logisticWeight(-0.1, 100) -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) - -# Classify interval -from = as.Date("2007-09-01") -to = as.Date("2013-09-01") -by = "6 month" -gp = plotClassification(x=mat1, from=from, to=to, by=by, overlap=.5) -gp - - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{twdtwClassify}}, -\code{\link[dtwSat]{plotAlignments}}, -\code{\link[dtwSat]{plotPaths}}, -\code{\link[dtwSat]{plotMatches}}, and -\code{\link[dtwSat]{plotCostMatrix}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotCostMatrix.Rd b/man/plotCostMatrix.Rd deleted file mode 100644 index b9e5fd0..0000000 --- a/man/plotCostMatrix.Rd +++ /dev/null @@ -1,62 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotCostMatrix.R -\name{plotCostMatrix} -\alias{plotCostMatrix} -\title{Plotting paths} -\usage{ -plotCostMatrix( - x, - timeseries.labels = NULL, - patterns.labels = NULL, - matrix.name = "costMatrix" -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwMatches}}.} - -\item{timeseries.labels}{The label or index of the time series. -Default is 1.} - -\item{patterns.labels}{A vector with labels of the patterns. If not -declared the function will plot one alignment for each pattern.} - -\item{matrix.name}{A character. The name of the matrix to plot, -"costMatrix" for accumulated cost, "localMatrix" for local cost, -or "timeWeight" for time-weight. Default is "costMatrix".} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting low cost paths in the TWDTW -cost matrix. -} -\examples{ -log_fun = logisticWeight(-0.1, 100) -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) - -plotCostMatrix(mat1, matrix.name="costMatrix") - -plotCostMatrix(mat1, matrix.name="localMatrix") - -plotCostMatrix(mat1, matrix.name="timeWeight") - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotAlignments}}, -\code{\link[dtwSat]{plotPaths}}, -\code{\link[dtwSat]{plotMatches}}, and -\code{\link[dtwSat]{plotClassification}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotDistance.Rd b/man/plotDistance.Rd deleted file mode 100644 index 2beaf9d..0000000 --- a/man/plotDistance.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotDistance.R -\name{plotDistance} -\alias{plotDistance} -\title{Plotting distance maps} -\usage{ -plotDistance(x, time.levels = 1, time.labels = 1, layers = NULL) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwRaster}}.} - -\item{time.levels}{A \link[base]{character} or \link[base]{numeric} -vector with the layers to plot. For plot type ''change'' the minimum length -is two.} - -\item{time.labels}{A \link[base]{character} or \link[base]{numeric} -vector with the labels of the layers. It must have the same -length as time.levels. Default is NULL.} - -\item{layers}{A \link[base]{character} or \link[base]{numeric} -vector with the layers/bands of the raster time series.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting TWDTW distance maps. -} -\examples{ -\dontrun{ -# Run TWDTW analysis for raster time series -patt = MOD13Q1.MT.yearly.patterns -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -time_interval = seq(from=as.Date("2007-09-01"), to=as.Date("2013-09-01"), - by="12 month") -log_fun = weight.fun=logisticWeight(-0.1,50) - -r_twdtw = twdtwApply(x=rts, y=patt, weight.fun=log_fun, breaks=time_interval, - filepath="~/test_twdtw", overwrite=TRUE, format="GTiff", mc.cores=3) - -plotDistance(r_twdtw) - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotArea}}, -\code{\link[dtwSat]{plotChanges}}, and -\code{\link[dtwSat]{plotDistance}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotMapSamples.Rd b/man/plotMapSamples.Rd deleted file mode 100644 index 2e57872..0000000 --- a/man/plotMapSamples.Rd +++ /dev/null @@ -1,120 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotMapSamples.R -\name{plotMapSamples} -\alias{plotMapSamples} -\title{Plotting maps} -\usage{ -plotMapSamples(x, samples = "all", ...) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwAssessment}}.} - -\item{samples}{A character defining the samples to plot -"correct", "incorrect", "all". Default is "all".} - -\item{...}{Other arguments to pass to \code{\link[dtwSat]{twdtwRaster}}} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting maps and samples. -} -\examples{ -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwAssessment}}, -\code{\link[dtwSat]{plotAccuracy}}, and -\code{\link[dtwSat]{plotAdjustedArea}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotMaps.Rd b/man/plotMaps.Rd deleted file mode 100644 index b366474..0000000 --- a/man/plotMaps.Rd +++ /dev/null @@ -1,85 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotMaps.R -\name{plotMaps} -\alias{plotMaps} -\title{Plotting maps} -\usage{ -plotMaps( - x, - time.levels = NULL, - time.labels = NULL, - class.levels = NULL, - class.labels = NULL, - class.colors = NULL -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwRaster}}.} - -\item{time.levels}{A \link[base]{character} or \link[base]{numeric} -vector with the layers to plot. For plot type ''change'' the minimum length -is two.} - -\item{time.labels}{A \link[base]{character} or \link[base]{numeric} -vector with the labels of the layers. It must have the same -length as time.levels. Default is NULL.} - -\item{class.levels}{A \link[base]{character} or \link[base]{numeric} -vector with the levels of the raster values. Default is NULL.} - -\item{class.labels}{A \link[base]{character} or \link[base]{numeric} -vector with the labels of the raster values. It must have the same -length as class.levels. Default is NULL.} - -\item{class.colors}{A set of aesthetic values. It must have the same -length as class.levels. Default is NULL. See -\link[ggplot2]{scale_fill_manual} for details.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting time series of maps. -} -\examples{ -\dontrun{ -# Run TWDTW analysis for raster time series -patt = MOD13Q1.MT.yearly.patterns -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -time_interval = seq(from=as.Date("2007-09-01"), to=as.Date("2013-09-01"), - by="12 month") -log_fun = weight.fun=logisticWeight(-0.1,50) - -r_twdtw = twdtwApply(x=rts, y=patt, weight.fun=log_fun, breaks=time_interval, - filepath="~/test_twdtw", overwrite=TRUE, format="GTiff", mc.cores=3) - -r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) - -plotMaps(r_lucc) - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotArea}}, -\code{\link[dtwSat]{plotChanges}}, and -\code{\link[dtwSat]{plotDistance}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotMatches.Rd b/man/plotMatches.Rd deleted file mode 100644 index 9098386..0000000 --- a/man/plotMatches.Rd +++ /dev/null @@ -1,76 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotMatches.R -\docType{methods} -\name{plotMatches} -\alias{plotMatches} -\title{Plotting matching points} -\usage{ -plotMatches( - x, - timeseries.labels = 1, - patterns.labels = NULL, - k = 1, - attr = 1, - shift = 0.5, - show.dist = FALSE -) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwMatches}}.} - -\item{timeseries.labels}{The label or index of the time series. -Default is 1.} - -\item{patterns.labels}{A vector with labels of the patterns. If not -declared the function will plot one alignment for each pattern.} - -\item{k}{A positive integer. The index of the last alignment to include in -the plot. If not declared the function will plot the best match for -each pattern.} - -\item{attr}{An \link[base]{integer} or \link[base]{character} vector -indicating the attribute for plotting. Default is 1.} - -\item{shift}{A number that shifts the pattern position in the \code{x} -direction. Default is 0.5.} - -\item{show.dist}{Show the distance for each alignment. Default is FALSE.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting the matching points from -TWDTW analysis. -} -\examples{ -log_fun = logisticWeight(-0.1, 100) -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) - -plotMatches(mat1) - -plotMatches(mat1, patterns.labels="Soybean", k=4) - -plotMatches(mat1, patterns.labels=c("Soybean","Maize"), k=4) - -plotMatches(mat1, patterns.labels=c("Soybean","Cotton"), k=c(3,1)) - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotPaths}}, -\code{\link[dtwSat]{plotCostMatrix}}, -\code{\link[dtwSat]{plotAlignments}}, and -\code{\link[dtwSat]{plotClassification}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotPaths.Rd b/man/plotPaths.Rd deleted file mode 100644 index d08260e..0000000 --- a/man/plotPaths.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotPaths.R -\name{plotPaths} -\alias{plotPaths} -\title{Plotting paths} -\usage{ -plotPaths(x, timeseries.labels = NULL, patterns.labels = NULL, k = NULL) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwMatches}}.} - -\item{timeseries.labels}{The label or index of the time series. -Default is 1.} - -\item{patterns.labels}{A vector with labels of the patterns. If not -declared the function will plot one alignment for each pattern.} - -\item{k}{A positive integer. The index of the last alignment to include in -the plot. If not declared the function will plot all low cost paths.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting low cost paths in the TWDTW -cost matrix. -} -\examples{ -log_fun = logisticWeight(-0.1, 100) -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) - -plotPaths(mat1) - -plotPaths(mat1, patterns.labels="Soybean", k=1:2) - -plotPaths(mat1, patterns.labels=c("Maize","Cotton"), k=2) - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{plotAlignments}}, -\code{\link[dtwSat]{plotCostMatrix}}, -\code{\link[dtwSat]{plotMatches}}, and -\code{\link[dtwSat]{plotClassification}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotPatterns.Rd b/man/plotPatterns.Rd deleted file mode 100644 index 44e91f7..0000000 --- a/man/plotPatterns.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotPatterns.R -\name{plotPatterns} -\alias{plotPatterns} -\title{Plotting temporal patterns} -\usage{ -plotPatterns(x, labels = NULL, attr, year = 2005) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwTimeSeries}}, -\code{\link[zoo]{zoo}}, or list of \code{\link[zoo]{zoo}}.} - -\item{labels}{A vector with labels of the time series. If not declared -the function will plot all time series.} - -\item{attr}{An \link[base]{integer} vector or \link[base]{character} vector -indicating the attribute for plotting. If not declared the function will plot -all attributes.} - -\item{year}{An integer. The base year to shift the dates of the time series to. -If NULL then the time series is not shifted. Default is 2005.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting the temporal patterns. -} -\examples{ -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -plotPatterns(patt) -plotPatterns(patt, attr="evi") - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwTimeSeries-class}} and -\code{\link[dtwSat]{plotTimeSeries}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plotTimeSeries.Rd b/man/plotTimeSeries.Rd deleted file mode 100644 index 8233ef1..0000000 --- a/man/plotTimeSeries.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotTimeSeries.R -\name{plotTimeSeries} -\alias{plotTimeSeries} -\title{Plotting time series} -\usage{ -plotTimeSeries(x, labels = NULL, attr) -} -\arguments{ -\item{x}{An object of class \code{\link[dtwSat]{twdtwTimeSeries}}, -\code{\link[zoo]{zoo}}, or list of class \code{\link[zoo]{zoo}}.} - -\item{labels}{A vector with labels of the time series. If missing, all -elements in the list will be plotted (up to a maximum of 16).} - -\item{attr}{An \link[base]{integer} vector or \link[base]{character} vector -indicating the attribute for plotting. If not declared the function will plot -all attributes.} -} -\value{ -A \link[ggplot2]{ggplot} object. -} -\description{ -Method for plotting the temporal patterns. -} -\examples{ -ts = twdtwTimeSeries(MOD13Q1.ts.list) -plotTimeSeries(ts) -plotTimeSeries(ts, attr="evi") - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwTimeSeries-class}} and -\code{\link[dtwSat]{plotPatterns}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/plot_patterns.Rd b/man/plot_patterns.Rd new file mode 100644 index 0000000..97e24d6 --- /dev/null +++ b/man/plot_patterns.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_patterns.R +\name{plot_patterns} +\alias{plot_patterns} +\title{Plot Patterns from Time Series Data} +\usage{ +plot_patterns(x, ...) +} +\arguments{ +\item{x}{A list where each element is a data.frame representing a time series. +Each data.frame should have the same number of rows and columns, +with columns representing different attributes (e.g., bands or indices) +and rows representing time points. +The name of each element in the list will be used as the facet title.} + +\item{...}{Not used.} +} +\value{ +A ggplot object displaying the time series patterns. +} +\description{ +This function takes a list of time series data and creates a multi-faceted plot +where each facet corresponds to a different time series from the list. +Within each facet, different attributes (columns of the time series) are +plotted as lines with different colors. +} diff --git a/man/reexports.Rd b/man/reexports.Rd deleted file mode 100644 index 82e3410..0000000 --- a/man/reexports.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/zzz.R -\docType{import} -\name{reexports} -\alias{reexports} -\alias{symmetric1} -\alias{symmetric2} -\alias{asymmetric} -\alias{rabinerJuangStepPattern} -\title{Objects exported from other packages} -\keyword{internal} -\description{ -These objects are imported from other packages. Follow the links -below to see their documentation. - -\describe{ - \item{dtw}{\code{\link[dtw:stepPattern]{asymmetric}}, \code{\link[dtw:stepPattern]{rabinerJuangStepPattern}}, \code{\link[dtw:stepPattern]{symmetric1}}, \code{\link[dtw:stepPattern]{symmetric2}}} -}} - diff --git a/man/resampleTimeSeries.Rd b/man/resampleTimeSeries.Rd deleted file mode 100644 index c2b008f..0000000 --- a/man/resampleTimeSeries.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/resampleTimeSeries.R -\name{resampleTimeSeries} -\alias{resampleTimeSeries} -\alias{resampleTimeSeries,twdtwTimeSeries-method} -\alias{resampleTimeSeries-twdtwMatches} -\title{Resample time series} -\usage{ -resampleTimeSeries(object, length = NULL) - -\S4method{resampleTimeSeries}{twdtwTimeSeries}(object, length = NULL) -} -\arguments{ -\item{object}{an object of class twdtwTimeSeries.} - -\item{length}{An integer. The number of samples to resample the time series to. -If not declared the length is set to the length of the longest time series.} -} -\value{ -An object of class \code{\link[dtwSat]{twdtwTimeSeries}} whose -time series have the same number of samples (points). -} -\description{ -Resample time series in the object to have the same length. -} -\examples{ -# Resampling time series from objects of class twdtwTimeSeries -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -npatt = resampleTimeSeries(patt, length=46) -nrow(patt) -nrow(npatt) - -} -\seealso{ -\code{\link[dtwSat]{twdtwTimeSeries-class}}, and -\code{\link[dtwSat]{twdtwApply}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/shiftDates.Rd b/man/shiftDates.Rd deleted file mode 100644 index 0ff01d8..0000000 --- a/man/shiftDates.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/miscellaneous.R -\name{shiftDates} -\alias{shiftDates} -\alias{shiftDates,twdtwTimeSeries-method} -\alias{shiftDates-twdtwTimeSeries} -\alias{shiftDates,list-method} -\alias{shiftDates-list} -\alias{shiftDates,zoo-method} -\alias{shiftDates-zoo} -\title{Shift dates} -\usage{ -shiftDates(object, year = NULL) - -\S4method{shiftDates}{twdtwTimeSeries}(object, year = NULL) - -\S4method{shiftDates}{list}(object, year = NULL) - -\S4method{shiftDates}{zoo}(object, year = NULL) -} -\arguments{ -\item{object}{\code{\link[dtwSat]{twdtwTimeSeries}} objects, -\code{\link[zoo]{zoo}} objects or a list of \code{\link[zoo]{zoo}} objects.} - -\item{year}{the base year to shift the time series to.} -} -\value{ -An object of the same class as the input \code{object}. -} -\description{ -This function shifts the dates of the time series to a -given base year. -} -\examples{ -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -npatt = shiftDates(patt, year=2005) -index(patt) -index(npatt) - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} - -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwTimeSeries-class}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/shift_dates.Rd b/man/shift_dates.Rd new file mode 100644 index 0000000..87d58c1 --- /dev/null +++ b/man/shift_dates.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{shift_dates} +\alias{shift_dates} +\title{Shift Dates to Start on a Specified Origin Year} +\usage{ +shift_dates(x, origin = "1970-01-01") +} +\arguments{ +\item{x}{A vector of date strings or Date objects representing the sequence to shift.} + +\item{origin}{A date string or Date object specifying the desired origin year for the shifted dates. +Default is "1970-01-01".} +} +\value{ +A vector of Date objects with the shifted dates starting on the same day-of-year in the specified origin year. +} +\description{ +Shifts a vector of dates to start on the same day-of-year in a specified origin year +while preserving the relative difference in days among the observations. +This way the temporal pattern (e.g., seasonality) inherent to the original dates +will also be preserved in the shifted dates. +} +\details{ +The primary goal of this function is to align a sequence of dates based on the day-of-year +in a desired origin year. This can be particularly useful for comparing or visualizing +two or more time series with different absolute dates but aiming to align them based on +the day-of-year or another relative metric. +} +\examples{ + +x <- c("2011-09-14", "2011-09-30", "2011-10-16", "2011-11-01") + +shift_dates(x) + +} diff --git a/man/subset.Rd b/man/subset.Rd deleted file mode 100644 index ef0fb5d..0000000 --- a/man/subset.Rd +++ /dev/null @@ -1,87 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/subset.R -\name{subset} -\alias{subset} -\alias{subset,twdtwTimeSeries-method} -\alias{subset-twdtwTimeSeries} -\alias{subset,twdtwMatches-method} -\alias{subset-twdtwMatches} -\alias{subset,twdtwRaster-method} -\alias{subset-twdtwRaster} -\title{Subset time series} -\usage{ -\S4method{subset}{twdtwTimeSeries}(x, labels = NULL) - -\S4method{subset}{twdtwMatches}(x, timeseries.labels = NULL, patterns.labels = NULL, k = NULL) - -\S4method{subset}{twdtwRaster}(x, e = NULL, layers = NULL) -} -\arguments{ -\item{x}{An objects of class twdtw*.} - -\item{labels}{A character vector with time series labels.} - -\item{timeseries.labels}{a vector with labels of the time series.} - -\item{patterns.labels}{a vector with labels of the patterns.} - -\item{k}{A positive integer. The index of the last alignment to include in -the subset.} - -\item{e}{An extent object, or any object from which an Extent object can -be extracted. See \link[raster]{crop} for details.} - -\item{layers}{A vector with the names of the \code{twdtwRaster} object to include in -the subset.} -} -\value{ -An object of class twdtw*. -} -\description{ -Get subsets from objects of class twdtw*. -} -\examples{ -# Getting time series from objects of class twdtwTimeSeries -ts = twdtwTimeSeries(MOD13Q1.ts.list) -ts = subset(ts, 2) -ts -# Getting time series from objects of class twdtwTimeSeries -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat = twdtwApply(x=ts, y=patt, weight.fun=logisticWeight(-0.1,100), - keep=TRUE, legacy=TRUE) -mat = subset(mat, k=4) - -## This example creates a twdtwRaster object and extracts time series from it. - -# Creating objects of class twdtwRaster with evi and ndvi time series -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, timeline=timeline) - -rts_evi = subset(rts, layers="evi") - -field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -prj_string = scan(system.file("lucc_MT/data/samples_projection", package="dtwSat"), - what = "character") - -# Extract time series -ts_evi = getTimeSeries(rts_evi, y = field_samples, proj4string = prj_string) - -# Subset all labels = "Forest" -ts_forest = subset(ts_evi, labels="Forest") - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{twdtwTimeSeries-class}}, and -\code{\link[dtwSat]{twdtwMatches-class}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwApply.Rd b/man/twdtwApply.Rd deleted file mode 100644 index 9b885a9..0000000 --- a/man/twdtwApply.Rd +++ /dev/null @@ -1,272 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/twdtwApply.R -\name{twdtwApply} -\alias{twdtwApply} -\alias{twdtwApply,twdtwTimeSeries-method} -\alias{twdtwApply-twdtwTimeSeries} -\alias{twdtwApply,twdtwRaster-method} -\alias{twdtwApply-twdtwRaster} -\title{Apply TWDTW analysis} -\usage{ -twdtwApply( - x, - y, - resample = TRUE, - length = NULL, - weight.fun = function(phi, psi) phi, - dist.method = "Euclidean", - step.matrix = symmetric1, - n = NULL, - span = NULL, - min.length = 0, - ... -) - -\S4method{twdtwApply}{twdtwTimeSeries}( - x, - y, - resample, - length, - weight.fun, - dist.method, - step.matrix, - n, - span, - min.length, - legacy = FALSE, - keep = FALSE, - ... -) - -\S4method{twdtwApply}{twdtwRaster}( - x, - y, - resample, - length, - weight.fun, - dist.method, - step.matrix, - n, - span, - min.length, - breaks = NULL, - from = NULL, - to = NULL, - by = NULL, - overlap = 0.5, - filepath = "", - fill = NULL, - legacy = FALSE, - progress = "text", - minrows = 1, - alpha = -0.1, - beta = 50, - ... -) -} -\arguments{ -\item{x}{An object of class twdtw*. This is the target time series. -Usually, it is a set of unclassified time series.} - -\item{y}{An object of class \link[dtwSat]{twdtwTimeSeries}. -The temporal patterns.} - -\item{resample}{Resample the patterns to have the same length. Default is TRUE. -See \link[dtwSat]{resampleTimeSeries} for details.} - -\item{length}{An integer. Length of patterns used with \code{patterns.length}. -If not declared the length of the output patterns will be the length of -the longest pattern.} - -\item{weight.fun}{A function. Any function that receives two matrices and -performs a computation on them, returning a single matrix with the same -dimensions. The first matrix is the DTW local cost matrix and the -second a matrix of the time differences in days. The function should return a -matrix of DTW local cost weighted by the time differences. If not declared -the time-weight is zero. In this case the function runs the standard version -of the dynamic time warping. See details.} - -\item{dist.method}{A character. Method to derive the local cost matrix. -Default is ''Euclidean'' see \code{\link[proxy]{dist}} in package -\pkg{proxy}.} - -\item{step.matrix}{See \code{\link[dtw]{stepPattern}} in package \pkg{dtw} -\insertCite{Giorgino:2009}{dtwSat}.} - -\item{n}{An integer. The maximun number of matches to perform. -NULL will return all matches.} - -\item{span}{A number. Span between two matches, \emph{i.e.} the minimum -interval between two matches; for details see \insertCite{Muller:2007}{dtwSat}. -If not declared it removes all overlapping matches of the same pattern. To include -overlapping matches of the same pattern use \code{span=0}.} - -\item{min.length}{A number between 0 an 1. This argument removes overfittings. -Minimum length after warping. Percentage of the original pattern length. Default is 0.5, -meaning that the matching cannot be shorter than half of the pattern length.} - -\item{...}{Arguments to pass to \code{\link[raster]{writeRaster}} and -\code{\link[raster]{pbCreate}}} - -\item{legacy}{logical. If FALSE, runs a faster new TWDTW implementation. Default FLASE} - -\item{keep}{Preserves the cost matrix, inputs, and other internal structures. -Default is FALSE. For plot methods use \code{keep=TRUE}.} - -\item{breaks}{A vector of class \code{\link[base]{Dates}}. This replaces the arguments \code{from}, -\code{to}, and \code{by}.} - -\item{from}{A character or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd".} - -\item{to}{A \code{\link[base]{character}} or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd".} - -\item{by}{A \code{\link[base]{character}} with the interval size, \emph{e.g.} "6 month".} - -\item{overlap}{A number between 0 and 1. The minimum overlapping -between one match and the interval of classification. Default is 0.5, -\emph{i.e.} an overlap minimum of 50\%.} - -\item{filepath}{A character. The path at which to save the raster with results. If not provided the -function saves in the current work directory.} - -\item{fill}{A character to fill the classification gaps. -For signature \code{twdtwTimeSeries} the default is \code{fill="unclassified"}, -for signature \code{twdtwRaster} the default is \code{fill="unclassified"}.} - -\item{progress}{character. 'text' or 'window'.} - -\item{minrows}{Integer. Minimum number of rows in each block} - -\item{alpha}{Numeric. The steepness of TWDTW logistic weight.} - -\item{beta}{Numeric. The midpoint of TWDTW logistic weight.} -} -\value{ -An object of class twdtw*. -} -\description{ -This function performs a multidimensional Time-Weighted DTW -analysis and retrieves the matches between the temporal patterns and -a set of time series \insertCite{Maus:2019}{dtwSat}. -} -\details{ -The linear \code{linearWeight} and \code{logisticWeight} weight functions -can be passed to \code{twdtwApply} through the argument \code{weight.fun}. This will -add a time-weight to the dynamic time warping analysis. The time weight -creates a global constraint useful for analyzing time series with phenological cycles -of vegetation that are usually bound to seasons. In previous studies by -\insertCite{Maus:2016}{dtwSat} the logistic weight had better results than the -linear for land cover classification. -See \insertCite{Maus:2016,Maus:2019}{dtwSat} for details about the method. -} -\examples{ -# Applying TWDTW analysis to objects of class twdtwTimeSeries -log_fun = logisticWeight(-0.1, 100) -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat1 = twdtwApply(x=ts, y=patt, weight.fun=log_fun, keep=TRUE, legacy=TRUE) -mat1 - -\dontrun{ -# Parallel processin -require(parallel) -mat_list = mclapply(as.list(ts), mc.cores=2, FUN=twdtwApply, y=patt, weight.fun=log_fun) -mat2 = twdtwMatches(alignments=mat_list) -} -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -} -\references{ -\insertAllCited{} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwTimeSeries-class}}, -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{getTimeSeries}}, and -\code{\link[dtwSat]{createPatterns}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwAssess.Rd b/man/twdtwAssess.Rd deleted file mode 100644 index e89ceb6..0000000 --- a/man/twdtwAssess.Rd +++ /dev/null @@ -1,284 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/twdtwAssess.R -\name{twdtwAssess} -\alias{twdtwAssess} -\alias{twdtwAssess,twdtwRaster-method} -\alias{twdtwAssess-twdtwRaster} -\alias{twdtwAssess,data.frame-method} -\alias{twdtwAssess-data.frame} -\alias{twdtwAssess,table-method} -\alias{twdtwAssess-table} -\alias{twdtwAssess,matrix-method} -\alias{twdtwAssess-matrix} -\alias{twdtwAssess,twdtwMatches-method} -\alias{twdtwAssess-twdtwMatches} -\title{Assess TWDTW classification} -\usage{ -\S4method{twdtwAssess}{twdtwRaster}( - object, - y, - labels = NULL, - id.labels = NULL, - proj4string = NULL, - conf.int = 0.95, - rm.nosample = FALSE, - start_date = NULL -) - -\S4method{twdtwAssess}{data.frame}(object, area, conf.int = 0.95, rm.nosample = TRUE) - -\S4method{twdtwAssess}{table}(object, area, conf.int = 0.95, rm.nosample = TRUE) - -\S4method{twdtwAssess}{matrix}(object, area, conf.int = 0.95, rm.nosample = TRUE) - -\S4method{twdtwAssess}{twdtwMatches}(object, area, conf.int = 0.95, rm.nosample = TRUE) -} -\arguments{ -\item{object}{An object of class \code{\link[dtwSat]{twdtwRaster}} resulting from -the classification, i.e. \code{\link[dtwSat]{twdtwClassify}}. -The argument can also receive an error matrix (confusion matrix) using the classes -\code{\link[base]{data.frame}} or \code{\link[base]{table}}. In this case the user -must provide the area for each class to the argument \code{area}.} - -\item{y}{A \code{\link[base]{data.frame}} whose attributes are: longitude, -latitude, the start ''from'' and the end ''to'' of the time interval -for each sample. This can also be a \code{\link[sp]{SpatialPointsDataFrame}} -whose attributes are the start ''from'' and the end ''to'' of the time interval. -If missing ''from'' and/or ''to'', they are set to the time range of the -\code{object}.} - -\item{labels}{Character vector with time series labels. For signature -\code{\link[dtwSat]{twdtwRaster}} this argument can be used to set the -labels for each sample in \code{y}, or it can be combined with \code{id.labels} -to select samples with a specific label.} - -\item{id.labels}{A numeric or character with an column name from \code{y} to -be used as samples labels. Optional.} - -\item{proj4string}{Projection string, see \code{\link[sp]{CRS-class}}. Used -if \code{y} is a \code{\link[base]{data.frame}}.} - -\item{conf.int}{Specifies the confidence level (0-1).} - -\item{rm.nosample}{If sum of columns and sum of rows of the error matrix are zero -then remove class. Default is TRUE.} - -\item{start_date}{A date. Required if there is only one map to be assessed. Usually this is the -first date of the timeline from satellite images.} - -\item{area}{A numeric vector with the area for each class if the argument \code{object} -is an error matrix (confusion matrix). If \code{object} is \code{\link[dtwSat]{twdtwMatches}} -area can be either a vector with the area of each classified object, or a single number -if the objects are single pixels.} -} -\description{ -Performs an accuracy assessment -of the classified maps. The function returns Overall Accuracy, -User's Accuracy, Produce's Accuracy, error matrix (confusion matrix), -and estimated area according to \insertCite{Olofsson:2013,Olofsson:2014;textual}{dtwSat}. -The function returns the metrics for each time interval and a summary considering all -classified intervals. -} -\examples{ -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - - -# Total mapped area by class. Data from [1] -area = c(A = 22353, B = 1122543, C = 610228) - -# Error matrix, columns (Reference) rows (Map) -x = - rbind( - c( 97, 0, 3), - c( 3, 279, 18), - c( 2, 1, 97) - ) - -table_assess = twdtwAssess(x, area, conf.int = .95) - -table_assess - -plot(table_assess, type="area", perc=FALSE) - -plot(table_assess, type="accuracy") - -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -} -\references{ -\insertAllCited{} - - \insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwClassify}}, -\code{\link[dtwSat]{twdtwAssessment}}, and -\code{\link[dtwSat]{twdtwXtable}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwAssessment-class.Rd b/man/twdtwAssessment-class.Rd deleted file mode 100644 index a79d971..0000000 --- a/man/twdtwAssessment-class.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-twdtwAssessment.R, R/methods.R -\name{twdtwAssessment-class} -\alias{twdtwAssessment-class} -\alias{twdtwAssessment} -\alias{show,twdtwAssessment-method} -\title{class "twdtwAssessment"} -\usage{ -\S4method{show}{twdtwAssessment}(object) -} -\arguments{ -\item{object}{an object of class twdtwAssessment.} -} -\description{ -This class stores the map assessment metrics. -} -\details{ -If the twdtwRaster is unprojected (longitude/latitude) the estimated area is the sum of the approximate -surface area in km2 of each cell (pixel). If the twdtwRaster is projected the estimated area is calculated -using the the pixel resolution in the map unit. -} -\section{Slots }{ - -\describe{ - \item{\code{accuracySummary}:}{Overall Accuracy, User's Accuracy, Producer's Accuracy, - Error Matrix (confusion matrix), and Estimated Area, considering all time periods.} - \item{\code{accuracyByPeriod}:}{Overall Accuracy, User's Accuracy, Producer's Accuracy, - Error Matrix (confusion matrix), and Estimated Area, for each time periods independently - from each other.} - \item{\code{data}:}{A \code{\link[sp]{SpatialPointsDataFrame}} with sample ID, period, - date from, date to, reference labels, predicted labels, and TWDTW distance.} - \item{\code{map}:}{A \code{\link[dtwSat]{twdtwRaster}} with the raster maps.} -} -} - -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwClassify}}, -\code{\link[dtwSat]{twdtwAssess}}, and -\code{\link[dtwSat]{twdtwXtable}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwClassify.Rd b/man/twdtwClassify.Rd deleted file mode 100644 index 3db968a..0000000 --- a/man/twdtwClassify.Rd +++ /dev/null @@ -1,576 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/twdtwClassify.R -\name{twdtwClassify} -\alias{twdtwClassify} -\alias{twdtwClassify,data.frame-method} -\alias{twdtwClassify-data.frame} -\alias{twdtwClassify,list-method} -\alias{twdtwClassify-list} -\alias{twdtwClassify,twdtwTimeSeries-method} -\alias{twdtwClassify-twdtwTimeSeries} -\alias{twdtwClassify,twdtwMatches-method} -\alias{twdtwClassify,twdtwRaster-method} -\alias{twdtwClassify-twdtwRaster} -\title{Classify time series} -\usage{ -twdtwClassify(x, ...) - -\S4method{twdtwClassify}{data.frame}( - x, - y, - step.matrix = symmetric1, - breaks = NULL, - from = NULL, - to = NULL, - by = NULL, - overlap = 0.5, - fill = length(y), - alpha = -0.1, - beta = 50, - time.window = FALSE, - keep = FALSE, - ... -) - -\S4method{twdtwClassify}{list}( - x, - y, - step.matrix = symmetric1, - breaks = NULL, - from = NULL, - to = NULL, - by = NULL, - overlap = 0.5, - fill = length(y), - alpha = -0.1, - beta = 50, - time.window = FALSE, - keep = FALSE, - ... -) - -\S4method{twdtwClassify}{twdtwTimeSeries}( - x, - patterns.labels = NULL, - from = NULL, - to = NULL, - by = NULL, - breaks = NULL, - overlap = 0.5, - thresholds = Inf, - fill = "unclassified", - ... -) - -\S4method{twdtwClassify}{twdtwMatches}( - x, - patterns.labels = NULL, - from = NULL, - to = NULL, - by = NULL, - breaks = NULL, - overlap = 0.5, - thresholds = Inf, - fill = "unclassified" -) - -\S4method{twdtwClassify}{twdtwRaster}( - x, - patterns.labels = NULL, - thresholds = Inf, - fill = 255, - filepath = "", - ... -) -} -\arguments{ -\item{x}{An object of class twdtw*. This is the target time series. -Usually, it is a set of unclassified time series.} - -\item{...}{Arguments to pass to specific methods for each twdtw* class -and other arguments to pass to \code{\link[raster]{writeRaster}} and -\code{\link[raster]{pbCreate}}. If \code{x} of -\code{\link[dtwSat]{twdtwTimeSeries-class}} additional arguments passed to -\code{\link[dtwSat]{twdtwApply}}.} - -\item{y}{a list of data.frame objects similar to \code{x}. -The temporal patterns used to classify the time series in \code{x}.} - -\item{step.matrix}{See \code{\link[dtw]{stepPattern}} in package \pkg{dtw} -\insertCite{Giorgino:2009}{dtwSat}.} - -\item{breaks}{A vector of class \code{\link[base]{Dates}}. This replaces the arguments \code{from}, -\code{to}, and \code{by}.} - -\item{from}{A character or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd".} - -\item{to}{A \code{\link[base]{character}} or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd".} - -\item{by}{A \code{\link[base]{character}} with the interval size, \emph{e.g.} "6 month".} - -\item{overlap}{A number between 0 and 1. The minimum overlapping -between one match and the interval of classification. Default is 0.5, -\emph{i.e.} an overlap minimum of 50\%.} - -\item{fill}{A character to fill the classification gaps. -For signature \code{twdtwTimeSeries} the default is \code{fill="unclassified"}, -for signature \code{twdtwRaster} the default is \code{fill="unclassified"}.} - -\item{alpha}{Numeric. The steepness of TWDTW logistic weight.} - -\item{beta}{Numeric. The midpoint of TWDTW logistic weight.} - -\item{time.window}{logical. TRUE will constrain the TWDTW computation to the -value of the parameter \code{beta} defined in the logistic weight function. -Default is FALSE.} - -\item{keep}{Preserves the cost matrix, inputs, and other internal structures. -Default is FALSE. For plot methods use \code{keep=TRUE}.} - -\item{patterns.labels}{a vector with labels of the patterns.} - -\item{thresholds}{A numeric vector the same length as \code{patterns.labels}. -The TWDTW dissimilarity thresholds, i.e. the maximum TWDTW cost for consideration -in the classification. Default is \code{Inf} for all \code{patterns.labels}.} - -\item{filepath}{A character. The path at which to save the raster with results. -If not provided the function saves in the same directory as the input time series raster.} -} -\value{ -An object of class twdtw*. -} -\description{ -This function classifies the intervals of a time series -based on the TWDTW results. -} -\examples{ -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -\dontrun{ - -# Example of TWDTW analysis using raster files -library(dtwSat) -library(caret) - -# Load raster data -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -timeline <- - scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") - -# Create raster time series -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Load field samples and projection -field_samples <- - read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -proj_str <- - scan(system.file("lucc_MT/data/samples_projection", package = "dtwSat"), - what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -set.seed(1) -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples <- field_samples[I, ] -validation_samples <- field_samples[-I, ] - -# Get time series form raster -training_ts <- getTimeSeries(rts, y = training_samples, proj4string = proj_str) -validation_ts <- getTimeSeries(rts, y = validation_samples, proj4string = proj_str) - -# Create temporal patterns -temporal_patterns <- createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Set TWDTW weight function -log_fun <- logisticWeight(-0.1, 50) - -# Run TWDTW analysis -system.time( - r_twdtw <- - twdtwApply(x = rts, y = temporal_patterns, weight.fun = log_fun, progress = 'text') -) - -# Plot TWDTW distances for the first year -plot(r_twdtw, type = "distance", time.levels = 1) - -# Classify raster based on the TWDTW analysis -r_lucc <- twdtwClassify(r_twdtw, progress = 'text') - -# Plot TWDTW classification results -plot(r_lucc, type = "map") - -# Assess classification -twdtw_assess <- - twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int = .95) - -# Plot map accuracy -plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty -plot(twdtw_assess, type = "area") - -# Plot misclassified samples -plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix -twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy -twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty -twdtwXtable(twdtw_assess, table.type = "area") - -} - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwTimeSeries-class}}, and -\code{\link[dtwSat]{twdtwRaster-class}}, -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwCrossValidate.Rd b/man/twdtwCrossValidate.Rd deleted file mode 100644 index 25024a3..0000000 --- a/man/twdtwCrossValidate.Rd +++ /dev/null @@ -1,81 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/twdtwCrossValidate.R -\name{twdtwCrossValidate} -\alias{twdtwCrossValidate} -\alias{twdtwCrossValidate,twdtwTimeSeries-method} -\alias{twdtwCrossValidate-twdtwTimeSeries} -\title{Cross Validate temporal patterns} -\usage{ -\S4method{twdtwCrossValidate}{twdtwTimeSeries}(object, times, p, ...) -} -\arguments{ -\item{object}{An object of class \code{\link[dtwSat]{twdtwTimeSeries}}.} - -\item{times}{Number of partitions to create.} - -\item{p}{The percentage of data that goes to training. -See \code{\link[caret]{createDataPartition}} for details.} - -\item{...}{Other arguments to be passed to \code{\link[dtwSat]{createPatterns}} and -to \code{\link[dtwSat]{twdtwApply}}.} -} -\description{ -Splits the set of time series into training and validation and -computes accuracy metrics. The function uses stratified sampling and a simple -random sampling for each stratum. For each data partition this function -performs a TWDTW analysis and returns the Overall Accuracy, User's Accuracy, -Produce's Accuracy, error matrix (confusion matrix), and a \code{\link[base]{data.frame}} -with the classification (Predicted), the reference classes (Reference), -and the results of the TWDTW analysis. -} -\examples{ -\dontrun{ -# Data folder -data_folder = system.file("lucc_MT/data", package = "dtwSat") - -# Read dates -dates = scan(paste(data_folder,"timeline", sep = "/"), what = "dates") - -# Read raster time series -evi = brick(paste(data_folder,"evi.tif", sep = "/")) -raster_timeseries = twdtwRaster(evi, timeline = dates) - -# Read field samples -field_samples = read.csv(paste(data_folder,"samples.csv", sep = "/")) -table(field_samples[["label"]]) - -# Read field samples projection -proj_str = scan(paste(data_folder,"samples_projection", sep = "/"), - what = "character") - -# Get sample time series from raster time series -field_samples_ts = getTimeSeries(raster_timeseries, - y = field_samples, proj4string = proj_str) -field_samples_ts - -# Run cross validation -set.seed(1) -# Define TWDTW weight function -log_fun = logisticWeight(alpha=-0.1, beta=50) -cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, - freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) -cross_validation - -summary(cross_validation) - -plot(cross_validation) - -twdtwXtable(cross_validation) - -twdtwXtable(cross_validation, show.overall=FALSE) - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwCrossValidation-class.Rd b/man/twdtwCrossValidation-class.Rd deleted file mode 100644 index f78ec53..0000000 --- a/man/twdtwCrossValidation-class.Rd +++ /dev/null @@ -1,85 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-crossValidation.R, R/methods.R -\name{twdtwCrossValidation-class} -\alias{twdtwCrossValidation-class} -\alias{twdtwCrossValidation} -\alias{show,twdtwCrossValidation-method} -\alias{summary,twdtwCrossValidation-method} -\title{class "twdtwCrossValidation"} -\usage{ -\S4method{show}{twdtwCrossValidation}(object) - -\S4method{summary}{twdtwCrossValidation}(object, conf.int = 0.95, ...) -} -\arguments{ -\item{object}{an object of class twdtwCrossValidation.} - -\item{conf.int}{specifies the confidence level (0-1) for interval estimation of the -population mean. For more details see \code{\link[ggplot2]{mean_cl_boot}}.} - -\item{...}{Other arguments. Not used.} -} -\description{ -This class stores the results of the cross-validation. -} -\section{Slots }{ - -\describe{ - \item{\code{partitions}:}{A list with the indices of time series used for training.} - \item{\code{accuracy}:}{A list with the accuracy and other TWDTW information for each - data partitions.} -} -} - -\examples{ -\dontrun{ -# Data folder -data_folder = system.file("lucc_MT/data", package = "dtwSat") - -# Read dates -dates = scan(paste(data_folder,"timeline", sep = "/"), what = "dates") - -# Read raster time series -evi = brick(paste(data_folder,"evi.tif", sep = "/")) -raster_timeseries = twdtwRaster(evi, timeline = dates) - -# Read field samples -field_samples = read.csv(paste(data_folder,"samples.csv", sep = "/")) -table(field_samples[["label"]]) - -# Read field samples projection -proj_str = scan(paste(data_folder,"samples_projection", sep = "/"), - what = "character") - -# Get sample time series from raster time series -field_samples_ts = getTimeSeries(raster_timeseries, - y = field_samples, proj4string = proj_str) -field_samples_ts - -# Run cross validation -set.seed(1) -# Define TWDTW weight function -log_fun = logisticWeight(alpha=-0.1, beta=50) -cross_validation = twdtwCrossValidate(field_samples_ts, times=3, p=0.1, - freq = 8, formula = y ~ s(x, bs="cc"), weight.fun = log_fun) -cross_validation - -summary(cross_validation) - -plot(cross_validation) - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{createPatterns}}, and -\code{\link[dtwSat]{twdtwApply}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwMatches-class.Rd b/man/twdtwMatches-class.Rd deleted file mode 100644 index 7ad7654..0000000 --- a/man/twdtwMatches-class.Rd +++ /dev/null @@ -1,131 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-twdtwMatches.R, R/methods.R -\name{twdtwMatches-class} -\alias{twdtwMatches-class} -\alias{twdtwMatches} -\alias{twdtwMatches,ANY-method} -\alias{twdtwMatches-create} -\alias{index,twdtwMatches-method} -\alias{length,twdtwMatches-method} -\alias{as.list,twdtwMatches-method} -\alias{as.list,twdtwRaster-method} -\alias{[,twdtwMatches,ANY,ANY,ANY-method} -\alias{[[,twdtwMatches,numeric,ANY-method} -\alias{labels,twdtwMatches-method} -\alias{show,twdtwMatches-method} -\alias{is.twdtwMatches,ANY-method} -\alias{is.twdtwMatches} -\title{class "twdtwMatches"} -\usage{ -\S4method{twdtwMatches}{ANY}(timeseries = NULL, patterns = NULL, alignments = NULL) - -\S4method{index}{twdtwMatches}(x) - -\S4method{length}{twdtwMatches}(x) - -\S4method{as.list}{twdtwMatches}(x) - -\S4method{as.list}{twdtwRaster}(x) - -\S4method{[}{twdtwMatches,ANY,ANY,ANY}(x, i, j, drop = TRUE) - -\S4method{[[}{twdtwMatches,numeric,ANY}(x, i, j, drop = TRUE) - -\S4method{labels}{twdtwMatches}(object) - -\S4method{show}{twdtwMatches}(object) - -\S4method{is.twdtwMatches}{ANY}(x) -} -\arguments{ -\item{timeseries}{a \code{\link[dtwSat]{twdtwTimeSeries}} object.} - -\item{patterns}{a \code{\link[dtwSat]{twdtwTimeSeries}} object.} - -\item{alignments}{an object of class list with the TWDTW results with -the same length as \code{timeseries} or a list of twdtwMatches.} - -\item{x}{an object of class twdtwMatches.} - -\item{i}{indices of the time series.} - -\item{j}{indices of the pattern.} - -\item{drop}{if TRUE returns a data.frame, if FALSE returns a list. -Default is TRUE.} - -\item{object}{an object of class twdtwMatches.} - -\item{labels}{a vector with labels of the time series.} -} -\description{ -Class for Time-Weighted Dynamic Time Warping results. -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{twdtwMatches(ANY)}: Create object of class twdtwMatches. - -\item \code{is.twdtwMatches(ANY)}: Check if the object belongs to the class twdtwMatches. - -}} -\section{Slots }{ - -\describe{ - \item{\code{timeseries}:}{An object of class \code{\link[dtwSat]{twdtwTimeSeries-class}} with the satellite time series.} - \item{\code{pattern}:}{An object of class \code{\link[dtwSat]{twdtwTimeSeries-class}} with the temporal patterns.} - \item{\code{alignments}:}{A \code{\link[base]{list}} of TWDTW results with the same length as - the \code{timeseries}. Each element in this list has the following results for each temporal pattern - in \code{patterns}: - \cr\code{from}: a vector with the starting dates of each match in the format "YYYY-MM-DD", - \cr\code{to}: a vector with the ending dates of each match in the format "YYYY-MM-DD", - \cr\code{distance}: a vector with TWDTW dissimilarity measure, and - \cr\code{K}: the number of matches of the pattern. - } - \item{This list might have additional elements:}{ if \code{keep=TRUE} in the \code{twdtwApply} call - the list is extended to include internal structures used during the TWDTW computation: - \cr\code{costMatrix}: cumulative cost matrix, - \cr\code{directionMatrix}: directions of steps that would be taken from each element of matrix, - \cr\code{startingMatrix}: the starting points of each element of the matrix, - \cr\code{stepPattern}: \code{\link[dtw]{stepPattern}} used for the - computation, see package \code{\link[dtw]{dtw}}, - \cr\code{N}: the length of the \code{pattern}, - \cr\code{M}: the length of the time series \code{timeseries}, - \cr\code{timeWeight}: time weight matrix, - \cr\code{localMatrix}: local cost matrix, - \cr\code{matching}: A list whose elements have the matching points for - each match between pattern the time series, such that: - \cr--\code{index1}: a vector with matching points of the pattern, and - \cr--\code{index2}: a vector with matching points of the time series. - } -} -} - -\examples{ -ts = twdtwTimeSeries(timeseries=MOD13Q1.ts.list) -patterns = twdtwTimeSeries(timeseries=MOD13Q1.patterns.list) -matches = twdtwApply(x = ts, y = patterns, keep=TRUE, legacy=TRUE) -class(matches) -length(matches) -matches -# Creating objects of class twdtwMatches -ts = twdtwTimeSeries(MOD13Q1.ts.list) -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -mat = twdtwApply(ts, patt, weight.fun = logisticWeight(-0.1, 100), - keep=TRUE, legacy=TRUE) -mat = twdtwMatches(ts, patterns=patt, alignments=mat) -mat - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{twdtwTimeSeries-class}}, and -\code{\link[dtwSat]{twdtwRaster-class}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwRaster-class.Rd b/man/twdtwRaster-class.Rd deleted file mode 100644 index e1ab6a0..0000000 --- a/man/twdtwRaster-class.Rd +++ /dev/null @@ -1,203 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-twdtwRaster.R, R/methods.R -\name{twdtwRaster-class} -\alias{twdtwRaster-class} -\alias{twdtwRaster} -\alias{twdtwRaster,ANY-method} -\alias{twdtwRaster-create} -\alias{dim,twdtwRaster-method} -\alias{res,twdtwRaster-method} -\alias{extent,twdtwRaster-method} -\alias{writeRaster,twdtwRaster,ANY-method} -\alias{ncol,twdtwRaster-method} -\alias{nrow,twdtwRaster-method} -\alias{nlayers,twdtwRaster-method} -\alias{levels,twdtwRaster-method} -\alias{layers,twdtwRaster-method} -\alias{layers} -\alias{coverages,twdtwRaster-method} -\alias{coverages} -\alias{bands,twdtwRaster-method} -\alias{bands} -\alias{names,twdtwRaster-method} -\alias{index,twdtwRaster-method} -\alias{length,twdtwRaster-method} -\alias{[,twdtwRaster,ANY,ANY,ANY-method} -\alias{[[,twdtwRaster,ANY,ANY-method} -\alias{labels,twdtwRaster-method} -\alias{crop,twdtwRaster-method} -\alias{coordinates,twdtwRaster-method} -\alias{show,twdtwRaster-method} -\alias{is.twdtwRaster,ANY-method} -\alias{is.twdtwRaster} -\alias{projecttwdtwRaster,twdtwRaster-method} -\alias{projecttwdtwRaster} -\title{class "twdtwRaster"} -\usage{ -\S4method{twdtwRaster}{ANY}( - ..., - timeline, - doy = NULL, - layers = NULL, - labels = NULL, - levels = NULL, - filepath = NULL -) - -\S4method{dim}{twdtwRaster}(x) - -\S4method{res}{twdtwRaster}(x) - -\S4method{extent}{twdtwRaster}(x, y, ...) - -\S4method{writeRaster}{twdtwRaster,ANY}(x, filepath = ".", ...) - -\S4method{ncol}{twdtwRaster}(x) - -\S4method{nrow}{twdtwRaster}(x) - -\S4method{nlayers}{twdtwRaster}(x) - -\S4method{levels}{twdtwRaster}(x) - -\S4method{layers}{twdtwRaster}(x) - -\S4method{coverages}{twdtwRaster}(x) - -\S4method{bands}{twdtwRaster}(x) - -\S4method{names}{twdtwRaster}(x) - -\S4method{index}{twdtwRaster}(x) - -\S4method{length}{twdtwRaster}(x) - -\S4method{[}{twdtwRaster,ANY,ANY,ANY}(x, i) - -\S4method{[[}{twdtwRaster,ANY,ANY}(x, i) - -\S4method{labels}{twdtwRaster}(object) - -\S4method{crop}{twdtwRaster}(x, y, ...) - -\S4method{coordinates}{twdtwRaster}(obj, ...) - -\S4method{extent}{twdtwRaster}(x, y, ...) - -\S4method{show}{twdtwRaster}(object) - -\S4method{is.twdtwRaster}{ANY}(x) - -\S4method{projecttwdtwRaster}{twdtwRaster}(x, crs, ...) -} -\arguments{ -\item{...}{objects of class \code{\link[raster]{RasterBrick-class}} or -\code{\link[raster]{RasterStack-class}}.} - -\item{timeline}{a vector with the dates of the satellite images -in the format of "YYYY-MM-DD".} - -\item{doy}{A \code{\link[raster]{RasterBrick-class}} or -\code{\link[raster]{RasterStack-class}} with a sequence of days of the year for each pixel. -\code{doy} must have the same spatial and temporal extents as the Raster* objects passed to \code{...}. -If \code{doy} is not provided then at least one Raster* object must be passed through \code{...}.} - -\item{layers}{a vector with the names of the \code{Raster*} objects -passed to "\code{...}". If not provided the layers are set to the -names of objects in "\code{...}".} - -\item{labels}{a vector of class \code{\link[base]{character}} with -labels of the values in the Raster* objects. This is -useful for categorical Raster* values of land use classes.} - -\item{levels}{a vector of class \code{\link[base]{numeric}} with -levels of the values in the Raster* objects. This is -useful for categorical Raster* values of land use classes.} - -\item{filepath}{A character. The path to save the raster time series. If provided the -function saves a raster file for each Raster* object in the list, \emph{i.e} one file -for each time series. This way the function retrieves a list of -\code{\link[raster]{RasterBrick-class}}. It is useful when the time series are -originally stored in separated files. See details.} - -\item{x}{an object of class twdtwRaster.} - -\item{y}{Extent object, or any object from which an Extent object can be extracted.} - -\item{i}{indices of the time series.} - -\item{object}{an object of class twdtwRaster.} - -\item{obj}{object of class twdtwRaster.} - -\item{crs}{character or object of class 'CRS'. PROJ.4 description of -the coordinate reference system. For other arguments and more details see -\code{\link[raster]{projectRaster}}.} -} -\description{ -Class for set of satellite time series. -} -\details{ -The performance of the functions \code{\link[dtwSat]{twdtwApply}} and -\code{\link[dtwSat]{getTimeSeries}} is improved if the Raster* objects are connected -to files with the whole time series for each attribute. -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{twdtwRaster(ANY)}: Create object of class twdtwRaster. - -\item \code{is.twdtwRaster(ANY)}: Check if the object belongs to the class twdtwRaster. - -\item \code{projecttwdtwRaster(twdtwRaster)}: project twdtwRaster object. - -}} -\section{Slots }{ - -\describe{ - \item{\code{timeseries}:}{A list of multi-layer Raster* objects - with the satellite image time series.} - \item{\code{timeline}:}{A vector of class \code{\link[base]{date}} - with dates of the satellite images in \code{timeseries}.} - \item{\code{layers}:}{A vector of class \code{\link[base]{character}} - with the names of the Raster* objects.} - \item{\code{labels}:}{A vector of class \code{\link[base]{factor}} - with levels and labels of the values in the Raster* objects. This - is useful for categorical Raster* values of land use classes.} -} -} - -\examples{ -# Creating a new object of class twdtwTimeSeries -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = new("twdtwRaster", timeseries = evi, timeline = timeline) - -\dontrun{ -# Creating objects of class twdtwRaster -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -ts_evi = twdtwRaster(evi, timeline=timeline) - -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -rts = twdtwRaster(doy, evi, ndvi, blue, red, nir, mir, timeline = timeline) -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwApply}}, -\code{\link[dtwSat]{getTimeSeries}}, -\code{\link[dtwSat]{twdtwMatches-class}}, and -\code{\link[dtwSat]{twdtwTimeSeries-class}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwReduceTime.Rd b/man/twdtwReduceTime.Rd deleted file mode 100644 index 2f9a466..0000000 --- a/man/twdtwReduceTime.Rd +++ /dev/null @@ -1,108 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/twdtw_reduce_time.R -\name{twdtwReduceTime} -\alias{twdtwReduceTime} -\title{Faster version of TWDTW apply} -\usage{ -twdtwReduceTime( - x, - y, - alpha = -0.1, - beta = 50, - time.window = FALSE, - dist.method = "Euclidean", - step.matrix = symmetric1, - from = NULL, - to = NULL, - by = NULL, - breaks = NULL, - overlap = 0.5, - fill = length(y) + 1, - keep = FALSE, - ... -) -} -\arguments{ -\item{x}{a data.frame with the target time series. Usually, it is an -unclassified time series. It must contain two or more columns, one column -called \code{date} with dates in the format "YYYY-MM-DD". The other columns -can have any names (e.g., red, blue, nir, evi, ndvi) as long as they match -the column names in the temporal patterns \code{y}.} - -\item{y}{a list of data.frame objects similar to \code{x}. -The temporal patterns used to classify the time series in \code{x}.} - -\item{alpha}{Numeric. The steepness of TWDTW logistic weight.} - -\item{beta}{Numeric. The midpoint of TWDTW logistic weight.} - -\item{time.window}{logical. TRUE will constrain the TWDTW computation to the -value of the parameter \code{beta} defined in the logistic weight function. -Default is FALSE.} - -\item{dist.method}{A character. Method to derive the local cost matrix. -Default is ''Euclidean'' see \code{\link[proxy]{dist}} in package -\pkg{proxy}.} - -\item{step.matrix}{See \code{\link[dtw]{stepPattern}} in package \pkg{dtw} -\insertCite{Giorgino:2009}{dtwSat}.} - -\item{from}{A character or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd".} - -\item{to}{A \code{\link[base]{character}} or \code{\link[base]{Dates}} object in the format "yyyy-mm-dd".} - -\item{by}{A \code{\link[base]{character}} with the interval size, \emph{e.g.} "6 month".} - -\item{breaks}{A vector of class \code{\link[base]{Dates}}. This replaces the arguments \code{from}, -\code{to}, and \code{by}.} - -\item{overlap}{A number between 0 and 1. The minimum overlapping -between one match and the interval of classification. Default is 0.5, -\emph{i.e.} an overlap minimum of 50\%.} - -\item{fill}{An integer to fill the classification gaps.} - -\item{keep}{Preserves the cost matrix, inputs, and other internal structures. -Default is FALSE. For plot methods use \code{keep=TRUE}.} - -\item{...}{Arguments to pass to \code{\link[raster]{writeRaster}} and -\code{\link[raster]{pbCreate}}} -} -\description{ -This function is a faster implementation of -\link[dtwSat]{twdtwApply} that is in average 4x faster. The time weight function -is coded in Fortran. It does not keep any intermediate data. -It performs a multidimensional TWDTW analysis -\insertCite{Maus:2019}{dtwSat} and retrieves only the best matches between -the unclassified time series and the patterns for each defined time interval. -} -\examples{ -\dontrun{ - -library(dtwSat) -from = "2009-09-01" -to = "2017-09-01" -by = "12 month" - -# S4 objects for original implementation -tw_patt = readRDS(system.file("lucc_MT/patterns/patt.rds", package = "dtwSat")) -tw_ts = twdtwTimeSeries(MOD13Q1.ts) - -# Table from csv for faster version -mn_patt <- lapply(dir(system.file("lucc_MT/patterns", package = "dtwSat"), - pattern = ".csv$", full.names = TRUE), read.csv, stringsAsFactors = FALSE) -mn_ts <- read.csv(system.file("reduce_time/ts_MODIS13Q1.csv", package = "dtwSat"), - stringsAsFactors = FALSE) - -# Benchtmark -rbenchmark::benchmark( - legacy_twdtw = twdtwClassify(twdtwApply(x = tw_ts, y = tw_patt, weight.fun = log_fun), - from = from, to = to, by = by)[[1]], - fast_twdtw = twdtwReduceTime(x = mn_ts, y = mn_patt, rom = from, to = to, by = by) - ) -} - -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwTimeSeries-class.Rd b/man/twdtwTimeSeries-class.Rd deleted file mode 100644 index 2ce2304..0000000 --- a/man/twdtwTimeSeries-class.Rd +++ /dev/null @@ -1,127 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/class-twdtwTimeSeries.R, R/methods.R -\name{twdtwTimeSeries-class} -\alias{twdtwTimeSeries-class} -\alias{twdtwTimeSeries} -\alias{twdtwTimeSeries,ANY-method} -\alias{twdtwTimeSeries-create} -\alias{dim,twdtwTimeSeries-method} -\alias{index,twdtwTimeSeries-method} -\alias{nrow,twdtwTimeSeries-method} -\alias{ncol,twdtwTimeSeries-method} -\alias{length,twdtwTimeSeries-method} -\alias{as.list,twdtwTimeSeries-method} -\alias{as.data.frame,twdtwTimeSeries-method} -\alias{[,twdtwTimeSeries,ANY,ANY,ANY-method} -\alias{[[,twdtwTimeSeries,ANY,ANY-method} -\alias{labels,twdtwTimeSeries-method} -\alias{levels,twdtwTimeSeries-method} -\alias{show,twdtwTimeSeries-method} -\alias{as.twdtwTimeSeries,ANY-method} -\alias{as.twdtwTimeSeries} -\alias{is.twdtwTimeSeries,ANY-method} -\alias{is.twdtwTimeSeries} -\title{class "twdtwTimeSeries"} -\usage{ -\S4method{twdtwTimeSeries}{ANY}(..., labels = NULL) - -\S4method{dim}{twdtwTimeSeries}(x) - -\S4method{index}{twdtwTimeSeries}(x) - -\S4method{nrow}{twdtwTimeSeries}(x) - -\S4method{ncol}{twdtwTimeSeries}(x) - -\S4method{length}{twdtwTimeSeries}(x) - -\S4method{as.list}{twdtwTimeSeries}(x) - -\S4method{as.data.frame}{twdtwTimeSeries}(x) - -\S4method{[}{twdtwTimeSeries,ANY,ANY,ANY}(x, i) - -\S4method{[[}{twdtwTimeSeries,ANY,ANY}(x, i) - -\S4method{labels}{twdtwTimeSeries}(object) - -\S4method{levels}{twdtwTimeSeries}(x) - -\S4method{show}{twdtwTimeSeries}(object) - -\S4method{as.twdtwTimeSeries}{ANY}(x) - -\S4method{is.twdtwTimeSeries}{ANY}(x) -} -\arguments{ -\item{...}{\code{\link[dtwSat]{twdtwTimeSeries}} objects, -\code{\link[zoo]{zoo}} objects or a list of \code{\link[zoo]{zoo}} objects.} - -\item{labels}{a vector with labels of the time series.} - -\item{x}{an object of class twdtwTimeSeries.} - -\item{i}{indices of the time series.} - -\item{object}{an object of class twdtwTimeSeries.} -} -\description{ -Class for setting irregular time series. -} -\section{Methods (by generic)}{ -\itemize{ -\item \code{twdtwTimeSeries(ANY)}: Create object of class twdtwTimeSeries. - -\item \code{as.twdtwTimeSeries(ANY)}: convert list of data.frame to class twdtwTimeSeries. - -\item \code{is.twdtwTimeSeries(ANY)}: Check if the object belongs to the class twdtwTimeSeries. - -}} -\section{Slots }{ - -\describe{ - \item{\code{timeseries}:}{A list of \code{\link[zoo]{zoo}} objects.} - \item{\code{labels}:}{A vector of class \code{\link[base]{factor}} with time series labels.} -} -} - -\examples{ -# Creating a new object of class twdtwTimeSeries -ptt = new("twdtwTimeSeries", timeseries = MOD13Q1.patterns.list, - labels = names(MOD13Q1.patterns.list)) -class(ptt) -labels(ptt) -levels(ptt) -length(ptt) -nrow(ptt) -ncol(ptt) -dim(ptt) -# Creating objects of class twdtwTimeSeries from zoo objects -ts = twdtwTimeSeries(MOD13Q1.ts) -ts - -# Creating objects of class twdtwTimeSeries from list of zoo objects -patt = twdtwTimeSeries(MOD13Q1.patterns.list) -patt - -# Joining objects of class twdtwTimeSeries -tsA = twdtwTimeSeries(MOD13Q1.ts.list[[1]], labels = "A") -tsB = twdtwTimeSeries(B = MOD13Q1.ts.list[[2]]) -ts = twdtwTimeSeries(tsA, tsB, C=MOD13Q1.ts) -ts - -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwMatches-class}}, -\code{\link[dtwSat]{twdtwRaster-class}}, -\code{\link[dtwSat]{getTimeSeries}}, and -\code{\link[dtwSat]{twdtwApply}} -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/man/twdtwXtable.Rd b/man/twdtwXtable.Rd deleted file mode 100644 index 94b3c82..0000000 --- a/man/twdtwXtable.Rd +++ /dev/null @@ -1,139 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/twdtwXtable.R -\name{twdtwXtable} -\alias{twdtwXtable} -\alias{twdtwXtable,twdtwAssessment-method} -\alias{twdtwXtable-twdtwAssessment} -\alias{twdtwXtable,twdtwCrossValidation-method} -\alias{twdtwXtable-twdtwCrossValidation} -\title{LaTeX table from accuracy metrics} -\usage{ -\S4method{twdtwXtable}{twdtwAssessment}( - object, - table.type = "accuracy", - show.prop = TRUE, - category.name = NULL, - category.type = NULL, - rotate.col = FALSE, - time.labels = NULL, - caption = NULL, - digits = 2, - show.footnote = TRUE, - ... -) - -\S4method{twdtwXtable}{twdtwCrossValidation}( - object, - conf.int = 0.95, - show.overall = TRUE, - category.name = NULL, - category.type = NULL, - caption = NULL, - digits = 2, - show.footnote = TRUE, - ... -) -} -\arguments{ -\item{object}{an object of class twdtwAssessment.} - -\item{table.type}{Table type, 'accuracy' for User's and Producer's Accuracy, -'errormatrix' for error matrix, and 'area' for area and uncertainty. -Default is 'accuracy'.} - -\item{show.prop}{If TRUE shows the estimated proportion of area. -Used with \code{table.type='accuracy'}. Default is TRUE.} - -\item{category.name}{A character vector defining the class names. If NULL -the class names in the object \code{x} are used. Default is NULL.} - -\item{category.type}{A character defining the categories type "numeric" -or "letter", if NULL the class names are used. Default is NULL.} - -\item{rotate.col}{Rotate class column names in latex table. Default is FALSE.} - -\item{time.labels}{A character or numeric for the time period or NULL to -include all classified periods. Default is NULL.} - -\item{caption}{The table caption.} - -\item{digits}{Number of digits to show.} - -\item{show.footnote}{Show confidence interval in the footnote.} - -\item{...}{Other arguments to pass to \code{\link[xtable]{print.xtable}}.} - -\item{conf.int}{Specifies the confidence level (0-1).} - -\item{show.overall}{If TRUE shows the overall accuracy of the cross-validation. -Default is TRUE.} -} -\description{ -Creates LaTeX table from accuracy metrics -} -\examples{ -\dontrun{ - -# Create raster time series -evi = brick(system.file("lucc_MT/data/evi.tif", package="dtwSat")) -ndvi = brick(system.file("lucc_MT/data/ndvi.tif", package="dtwSat")) -red = brick(system.file("lucc_MT/data/red.tif", package="dtwSat")) -blue = brick(system.file("lucc_MT/data/blue.tif", package="dtwSat")) -nir = brick(system.file("lucc_MT/data/nir.tif", package="dtwSat")) -mir = brick(system.file("lucc_MT/data/mir.tif", package="dtwSat")) -doy = brick(system.file("lucc_MT/data/doy.tif", package="dtwSat")) -timeline = scan(system.file("lucc_MT/data/timeline", package="dtwSat"), what="date") -rts = twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) - -# Read field samples -field_samples = read.csv(system.file("lucc_MT/data/samples.csv", package="dtwSat")) -proj_str = scan(system.file("lucc_MT/data/samples_projection", - package="dtwSat"), what = "character") - -# Split samples for training (10\%) and validation (90\%) using stratified sampling -library(caret) -set.seed(1) -I = unlist(createDataPartition(field_samples$label, p = 0.1)) -training_samples = field_samples[I,] -validation_samples = field_samples[-I,] - -# Create temporal patterns -training_ts = getTimeSeries(rts, y = training_samples, proj4string = proj_str) -temporal_patterns = createPatterns(training_ts, freq = 8, formula = y ~ s(x)) - -# Run TWDTW analysis for raster time series -log_fun = weight.fun=logisticWeight(-0.1,50) -r_twdtw = twdtwApply(x=rts, y=temporal_patterns, weight.fun=log_fun, format="GTiff", - overwrite=TRUE) - -# Classify raster based on the TWDTW analysis -r_lucc = twdtwClassify(r_twdtw, format="GTiff", overwrite=TRUE) -plot(r_lucc) - -# Assess classification -twdtw_assess = twdtwAssess(object = r_lucc, y = validation_samples, - proj4string = proj_str, conf.int=.95) -twdtw_assess - -# Create latex tables -twdtwXtable(twdtw_assess, table.type="errormatrix", rotate.col=TRUE, - caption="Error matrix", digits=2, comment=FALSE) -twdtwXtable(twdtw_assess, table.type="accuracy", category.type="letter", - caption="Accuracy metrics.") -twdtwXtable(twdtw_assess, table.type="area", category.type="letter", - digits = 0, caption="Area and uncertainty") - -} -} -\references{ -\insertRef{Maus:2019}{dtwSat} - - \insertRef{Maus:2016}{dtwSat} -} -\seealso{ -\code{\link[dtwSat]{twdtwAssess}} and -\code{\link[dtwSat]{twdtwAssessment}}. -} -\author{ -Victor Maus, \email{vwmaus1@gmail.com} -} diff --git a/src/bestmatches.f b/src/bestmatches.f deleted file mode 100644 index 82642d1..0000000 --- a/src/bestmatches.f +++ /dev/null @@ -1,80 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C (c) Victor Maus C -C Institute for Geoinformatics (IFGI) C -C University of Muenster (WWU), Germany C -C C -C Earth System Science Center (CCST) C -C National Institute for Space Research (INPE), Brazil C -C C -C C -C Find best matches TWDTW - 2016-03-26 C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C XM - Two columns matrix with 'from' and 'to' dates as integers -C AM - Matrix (P-1 x L) with classification intervals (P-1) and possible classes (L) -C DM - Vector length K DTW distance for each alignment -C DP - Vector length P-1 with classification intervals -C X - Vector length K with alignments index -C IM - Matrix to return best matches, intervals, and class labels -C A - Vector with alignment index -C K - Number of alignments -C P - Number of dates defineing classification intervals -C L - Number of classes -C OV - Minimum temporal overlap - SUBROUTINE bestmatches(XM,AM,DM,DP,X,IM,DB,A,K,P,L,OV) -C I/O Variables - INTEGER K, P, L, XM(K,2), X(K), DP(P), IM(P-1,4), A(K) - DOUBLE PRECISION AM(P-1,L), DD, DM(K), OV, DB(P-1) -C Internals - DOUBLE PRECISION R - INTEGER I, J, IL, B1, B2, D1, D2 -C For all time intervals - DO 30 J = 1, P-1 - B1 = DP(J) - B2 = DP(J+1) - DD = AM(J,1) - -C For all TWDTW matches - DO 20 I = 1, K -C print *, "I: ", I - D1 = XM(I,1) - D2 = XM(I,2) - IL = X(I) - IF ((D2.LT.B1).OR.(D1.GT.B2)) THEN -C print *, "D1: ", D1, "D2: ", D2 - GOTO 20 - ENDIF - IF (D1.LT.B1) THEN - D1 = B1 - ENDIF - IF (B2.LT.D2) THEN - D2 = B2 - ENDIF - R = REAL(D2 - D1) / REAL(B2 - B1) - IF( .NOT.(OV.LE.R.AND.R.LE.(2-OV)) ) THEN -C print *, "R: ", R - GOTO 20 - ENDIF - IF( DM(I).GE.AM(J,IL) ) THEN -C print *, "DM(I): ", DM(I) - GOTO 20 - ENDIF - AM(J,IL) = DM(I) - IF( DM(I).LT.DD ) THEN - DD = DM(I) - IM(J,1) = IL - IM(J,2) = I - IM(J,3) = A(I) -C print *, "IM: ", IM - DB(J) = DD - ENDIF - 20 CONTINUE - 30 CONTINUE - END - - - - - diff --git a/src/computecost.f b/src/computecost.f deleted file mode 100644 index 962fd89..0000000 --- a/src/computecost.f +++ /dev/null @@ -1,89 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C (c) Victor Maus C -C Institute for Geoinformatics (IFGI) C -C University of Muenster (WWU), Germany C -C C -C Earth System Science Center (CCST) C -C National Institute for Space Research (INPE), Brazil C -C C -C C -C Efficient computation of DTW cost matrix - 2015-10-16 C -C C -C This function was adpted from the C function 'computeCM' C -C implemented in the R package 'dtw' by Toni Giorgino. C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C CM - Input local cost and output cumulative cost matrix -C DM - Direction matrix -C VM - Starting points matrix -C SM - Matrix of step patterns -C N - Number of rows in CM, DM, and VM -C M - Number of columns CM, DM, and VM -C NS - Number of rows in SM - SUBROUTINE computecost(CM, DM, VM, SM, N, M, NS) -C 800 FORMAT(I4,I4,I4,I4,F8.0,F8.0) -C I/O Variables - INTEGER N, M, NS, SM(NS,4), DM(N,M), VM(N,M) - DOUBLE PRECISION CM(N,M) -C Internals - DOUBLE PRECISION W, CP(NS), VMIN - INTEGER I, J, IL(NS), JL(NS), K, PK, KMIN, ZERO, ONE - PARAMETER(ZERO=0,ONE=1) - REAL NAN, INF - NAN = ZERO - NAN = NAN / NAN - INF = HUGE(ZERO) - VM(1,1) = 1 -C Initialize the firt row and col of the matrices - DO 21 I = 2, N - CM(I,1) = CM(I-1,1) + CM(I,1) - DM(I,1) = 3 - VM(I,1) = 1 - 21 CONTINUE - DO 31 J = 2, M - CM(1,J) = CM(1,J-1) + CM(1,J) - DM(1,J) = 2 - VM(1,J) = J - 31 CONTINUE -C Compute cumulative cost matrix - DO 32 J = 2, M - DO 22 I = 2, N -C Initialize list of step cost - DO 10 K = 1, NS - CP(K) = NAN - 10 CONTINUE - DO 11 K = 1, NS - PK = SM(K,1) - IL(K) = I - SM(K,2) - JL(K) = J - SM(K,3) - IF ((IL(K).GT.ZERO).AND.(JL(K).GT.ZERO)) THEN - W = SM(K,4) - IF (W.EQ.-ONE) THEN - CP(PK) = CM(IL(K),JL(K)) - ELSE - CP(PK) = CP(PK) + CM(IL(K),JL(K))*W - ENDIF - ENDIF - 11 CONTINUE - KMIN = -ONE - VMIN = INF - ILMIN = -ONE - JLMIN = -ONE - DO 12 K = 1, NS - PK = SM(K,1) - IF (CP(PK).EQ.CP(PK).AND.CP(PK).LT.VMIN) THEN - KMIN = PK - VMIN = CP(PK) - ILMIN = IL(K) - JLMIN = JL(K) - ENDIF - 12 CONTINUE - IF (KMIN.GT.-ONE) THEN - CM(I,J) = VMIN - DM(I,J) = KMIN - VM(I,J) = VM(ILMIN, JLMIN) - ENDIF - 22 CONTINUE - 32 CONTINUE - END diff --git a/src/ellapsed.f b/src/ellapsed.f deleted file mode 100644 index a854ad0..0000000 --- a/src/ellapsed.f +++ /dev/null @@ -1,17 +0,0 @@ -C Computation ellapsed time in days -C -C TD - time difference in days - SUBROUTINE ellapsed(TD) - DOUBLE PRECISION TD, HPC - PARAMETER(PC=366.0) - HPC = PC/2 -C Compute ellapsed time difference - TD = SQRT(TD * TD) -C Correct ellapsed time with year cycle - IF (TD.GT.HPC) THEN - TD = PC - TD - ENDIF - TD = ABS(TD) - RETURN - END - diff --git a/src/g.f b/src/g.f deleted file mode 100644 index 8406ffc..0000000 --- a/src/g.f +++ /dev/null @@ -1,37 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C (c) Victor Maus C -C Institute for Geoinformatics (IFGI) C -C University of Muenster (WWU), Germany C -C C -C Earth System Science Center (CCST) C -C National Institute for Space Research (INPE), Brazil C -C C -C C -C Computation allapsed time - 2016-01-22 C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C TM - Time difference matrix -C N - Number of rows in CM -C M - Number of columns CM -C PC - Cycle length in the unity of the measurements - SUBROUTINE g(TM, N, M, PC) -C I/O Variables - INTEGER N, M - DOUBLE PRECISION TM(N,M), PC -C Internals - DOUBLE PRECISION HPC - INTEGER I, J - PARAMETER(TWO=2.0) - HPC = PC/2 -C Compute ellapsed time matrix - DO 30 J = 1, M - DO 20 I = 1, N - IF (TM(I,J).GT.HPC) THEN - TM(I,J) = ABS(PC - TM(I,J)) - ENDIF - 20 CONTINUE - 30 CONTINUE - END - \ No newline at end of file diff --git a/src/init.c b/src/init.c deleted file mode 100644 index de747f3..0000000 --- a/src/init.c +++ /dev/null @@ -1,33 +0,0 @@ -#include -#include // for NULL -#include - - -/* FIXME: - Check these declarations against the C/Fortran source code. - */ - -/* .Fortran calls */ -extern void F77_NAME(bestmatches)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); -extern void F77_NAME(computecost)(void *, void *, void *, void *, void *, void *, void *); -extern void F77_NAME(twdtw)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); -extern void F77_NAME(g)(void *, void *, void *, void *); -extern void F77_NAME(tracepath)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); - -static const R_FortranMethodDef FortranEntries[] = { - {"bestmatches", (DL_FUNC) &F77_NAME(bestmatches), 12}, - {"computecost", (DL_FUNC) &F77_NAME(computecost), 7}, - {"twdtw", (DL_FUNC) &F77_NAME(twdtw), 13}, - {"g", (DL_FUNC) &F77_NAME(g), 4}, - {"tracepath", (DL_FUNC) &F77_NAME(tracepath), 11}, - {NULL, NULL, 0} -}; - -void R_init_dtwSat(DllInfo *dll) -{ - R_registerRoutines(dll, NULL, NULL, FortranEntries, NULL); - R_useDynamicSymbols(dll, FALSE); - R_forceSymbols(dll, FALSE); -} - - diff --git a/src/logtwdtw.f b/src/logtwdtw.f deleted file mode 100644 index a8d0480..0000000 --- a/src/logtwdtw.f +++ /dev/null @@ -1,31 +0,0 @@ -C Compute TWDTW distance using logistic weight -C -C XM - matrix with the time series (N,D) -C YM - matrix with the temporal profile (M,D) -C N - Number of rows in CM, DM, and VM - time series -C M - Number of columns CM, DM, and VM - temporal profile -C D - Number of spectral dimensions including time in XM and YM -C I - Single point in the time series to calculate the local distance -C J - Single point in the temporal profile to calculate the local distance -C A - Time-Weight parameter alpha -C B - Time-Weight parameter beta - REAL FUNCTION distance(YM, XM, N, M, D, I, J, TW, TD) - INTEGER N, M, D, I, J, K - DOUBLE PRECISION XM(M,D), YM(N,D), TD, BD, CD, TW(2) - PARAMETER(ZERO=0) - REAL NAN - NAN = ZERO - NAN = NAN / NAN - distance = NAN -C TD = YM(I,1) - XM(J,1) -C CALL ellapsed(TD) - CD = ZERO - DO 30 K = 2, D - BD = YM(I,K) - XM(J,K) - CD = CD + (BD * BD) - 30 CONTINUE -C WRITE (*,*) 'The value of X J', J, 'is', XM(J,D) - distance = SQRT(CD) + 1.0 / (1.0 + EXP(TW(1) * (TD - TW(2)))) - RETURN - END - diff --git a/src/tracepath.f b/src/tracepath.f deleted file mode 100644 index 6431f0b..0000000 --- a/src/tracepath.f +++ /dev/null @@ -1,77 +0,0 @@ -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C C -C (c) Victor Maus C -C Institute for Geoinformatics (IFGI) C -C University of Muenster (WWU), Germany C -C C -C Earth System Science Center (CCST) C -C National Institute for Space Research (INPE), Brazil C -C C -C C -C Efficient computation of DTW trace back - 2015-10-17 C -C C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C DM - Direction matrix -C SM - Matrix of step patterns -C JMIN - Positions o the minimum points -C IND1 - Alignment indices in the pattern -C IND2 - Alignment indices in the template -C POS - Starting points in IND1 and IND2 -C N - Number of rows in DM -C M - Number of columns DM -C NS - Number of rows in SM -C NJ - Number of minimum points -C AL - Length of IND1 and IND2 - SUBROUTINE tracepath(DM,SM,JMIN,IND1,IND2,POS,N,M,NS,NJ,AL) -C 800 FORMAT(I4,I4,I4,I4,I4,I4,I4,I4) -C I/O Variables - INTEGER N, M, NS, NJ, AL - INTEGER IND1(AL),IND2(AL),POS(NJ+1),SM(NS,4),DM(N,M),JMIN(NJ) -C Internals - INTEGER K, PK, I, J, P, PI, PJ, S, IS(NS), STEPS(NS,4*NS) - INTEGER ZERO, ONE - PARAMETER(ZERO=0,ONE=1) -C Initialize steps - DO 10 PK = 1, SM(NS,1) - STEPS(PK,1) = ZERO - IS(PK) = 2 - 10 CONTINUE -C Get steps direction - DO 11 K = 1, NS - PK = SM(K,1) - PI = SM(K,2) - PJ = SM(K,3) - IF (PI.EQ.ZERO.AND.PJ.EQ.ZERO) THEN - GO TO 11 - ENDIF - STEPS(PK,1) = STEPS(PK,1) + ONE - STEPS(PK,IS(PK)) = PI - STEPS(PK,IS(PK)+1) = PJ - IS(PK) = IS(PK) + 2 - 11 CONTINUE -C Trace back - P = ONE - POS(1) = ZERO - DO 30 JM = 1, NJ - I = N - J = JMIN(JM) - S = DM(I,J) - 20 IF (I.NE.ONE.AND.P.LT.AL) THEN - IND1(P) = I - IND2(P) = J - NS = STEPS(S,1) - DO 12 K = 1, NS - P = P + 1 - IND1(P) = I - STEPS(S,2*K) - IND2(P) = J - STEPS(S,2*K+1) - I = IND1(P) - J = IND2(P) - 12 CONTINUE - S = DM(I,J) - GO TO 20 - ENDIF - POS(JM+1) = P - P = P + 1 - 30 CONTINUE - END diff --git a/src/twdtw.f b/src/twdtw.f deleted file mode 100644 index df96fe8..0000000 --- a/src/twdtw.f +++ /dev/null @@ -1,157 +0,0 @@ -C Computation of TWDTW cost matrix -C -C XM - matrix with the time series (N,D) -C YM - matrix with the temporal profile (M,D) -C CM - Output cumulative cost matrix -C DM - Direction matrix -C VM - Starting points matrix -C SM - Matrix of step patterns -C N - Number of rows in CM, DM, and VM - time series -C M - Number of columns CM, DM, and VM - temporal profile -C D - Number of spectral dimensions including time in XM and YM -C NS - Number of rows in SM -C TW - Time-Weight parameters alpha and beta -C LB - Constrain TWDTW calculation to band given by TW(2) - SUBROUTINE twdtw(XM, YM, CM, DM, VM, SM, N, M, D, NS, TW, LB, JB) -C I/O Variables - INTEGER N, M, D, NS, SM(NS,4), DM(N+1,M), VM(N+1,M), JB(N) - DOUBLE PRECISION XM(M,D), YM(N,D), CM(N+1,M), TW(2) - LOGICAL LB -C Internals - DOUBLE PRECISION W, CP(NS), VMIN, A, B, TD - INTEGER I, J, IL(NS), JL(NS), K, PK, KMIN, ZERO, ONE, JM - PARAMETER(ZERO=0,ONE=1) - DOUBLE PRECISION NAN, INF - NAN = 0.0 - NAN = NAN / NAN - INF = HUGE(0.0) - IML = 1 - VM(1,1) = 1 - -C Initialize the firt row and col of the matrices - DO 21 I = 2, N+1 - TD = YM(I-1,1) - XM(1,1) - CALL ellapsed(TD) -C IF (TD.GT.TW(2)) THEN -C CM(I,1) = INF -C ELSE - CM(I,1) = CM(I-1,1) + - & distance(YM, XM, N, M, D, I-1, 1, TW, TD) -C ENDIF -C WRITE (*,*) 'The distance ',I,',1 is ', CM(I,1) - DM(I,1) = 3 - VM(I,1) = 1 - 21 CONTINUE - DO 31 J = 2, M - TD = YM(2,1) - XM(J,1) - CALL ellapsed(TD) -C IF (TD.GT.TW(2)) THEN -C CM(2,J) = INF -C ELSE - CM(2,J) = CM(2,J-1) + - & distance(YM, XM, N, M, D, 1, J, TW, TD) -C ENDIF -C WRITE (*,*) 'The distance 2,',J,' is ', CM(2,J) - DM(1,J) = 2 - VM(1,J) = J - 31 CONTINUE -C Compute cumulative cost matrix - J = 2 - DO 32 WHILE ( J .LE. M ) - I = 2 - DO 22 WHILE ( I .LE. N+1 ) -C PRINT *, "J: ", J, "I: ", I -C Calculate local distance -C # the call takes I-1 because local matrix has an additional row at the begning - TD = YM(I-1,1) - XM(J,1) - CALL ellapsed(TD) - IF (LB.AND.(TD.GT.TW(2))) THEN -C print *, "I: ", I, "TD: ", TD, " -- TW: ", TW(2) - CM(I,J) = INF - DM(I,J) = -ONE - VM(I,J) = ZERO - GOTO 44 - ELSE - CM(I,J) = distance(YM, XM, N, M, D, I-1, J, TW, TD) - ENDIF -C Initialize list of step cost - DO 10 K = 1, NS - CP(K) = NAN - 10 CONTINUE - DO 11 K = 1, NS - PK = SM(K,1) - IL(K) = I - SM(K,2) - JL(K) = J - SM(K,3) - IF ((IL(K).GT.ZERO).AND.(JL(K).GT.ZERO)) THEN - W = SM(K,4) - IF (W.EQ.-ONE) THEN - CP(PK) = CM(IL(K),JL(K)) - ELSE - CP(PK) = CP(PK) + CM(IL(K),JL(K))*W - ENDIF - ENDIF - 11 CONTINUE - KMIN = -ONE - VMIN = INF - ILMIN = -ONE - JLMIN = -ONE - DO 12 K = 1, NS - PK = SM(K,1) - IF (CP(PK).EQ.CP(PK).AND.CP(PK).LT.VMIN) THEN - KMIN = PK - VMIN = CP(PK) - ILMIN = IL(K) - JLMIN = JL(K) - ENDIF - 12 CONTINUE - IF (KMIN.GT.-ONE) THEN - CM(I,J) = VMIN - DM(I,J) = KMIN - VM(I,J) = VM(ILMIN, JLMIN) - ENDIF - 44 CONTINUE - I = I + 1 - 22 CONTINUE - J = J + 1 - 32 CONTINUE - 99 CONTINUE - J = 1 - K = ZERO -C PRINT *, "DONE: LOOP 1" - DO 69 WHILE ( J .LE. M ) - IF (VM(N+1,J).NE.ZERO) THEN - IF (K.EQ.ZERO) THEN - K = 1 - JB(K) = J - JM = VM(N+1,J) - GOTO 68 - ENDIF - IF (VM(N+1,J).NE.JM) THEN - K = K + 1 - JB(K) = J - JM = VM(N+1,J) - GOTO 68 - ENDIF -C PRINT *, J, "JB:",JB(k),"-", CM(N+1,J),"-",CM(N+1,JB(K)) - IF (CM(N+1,J).LT.CM(N+1,JB(K))) THEN - JB(K) = J - GOTO 68 - ENDIF - ENDIF - 68 CONTINUE - J = J + 1 - 69 CONTINUE -C PRINT *, "XM", XM -C PRINT *, "YM", YM -C PRINT *, "CM", CM -C PRINT *, "DM", DM -C PRINT *, "VM", VM -C PRINT *, "SM", SM -C PRINT *, "N", N -C PRINT *, "M", M -C PRINT *, "D", D -C PRINT *, "NS", NS -C PRINT *, "TW", TW -C PRINT *, "LB", LB -C PRINT *, "JB", JB - END diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..38db019 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(dtwSat) + +test_check("dtwSat") diff --git a/tests/testthat/test-twdtw_classify.R b/tests/testthat/test-twdtw_classify.R new file mode 100644 index 0000000..f5c0c04 --- /dev/null +++ b/tests/testthat/test-twdtw_classify.R @@ -0,0 +1,27 @@ +library(stars) +library(stringr) + +# Read training samples +samples <- st_read(system.file("mato_grosso_brazil/samples.gpkg", package = "dtwSat")) + +# Satellite image time sereis files +tif_files <- system.file("mato_grosso_brazil", package = "dtwSat") |> + dir(pattern = "\\.tif$", full.names = TRUE) + +# The acquisition date is in the file name are not the true acquisition date of each pixel +# MOD13Q1 is a 16-day composite product, so the acquisition date is the first day of the 16-day period +acquisition_date <- as.Date(str_extract(tif_files, "[0-9]{8}"), format = "%Y%m%d") + +# Read the data as a stars object, setting time as a dimension and band as attribute +dc <- read_stars(tif_files, proxy = FALSE, along = list(time = acquisition_date)) |> + st_set_dimensions(3, c("EVI", "NDVI", "RED", "BLUE", "NIR", "MIR", "DOY")) |> + split("band") + +# Remove the DOY band - this will be supported int the future +dc <- dc[c("EVI", "NDVI", "RED", "BLUE", "NIR", "MIR")] + +# Get temporal patters +ts_patterns <- create_patterns(x = dc, y = samples) + +# Visualize patterns +plot_patterns(ts_patterns) diff --git a/tic.R b/tic.R deleted file mode 100644 index ec2f06f..0000000 --- a/tic.R +++ /dev/null @@ -1 +0,0 @@ -add_package_checks() diff --git a/vignettes/twdtw01.Rmd b/vignettes/twdtw01.Rmd deleted file mode 100644 index 23af762..0000000 --- a/vignettes/twdtw01.Rmd +++ /dev/null @@ -1,109 +0,0 @@ ---- -title: "1. TWDTW: Time-Weighted Dynamic Time Warping" -author: "Victor Maus" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{1. TWDTW: Time-Weighted Dynamic Time Warping} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -bibliography: ./../inst/REFERENCES.bib ---- - -```{r, echo=FALSE, include=FALSE} -knitr::opts_chunk$set(collapse = TRUE) -knitr::opts_chunk$set(fig.height = 4.5) -knitr::opts_chunk$set(fig.width = 6) -``` - -This vignette present a short introduction on Time-Weighted Dynamic Time Warping (TWDTW) analysis using `dtwSat`. TWDTW is an algorithm for land cover mapping using multi-band satellite image time series. The algorithm is particularly valuable to produce land cover maps in regions with scarcity of training data. For details see @Maus:2016 and @Maus:2019. - -# Satellite images time series - -Continuous Earth observation measurements produce sequences of multi-temporal images--satellite images time series. TWDTW algorithm can extract information from satellite images time series, in particular about vegetation with annual phenological cycle. - -An example of phenological cycles is available in `dtwSat` as `MOD13Q1.MT.yearly.patterns`, which includes temporal profiles of vegetation in the Brazilian Amazon extracted from `MOD13Q1` time series. You can load and visualize these profiles in your R session using -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -library(dtwSat) - -veg_profiles <- twdtwTimeSeries(MOD13Q1.MT.yearly.patterns) - -veg_profiles - -class(veg_profiles) - -plot(veg_profiles, type = "patterns") -``` - -We can refer to the above profiles as the library of known vegetation phenological cycles in the study area. For this area study area `dtwSat` also provides some examples of time series, which you can load by running -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -veg_ts <- twdtwTimeSeries(MOD13Q1.ts) - -veg_ts - -class(veg_ts) - -plot(veg_ts, type = "timeseries") -``` - -# TWDTW analysis - -Comparing the above time series to the profiles library, which is the sequence of vegetation types in the above time series? To answered this question we can run a TWDTW analysis and compare the above time series to the profiles library, such that -```{r echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -# Define logistic time-weight, see Maus et al. (2016) -weight_fun <- logisticWeight(alpha = -0.1, beta = 50) - -# Run TWDTW analysis -twdtw_matches <- twdtwApply(x = veg_ts, - y = veg_profiles, - weight.fun = weight_fun, - keep = TRUE, legacy=TRUE) - -class(twdtw_matches) - -twdtw_matches -``` - -TWDTW analysis has found `r length(twdtw_matches)` alignments, i.e. `r length(twdtw_matches)` alignments between the profiles in the library and shorter segments of the time series. Each of these matches have an associated dissimilarity metric--the TWDTW distance. Using the code below we can visualize all matches with a TWDTW distance lower than `10.0`. -```{r, echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -plot(x = twdtw_matches, - type = "alignments", - threshold = 10.0) -``` - -Every segment in the figure shows one possible match between the profiles and the time series. The segments with lower TWDTW distance are more likely to be the correct classification for that specific segment. - -To further investigate the segments by looking at the matching points (observation) between a single pattern and the time series. In the code below we visualize the matching observations for the two best (lowest TWDTW distance) alignments of the `Soybean-cotton`. -```{r, echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -plot(x = twdtw_matches, - type = "matches", - attr = "evi", - patterns.labels = "Soybean-cotton", - k = 2) -``` - -We can also investigate the paths of minimum cost in the TWDTW cost matrix for each profile, for example for `Soybean-cotton` run -```{r, echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -plot(x = twdtw_matches, - type = "paths", - patterns.labels = "Soybean-cotton") -``` - -Finally we define sub-intervals of 12 months and classify each segment of the time series into one class in our profiles library, such that -```{r, echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -twdtw_classification <- twdtwClassify(x = twdtw_matches, - from = "2009-09-01", - to = "2014-08-31", - by = "12 month") - -twdtw_classification - -plot(twdtw_classification, type = "classification") -``` - -In this last chunk of code we answered our question. We can see that only the `r length(twdtw_classification)` best alignments over all land cover classes remained, i.e. the alignments with the lowest TWDTW distance per segment. - -This short introduction showed how to use `dtwSat` to analyse and classify a single time series. This is useful to better understand the method and adjust classification parameters. To learn how apply the method to a raster stack please red the next vignette. - -# References - - diff --git a/vignettes/twdtw02-lucc.Rmd b/vignettes/twdtw02-lucc.Rmd deleted file mode 100644 index c39fdd5..0000000 --- a/vignettes/twdtw02-lucc.Rmd +++ /dev/null @@ -1,180 +0,0 @@ ---- -title: "2. Land-cover change analysis with TWDTW" -author: "Victor Maus" -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{1. Land-cover change analysis with TWDTW} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -bibliography: ./../inst/REFERENCES.bib ---- - -```{r, echo=FALSE, include=FALSE} -knitr::opts_chunk$set(collapse = TRUE) -knitr::opts_chunk$set(fig.height = 4.5) -knitr::opts_chunk$set(fig.width = 6) -``` - -This vignette provides a short guide on how to perform a Time-Weighted Dynamic Time Warping (TWDTW) analysis on raster image time series using `dtwSat`. For more details about TWDTW read @Maus:2016 and @Maus:2019. - -# Create multi-band image time series - -`dtwSat` provides a set of images extracted from `MOD13Q1` dataset for a region within the Brazilian Amazon. You can load these images with -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -library(dtwSat) - -evi <- brick(system.file("lucc_MT/data/evi.tif", package = "dtwSat")) -ndvi <- brick(system.file("lucc_MT/data/ndvi.tif", package = "dtwSat")) -red <- brick(system.file("lucc_MT/data/red.tif", package = "dtwSat")) -blue <- brick(system.file("lucc_MT/data/blue.tif", package = "dtwSat")) -nir <- brick(system.file("lucc_MT/data/nir.tif", package = "dtwSat")) -mir <- brick(system.file("lucc_MT/data/mir.tif", package = "dtwSat")) -doy <- brick(system.file("lucc_MT/data/doy.tif", package = "dtwSat")) -``` - -The `tif` files above have been pre-processed, so that a single file has the complete time series for each band. One can also built the time series for each band from independent files using the function `stack` from the R package `raster`. - -Note that every band must have the same extend, resolution, and number of images, i.e. the same number of observations across space and time. To create the multi-band image time series we need the dates of each observation, which for the set of images above are -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -timeline <- scan(system.file("lucc_MT/data/timeline", package = "dtwSat"), what="date") -timeline -``` - -Finally, we can create the multi-band image time series with -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -rts <- twdtwRaster(evi, ndvi, red, blue, nir, mir, timeline = timeline, doy = doy) -rts -``` - -The multi-band image time series has `r length(rts)` bands and `r length(index(rts))` observations ranging from `r index(rts)[1]` to `r tail(index(rts), 1)`. - -# Create a library of vegetation profiles - -To crate a library of profiles we need a set of samples. `dtwSat` provides a set of samples of land cover classes for the study area. We can load the samples with -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -field_samples <- read.csv(system.file("lucc_MT/data/samples.csv", package = "dtwSat")) -head(field_samples) -``` - -We split this samples into a training and a validation set, such that -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -library(caret) - -set.seed(1) # set for reproducibility - -I <- unlist(createDataPartition(field_samples$label, p = 0.1)) - -training_samples <- field_samples[I,] - -validation_samples <- field_samples[-I,] -``` - -To get the time series for each sample in the training set, we can run -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -training_ts <- getTimeSeries(rts, - y = training_samples, - proj4string = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0") -``` - -Finally, we can use the training samples to crate the profiles library with -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -profiles_library <- createPatterns(training_ts, - freq = 8, - formula = y ~ s(x)) - -plot(profiles_library, type = "patterns") -``` - -The function `createPatterns` using generalized additive models (GAMs) to create the profiles. For details see `?gam` from `mgcv` package. - - - -# Classify image time series - -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -system.time( - twdtw_lucc <- twdtwApply(x = rts, - y = profiles_library, - alpha = -0.1, - beta = 50, - progress = 'text', - minrows = 30, - legacy = FALSE, - time.window = TRUE) -) -``` - -Note the argument `legacy = FALSE`. Setting this argument to `FALSE` considerably improves the performance of the processing as it does not keep any intermediate dataset. Using `time.window = TRUE` implements a change in the TWDTW algorithm to reduce processing. - -One can also run TWDTW in parallel. For a small area, the performance is not much better than the sequential processing. However, for larger areas, the parallel processing can reduce processing time. To run `twdtwApply` in parallel setup and register a cluster before calling the function, such that -```{r, echo = TRUE, eval = FALSE, warning = FALSE, message = FALSE} -library(doParallel) -library(parallel) -library(foreach) - -cl <- makeCluster(detectCores(), type = "FORK") -registerDoParallel(cl) - -system.time( - twdtw_lucc <- twdtwApply(x = rts, - y = profiles_library, - alpha = -0.1, - beta = 50, - progress = 'text', - minrows = 30, - legacy = FALSE, - time.window = TRUE) -) - -registerDoSEQ() -stopCluster(cl) -``` - -# Assess classifiaction results - -`dtwSat` provides a set of functions to asses the classification results. For example with -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -# Plot TWDTW distances for the first year - plot(twdtw_lucc, type = "distance", time.levels = 1) - -# Plot TWDTW classification results - plot(twdtw_lucc, type = "map") - -# Plot mapped area time series - plot(twdtw_lucc, type = "area") - -# Plot land-cover changes - plot(twdtw_lucc, type = "changes") -``` - -The package also offers a set of methods to assess the classification accuracy and visualize the results. -```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE} -# Assess classification - twdtw_assess <- - twdtwAssess(twdtw_lucc, - y = validation_samples, - proj4string = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0", - conf.int = .95) - -# Plot map accuracy - plot(twdtw_assess, type = "accuracy") - -# Plot area uncertainty - plot(twdtw_assess, type = "area") - -# Plot misclassified samples - plot(twdtw_assess, type = "map", samples = "incorrect") - -# Get latex table with error matrix - twdtwXtable(twdtw_assess, table.type = "matrix") - -# Get latex table with error accuracy - twdtwXtable(twdtw_assess, table.type = "accuracy") - -# Get latex table with area uncertainty - twdtwXtable(twdtw_assess, table.type = "area") -``` - -This short introduction showed how to use `dtwSat` for land-cover change analyse. To learn TWDTW read @Maus:2016 and @Maus:2019. - -# References diff --git a/vignettes/twdtw03-speed.Rmd b/vignettes/twdtw03-speed.Rmd deleted file mode 100644 index 13c7435..0000000 --- a/vignettes/twdtw03-speed.Rmd +++ /dev/null @@ -1,64 +0,0 @@ ---- -title: "2. TWDTW processing time" -author: "Victor Maus" -output: -output: rmarkdown::html_vignette -vignette: > - %\VignetteIndexEntry{1. TWDTW processing time} - %\VignetteEncoding{UTF-8} - %\VignetteEngine{knitr::rmarkdown} -bibliography: ./../inst/REFERENCES.bib -editor_options: - chunk_output_type: console ---- - -```{r, echo=FALSE, include=FALSE} -knitr::opts_chunk$set(collapse = TRUE) -knitr::opts_chunk$set(fig.height = 4.5) -knitr::opts_chunk$set(fig.width = 6) -``` -This vignette tests the performance of TWDTW. For details about method read @Maus:2016 and @Maus:2019. - -# Data - -This vignette uses data from the R package `sitsdata`, which can be installed from Github run -```{r, eval=FALSE} -remotes::install_github(repo = 'e-sensing/sitsdata', ref = '16c8fa7') -``` -The keep this vignette reproducible, I set the argument `ref` to a commit on the online Github repository. - -```{r, eval=FALSE} -library(dtwSat) -library(sitsdata) -library(dplyr) -data(samples_cerrado_mod13q1) -samples_cerrado_mod13q1 |> - group_by(label) |> - summarise(n_samples = n()) -``` - -# Performance - -## Performance on implementations - single time series - - -```{r} -# TODO: -# - twdtwCLassify call for twdtwTimeSeries class and list of data.frame/data.table -# - the same as above with the legacy option -rbenchmark::benchmark( - legacy = twdtwClassify(twdtwApply(x = tw_ts, y = tw_patt, weight.fun = log_fun), from = from, to = to, by = by)[[1]], - fast = twdtwReduceTime(x = mn_ts, y = mn_patt, from = from, to = to, by = by) -) -``` - -## Performance on a real world dataset - -## Performance on a real world with dense time sereis - -In this experiment I increase the number of observation observations in the time series of the example above. - - - - -